[commit: dph] master: Add more quickcheck properties. (47cb9fa)

[Ben Lippmeier]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/47cb9fa924038893bb63f39334848bfc40fc631b

>---------------------------------------------------------------

commit 47cb9fa924038893bb63f39334848bfc40fc631b
Author: George Roldugin <groldugin at cse.unsw.edu.au>
Date:   Mon May 30 21:19:23 2011 +1000

    Add more quickcheck properties.

>---------------------------------------------------------------

 examples/quickcheck/tests/Unlifted_Basics.hs      |   16 ++++++++++++
 examples/quickcheck/tests/Unlifted_Combinators.hs |   28 ++++++++++++++++++---
 examples/quickcheck/tests/Unlifted_Permutes.hs    |   15 +++++++++++
 3 files changed, 55 insertions(+), 4 deletions(-)

diff --git a/examples/quickcheck/tests/Unlifted_Basics.hs b/examples/quickcheck/tests/Unlifted_Basics.hs
index 756569b..13c95a1 100644
--- a/examples/quickcheck/tests/Unlifted_Basics.hs
+++ b/examples/quickcheck/tests/Unlifted_Basics.hs
@@ -1,3 +1,4 @@
+
 import Testsuite
 
 import Data.Array.Parallel.Unlifted as U
@@ -31,6 +32,17 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
   prop_replicate (Len n) x =
     toList (U.replicate n x) == P.replicate n x
 
+  prop_repeat :: (Eq a, Elt a) => Len -> Len -> Array a -> Bool
+  prop_repeat (Len n) (Len dummy) arr =
+    toList (U.repeat n dummy arr) == (P.concat $ P.replicate n (toList arr))
+
+  prop_interleave :: (Eq a, Elt a) => Array a -> Array a -> Bool
+  prop_interleave arr brr =
+    toList (U.interleave arr brr) == interleave (toList arr) (toList brr)
+      where interleave (x:xs) (y:ys) = x : y : (interleave xs ys)
+            interleave (x:_)  _      = [x]
+            interleave _      _      = []
+
   prop_index :: (Eq a, Elt a) => Array a -> Len -> Property
   prop_index arr (Len i) =
     i < U.length arr
@@ -40,6 +52,10 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
   prop_append arr brr =
     toList (arr +:+ brr) == toList arr ++ toList brr
 
+  prop_indexed :: (Eq a, Elt a) => Array a -> Bool
+  prop_indexed arr =
+    toList (indexed arr) == P.zip [0..U.length arr - 1] (toList arr)
+
   -- Equality
   -- --------
 
diff --git a/examples/quickcheck/tests/Unlifted_Combinators.hs b/examples/quickcheck/tests/Unlifted_Combinators.hs
index 124c34d..9b79c4b 100644
--- a/examples/quickcheck/tests/Unlifted_Combinators.hs
+++ b/examples/quickcheck/tests/Unlifted_Combinators.hs
@@ -37,6 +37,23 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
 
   -- missing: combine2
 
+  prop_zip :: (Eq a, Elt a, Eq b, Elt b) => Array a -> Array b -> Bool
+  prop_zip arr brr = 
+    toList (U.zip arr brr) == P.zip (toList arr) (toList brr)
+
+  prop_unzip :: (Eq a, Elt a, Eq b, Elt b) => Array (a, b) -> Bool
+  prop_unzip abrr =
+    (toList arr, toList brr) == P.unzip (toList abrr)
+      where (arr, brr) = U.unzip abrr
+
+  prop_fsts :: (Eq a, Elt a, Elt b) => Array (a, b) -> Bool
+  prop_fsts arr =
+    fsts arr == fst (U.unzip arr)
+
+  prop_snds :: (Elt a, Eq b, Elt b) => Array (a, b) -> Bool
+  prop_snds arr =
+    snds arr == snd (U.unzip arr)
+
   prop_zipWith :: (Elt a, Elt b, Eq c, Elt c) => (a -> b -> c) -> Array a -> Array b -> Bool
   prop_zipWith f arr brr =
     toList (U.zipWith f arr brr) == P.zipWith f (toList arr) (toList brr)
@@ -46,15 +63,18 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
   prop_zipWith3 f arr brr crr =
     toList (U.zipWith3 f arr brr crr) == P.zipWith3 f (toList arr) (toList brr) (toList crr)
 
-  prop_fold :: (Elt a, Eq a) => (a -> a -> a) -> a -> Array a -> Bool
-  prop_fold f z arr =
-    U.fold f z arr == P.foldl f z (toList arr)
+  -- TODO: Guarrantee associativity of the passed function
+  -- prop_fold :: (Elt a, Eq a) => (a -> a -> a) -> a -> Array a -> Bool
+  -- prop_fold f z arr =
+  --  U.fold f z arr == P.foldl f z (toList arr)
 
+  -- TODO: Guarrantee associativity of the passed function
   prop_fold1 :: (Elt a, Eq a) => (a -> a -> a) -> Array a -> Property
   prop_fold1 f arr =
-    not (null $ toList arr)
+    arr /= empty
     ==> U.fold1 f arr == P.foldl1 f (toList arr)
 
+  -- TODO: Guarrantee associativity of the passed function
   prop_scan :: (Elt a, Eq a) => (a -> a -> a) -> a -> Array a -> Bool
   prop_scan f z arr =
     toList (U.scan f z arr) == P.init (P.scanl f z (toList arr))
diff --git a/examples/quickcheck/tests/Unlifted_Permutes.hs b/examples/quickcheck/tests/Unlifted_Permutes.hs
index c113012..e37809a 100644
--- a/examples/quickcheck/tests/Unlifted_Permutes.hs
+++ b/examples/quickcheck/tests/Unlifted_Permutes.hs
@@ -39,5 +39,20 @@ $(testcases [ ""        <@ [t| ( Bool, Int ) |]
 
           pairs' = if n <= 0 then U.zip empty empty
                              else U.map (\(i,x) -> (i `mod` n, x)) pairs
+
+  prop_update :: (Eq a, Elt a) => Array a -> Array (Int, a) -> Bool
+  prop_update arr pairs =
+    toList (U.update arr pairs') == update (toList arr) (toList pairs')
+    where
+       -- update :: [a] -> [(Int, a)] -> [a]
+          update xs []         = xs
+          update xs ((i,x):ps) = update (set xs i x) ps
+       -- set :: [a] -> Int -> a -> [a]
+          set xs i x = (P.take i xs) ++ [x] ++ (P.drop (i+1) xs)
+
+          pairs' = if n <= 0 then U.zip empty empty
+                             else U.map (\(i,x) -> (i `mod` n, x)) pairs
+          n = U.length arr
+
  |])