Repository : ssh://darcs.haskell.org//srv/darcs/packages/dph On branch : master
http://hackage.haskell.org/trac/ghc/changeset/642fd7bf3c5272d9277b44a430f719a4896291ca >--------------------------------------------------------------- commit 642fd7bf3c5272d9277b44a430f719a4896291ca Author: George Roldugin <[email protected]> Date: Tue May 3 09:06:32 2011 +1000 Updated testing infrastructure. >--------------------------------------------------------------- examples/quickcheck/Makefile | 30 ++++++++++++++-------------- examples/quickcheck/Testsuite/Preproc.hs | 10 +++++++- examples/quickcheck/Testsuite/Testcase.hs | 4 +- examples/quickcheck/Testsuite/Utils.hs | 23 +++++++++++++-------- 4 files changed, 39 insertions(+), 28 deletions(-) diff --git a/examples/quickcheck/Makefile b/examples/quickcheck/Makefile index e928bb2..27c74de 100644 --- a/examples/quickcheck/Makefile +++ b/examples/quickcheck/Makefile @@ -1,13 +1,11 @@ -GHC = ../../../../../../../compiler/stage2/ghc-inplace -NDPDIR = ../../../../.. -NDPLIB = $(NDPDIR)/libHSndp.a +GHC = ../../../../inplace/bin/ghc-stage2 HC = $(GHC) -HCFLAGS = -fglasgow-exts -package QuickCheck -package template-haskell \ - -i$(NDPDIR) -v0 -OPTFLAGS = -O2 -funbox-strict-fields \ - -fliberate-case-threshold100 -fno-method-sharing - +HCFLAGS = -package QuickCheck -package template-haskell -package regex-compat \ + -fth -XGeneralizedNewtypeDeriving -XTypeSynonymInstances -v0 +OPTFLAGS = -O2 -funbox-strict-fields -fliberate-case-threshold100 +PARFLAGS = -package dph-prim-par +SEQFLAGS = -package dph-prim-seq TESTSUITE = Testsuite/Utils.hs \ Testsuite/Testcase.hs \ @@ -39,11 +37,11 @@ testsuite: $(TESTSUITE_OBJS) Testsuite.o: $(filter-out Testsuite.o,$(TESTSUITE_OBJS)) -%.o : %.hs $(NDPLIB) - $(HC) -c $< $(HCFLAGS) +%.o : %.hs + $(HC) -c $< $(HCFLAGS) $(PARFLAGS) -%-opt.o: %.hs $(NDPLIB) testsuite - $(HC) -o $@ -c $< $(HCFLAGS) $(OPTFLAGS) +%-opt.o: %.hs testsuite + $(HC) -o $@ -c $< $(HCFLAGS) $(PARFLAGS) $(OPTFLAGS) %.hi: %.o @: @@ -55,14 +53,16 @@ $(TEST_OBJS) : testsuite %-unopt: @echo "======== Testing $(patsubst %-unopt,%,$@) (interpreted) ========" - @$(HC) -e $(TESTMAIN) $(patsubst %-unopt,tests/%.hs,$@) $(HCFLAGS) \ + @$(HC) -e $(TESTMAIN) $(patsubst %-unopt,tests/%.hs,$@) $(HCFLAGS) $(PARFLAGS) \ + | tee [email protected] | { grep -v '\.\.\. pass' || true; } + @$(HC) -e $(TESTMAIN) $(patsubst %-unopt,tests/%.hs,$@) $(HCFLAGS) $(SEQFLAGS) \ | tee [email protected] | { grep -v '\.\.\. pass' || true; } @echo "======== Finished $(patsubst %-unopt,%,$@) (interpreted) ========" %-opt: tests/%-opt.o - @$(HC) -o tst $(HCFLAGS) $< $(TESTSUITE_OBJS) $(NDPLIB) @echo "======== Testing $(patsubst %-opt,%,$@) (optimised) ========" + @$(HC) -o tst $(HCFLAGS) $(PARFLAGS) $< $(TESTSUITE_OBJS) @./tst | tee $@ | { grep -v '\.\.\. pass' || true; } - @echo "======== Finished $(patsubst %-opt,%,$@) (optimised) ========" @rm -f tst $< + @echo "======== Finished $(patsubst %-opt,%,$@) (optimised) ========" diff --git a/examples/quickcheck/Testsuite/Preproc.hs b/examples/quickcheck/Testsuite/Preproc.hs index 636a4b8..37f532a 100644 --- a/examples/quickcheck/Testsuite/Preproc.hs +++ b/examples/quickcheck/Testsuite/Preproc.hs @@ -4,7 +4,7 @@ where import Language.Haskell.TH import Data.List import Data.Maybe (fromJust) -import Monad (liftM) +import Control.Monad (liftM) data Prop = Prop { propName :: Name , propTyvars :: [Name] @@ -67,9 +67,15 @@ instid inst = name inst ++ env inst properties :: [Dec] -> [Prop] properties decs = [mkProp nm ty | SigD nm ty <- decs] where - mkProp nm (ForallT vars _ ty) = Prop nm vars ty + mkProp nm (ForallT vars _ ty) = Prop nm (names vars) ty mkProp nm ty = Prop nm [] ty +names :: [TyVarBndr] -> [Name] +names tvs = map name tvs + where + name (PlainTV n ) = n + name (KindedTV n _) = n + embed :: [Inst] -> Exp embed insts = ListE [((VarE $ mkName "mkTest") `AppE` (LitE . StringL $ instid i)) `AppE` diff --git a/examples/quickcheck/Testsuite/Testcase.hs b/examples/quickcheck/Testsuite/Testcase.hs index fc67352..7a66862 100644 --- a/examples/quickcheck/Testsuite/Testcase.hs +++ b/examples/quickcheck/Testsuite/Testcase.hs @@ -5,13 +5,13 @@ module Testsuite.Testcase ( import Test.QuickCheck import Test.QuickCheck.Batch (TestResult(..), run, defOpt) -import Text.Regex.Base +import Text.Regex import System.Environment (getArgs) import Data.Maybe (isJust) -import IO +import System.IO data Test = Test { testName :: String , testProperty :: Property diff --git a/examples/quickcheck/Testsuite/Utils.hs b/examples/quickcheck/Testsuite/Utils.hs index 6bb41e2..c9e2fab 100644 --- a/examples/quickcheck/Testsuite/Utils.hs +++ b/examples/quickcheck/Testsuite/Utils.hs @@ -1,7 +1,7 @@ module Testsuite.Utils ( - Len(..), EFL, + Len(..) - gvector, gdist, gtype, vtype +--gvector, gdist, gtype, vtype ) where import Test.QuickCheck @@ -9,13 +9,10 @@ import Test.QuickCheck.Batch import Text.Show.Functions -import Data.Array.Parallel.Base.Hyperstrict -import Data.Array.Parallel.Base.Fusion (EFL) import Data.Array.Parallel.Unlifted -import Data.Array.Parallel.Distributed import Data.Char -import Monad (liftM) +import Control.Monad (liftM) -- infix 4 === @@ -25,23 +22,28 @@ instance Arbitrary Char where arbitrary = fmap chr . sized $ \n -> choose (0,n) coarbitrary = coarbitrary . ord +{- instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where arbitrary = liftM (uncurry (:*:)) arbitrary coarbitrary (a :*: b) = coarbitrary (a,b) +-} instance Arbitrary Len where arbitrary = sized $ \n -> Len `fmap` choose (0,n) coarbitrary (Len n) = coarbitrary n +{- instance Arbitrary a => Arbitrary (MaybeS a) where arbitrary = frequency [(1, return NothingS), (3, liftM JustS arbitrary)] coarbitrary NothingS = variant 0 coarbitrary (JustS x) = variant 1 . coarbitrary x +-} -instance (UA a, Arbitrary a) => Arbitrary (UArr a) where - arbitrary = fmap toU arbitrary - coarbitrary = coarbitrary . fromU +instance (Elt a, Arbitrary a) => Arbitrary (Array a) where + arbitrary = fmap fromList arbitrary + coarbitrary = coarbitrary . toList +{- instance (UA a, Arbitrary a) => Arbitrary (SUArr a) where arbitrary = fmap toSU arbitrary coarbitrary = coarbitrary . fromSU @@ -49,7 +51,9 @@ instance (UA a, Arbitrary a) => Arbitrary (SUArr a) where instance Arbitrary Gang where arbitrary = sized $ \n -> sequentialGang `fmap` choose (1,n+1) coarbitrary = coarbitrary . gangSize +-} +{- gvector :: Arbitrary a => Gang -> Gen [a] gvector = vector . gangSize @@ -61,6 +65,7 @@ vtype = const gtype :: Gen (Dist a) -> a -> Gen (Dist a) gtype = const +-} {- class Eq a => SemEq a where _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
