Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph On branch : master
http://hackage.haskell.org/trac/ghc/changeset/765261806b5f306d869578f35bc4c9143321adb6 >--------------------------------------------------------------- commit 765261806b5f306d869578f35bc4c9143321adb6 Author: George Roldugin <[email protected]> Date: Mon May 30 08:44:24 2011 +1000 Prevent permute tests from exhausting. >--------------------------------------------------------------- examples/quickcheck/Makefile | 7 +++- examples/quickcheck/Testsuite/Utils.hs | 22 +--------------- examples/quickcheck/tests/Unlifted_Permutes.hs | 32 ++++++++++++++--------- 3 files changed, 25 insertions(+), 36 deletions(-) diff --git a/examples/quickcheck/Makefile b/examples/quickcheck/Makefile index 27c74de..1345154 100644 --- a/examples/quickcheck/Makefile +++ b/examples/quickcheck/Makefile @@ -52,13 +52,16 @@ $(TEST_OBJS) : testsuite @: %-unopt: - @echo "======== Testing $(patsubst %-unopt,%,$@) (interpreted) ========" + @echo "======== Testing $(patsubst %-unopt,%,$@) (parallel, interpreted) ========" @$(HC) -e $(TESTMAIN) $(patsubst %-unopt,tests/%.hs,$@) $(HCFLAGS) $(PARFLAGS) \ | tee [email protected] | { grep -v '\.\.\. pass' || true; } + @echo "======== Finished $(patsubst %-unopt,%,$@) (parallel, interpreted) ========" + @echo "======== Testing $(patsubst %-unopt,%,$@) (sequential, interpreted) ========" @$(HC) -e $(TESTMAIN) $(patsubst %-unopt,tests/%.hs,$@) $(HCFLAGS) $(SEQFLAGS) \ | tee [email protected] | { grep -v '\.\.\. pass' || true; } - @echo "======== Finished $(patsubst %-unopt,%,$@) (interpreted) ========" + @echo "======== Finished $(patsubst %-unopt,%,$@) (sequential, interpreted) ========" +# Throws warnings %-opt: tests/%-opt.o @echo "======== Testing $(patsubst %-opt,%,$@) (optimised) ========" @$(HC) -o tst $(HCFLAGS) $(PARFLAGS) $< $(TESTSUITE_OBJS) diff --git a/examples/quickcheck/Testsuite/Utils.hs b/examples/quickcheck/Testsuite/Utils.hs index 7a28aeb..13b39f2 100644 --- a/examples/quickcheck/Testsuite/Utils.hs +++ b/examples/quickcheck/Testsuite/Utils.hs @@ -1,5 +1,5 @@ module Testsuite.Utils ( - Len(..), Perm(..), BPerm(..), DftPerm(..) + Len(..), Perm(..) --gvector, gdist, gtype, vtype ) where @@ -23,12 +23,6 @@ newtype Len = Len Int deriving (Eq,Ord,Enum,Show,Num) -- permutation of [0..n-1] with all values appearing exactly once newtype Perm = Perm (Array Int) deriving (Eq,Show) --- array of elements taken from [0..n-1] -newtype BPerm = BPerm (Array Int) deriving (Eq,Show) - --- array of index-value pairs with indices taken from [0..n-1] -newtype DftPerm a = DftPerm (Array (Int, a)) deriving (Eq, Show) - {- instance Arbitrary Char where arbitrary = fmap chr . sized $ \n -> choose (0,n) @@ -47,15 +41,6 @@ instance Arbitrary Len where instance Arbitrary Perm where arbitrary = Perm `fmap` (sized $ \n -> elements $ P.map fromList (permutations [0..n-1])) -instance Arbitrary BPerm where - arbitrary = sized $ \n -> (BPerm . fromList . P.map (`mod` n)) `fmap` enlarge n arbitrary - -instance (Elt a, Arbitrary a) => Arbitrary (DftPerm a) where - arbitrary = do - BPerm idxs <- arbitrary -- :: Gen BPerm - vals <- sized $ \n -> enlarge n arbitrary -- :: Gen (Array a) - return $ DftPerm (U.zip idxs vals) - {- instance Arbitrary a => Arbitrary (MaybeS a) where arbitrary = frequency [(1, return NothingS), (3, liftM JustS arbitrary)] @@ -76,11 +61,6 @@ instance Arbitrary Gang where coarbitrary = coarbitrary . gangSize -} --- wrapper to Test.QuickCheck.resize facilitating the generation of --- longer permutations while keeping indices within bounds -enlarge n = resize $ case n of 0 -> 0 -- potential corner cases - 1 -> 1 -- these too - n -> 2*n {- gvector :: Arbitrary a => Gang -> Gen [a] gvector = vector . gangSize diff --git a/examples/quickcheck/tests/Unlifted_Permutes.hs b/examples/quickcheck/tests/Unlifted_Permutes.hs index 6037080..c113012 100644 --- a/examples/quickcheck/tests/Unlifted_Permutes.hs +++ b/examples/quickcheck/tests/Unlifted_Permutes.hs @@ -15,23 +15,29 @@ $(testcases [ "" <@ [t| ( Bool, Int ) |] prop_permute arr (Perm is) = (U.length arr == U.length is) ==> permute arr is == U.map (arr!:) is - prop_bpermute :: (Elt a, Eq a) => Array a -> BPerm -> Property - prop_bpermute arr (BPerm is) = - (is == empty) || (maximum $ toList is) < U.length arr - ==> bpermute arr is == U.map (arr!:) is + prop_bpermute :: (Elt a, Eq a) => Array a -> Array Int -> Bool + prop_bpermute arr ixs = + bpermute arr ixs' == U.map (arr!:) ixs' + where ixs' = if U.length arr == 0 then empty -- no permutations for an empty array + else U.map (`mod` (U.length arr)) ixs - prop_mbpermute :: (Elt a, Eq b, Elt b) => (a -> b) -> Array a -> BPerm -> Property - prop_mbpermute f arr (BPerm is) = - (is == empty) || (maximum $ toList is) < U.length arr - ==> mbpermute f arr is == U.map (\i -> f (arr!:i)) is + prop_mbpermute :: (Elt a, Eq b, Elt b) => (a -> b) -> Array a -> Array Int -> Bool + prop_mbpermute f arr ixs = + mbpermute f arr ixs' == U.map (\i -> f (arr!:i)) ixs' + where ixs' = if U.length arr == 0 then empty -- no permutations for an empty array + else U.map (`mod` (U.length arr)) ixs - prop_bpermuteDft :: (Elt a, Eq a) => Len -> (Int -> a) -> DftPerm a -> Property - prop_bpermuteDft (Len n) init (DftPerm pairs) = - (pairs == empty) || (maximum (toList $ fsts pairs) < n) - ==> toList (bpermuteDft n init pairs) == update (P.map init [0..n-1]) (toList pairs) - where set xs i x = (P.take i xs) ++ [x] ++ (P.drop (i+1) xs) + prop_bpermuteDft :: (Elt a, Eq a) => Len -> (Int -> a) -> Array (Int, a) -> Bool + prop_bpermuteDft (Len n) init pairs = + toList (bpermuteDft n init pairs') == update (P.map init [0..n-1]) (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 |]) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
