From 6aab1acd88ab995350f148393a7e99be80cfffd6 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
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(-)

(limited to 'tests')

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