From 6aab1acd88ab995350f148393a7e99be80cfffd6 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Thu, 9 Jun 2011 06:07:22 +0200 Subject: Extend script for generating the code which runs tests Ignore-this: 44ebbee2683f50bc0728458f4babcce Now the number of runs each can be set, and the failures and successes are summarized in the same way as the core Properties.hs. There is some duplicated code which could be avoided by modifying Properties.hs. darcs-hash:20110609040722-1499c-206640f8199e58688298069c98e373ab82ce3999.gz --- tests/genMain.hs | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) diff --git a/tests/genMain.hs b/tests/genMain.hs index 90d8224..996f19a 100644 --- a/tests/genMain.hs +++ b/tests/genMain.hs @@ -6,7 +6,7 @@ Usage (your QuickCheck-1 version may vary): > ln -s ../../xmonad/tests/Properties.hs . > runghc genMain.hs > Main.hs -> ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e main +> ghc -DTESTING -i.. -i. -package QuickCheck-1.2.0.0 Main.hs -e ':main 200' -} module Main where @@ -44,9 +44,23 @@ genModule :: [String] -> [String] -> Doc genModule imports props = vcat [header,imports', main ] where header = text "module Main where" - imports' = text "import Test.QuickCheck" + imports' = text "import Test.QuickCheck; import Data.Maybe; \ + \import System.Environment; import Text.Printf; \ + \import Properties hiding (main); import Control.Monad" $$ vcat [ text "import qualified" <+> text im | im <- imports ] - props' = vcat [ text "quickCheck" <+> text p | p <- props ] - main = hang (text "main = do") 4 props' + props' = [ parens $ doubleQuotes (text p) <> comma <> text "mytest" <+> text p + | p <- props ] + main = hang (text "main = do") 4 $ + text "n <- maybe (return 100) readIO . listToMaybe =<< getArgs" + $$ + hang (text "let props = ") 8 + (brackets $ foldr1 (\x xs -> x <> comma $$ xs) props') + $$ + text "(results, passed) <- liftM unzip $ \ + \mapM (\\(s,a) -> printf \"%-40s: \" s >> a n) props" + $$ + text "printf \"Passed %d tests!\\n\" (sum passed)" + $$ + text "when (any not results) $ fail \"Not all tests passed!\"" io x = liftIO x -- cgit v1.2.3