From 0cbd54c4f6a70c8fde46f5f0733906113bdd9766 Mon Sep 17 00:00:00 2001
From: "Neil Mitchell http://www.cs.york.ac.uk/~ndm/" <none>
Date: Tue, 8 May 2007 17:46:21 +0200
Subject: Add the initial Catch testing framework for StackSet

darcs-hash:20070508154621-fbc8d-8aeafa9c3c6cb40abf72a71f83c5a26d06a71501
---
 tests/Catch.hs | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 60 insertions(+)
 create mode 100644 tests/Catch.hs

(limited to 'tests')

diff --git a/tests/Catch.hs b/tests/Catch.hs
new file mode 100644
index 0000000..7538ff0
--- /dev/null
+++ b/tests/Catch.hs
@@ -0,0 +1,60 @@
+
+-- This is a test set for running with Catch
+-- http://www-users.cs.york.ac.uk/~ndm/catch/
+
+module Catch where
+
+import StackSet
+
+---------------------------------------------------------------------
+-- TESTING PROPERTIES
+
+main = 
+    screen ||| peekStack ||| index ||| empty ||| peek ||| push ||| delete ||| member |||
+    raiseFocus ||| rotate ||| promote ||| shift ||| view ||| workspace ||| insert |||
+    visibleWorkspaces ||| swap {- helper -}
+
+
+---------------------------------------------------------------------
+-- CATCH FIRST-ORDER LIBRARY
+
+-- this should be included with Catch by default
+-- and will be (one day!)
+
+foreign import primitive any0 :: a
+foreign import primitive anyEval1 :: a -> b
+foreign import primitive anyEval2 :: a -> b -> c
+foreign import primitive anyEval3 :: a -> b -> c -> d
+
+
+class Test a where
+    test :: a -> Bool
+
+
+instance Test b => Test (a -> b) where
+    test f = test (f any0)
+
+instance Test (Maybe a) where
+    test f = anyEval1 f
+
+instance Test [a] where
+    test f = anyEval1 f
+
+instance Test (StackSet a b c) where
+    test f = anyEval1 f
+
+instance Test (a,b) where
+    test f = anyEval1 f
+
+instance Test Bool where
+    test f = anyEval1 f
+
+instance Test Char where
+    test f = anyEval1 f
+
+instance Test (IO a) where
+    test f = anyEval1 (f >> return ())
+    
+
+(|||) :: (Test a, Test b) => a -> b -> IO c
+(|||) l r = anyEval2 (test l) (test r)
-- 
cgit v1.2.3