twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 03:20:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Extend script for generating the code which runs tests

Browse Source 
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.
This commit is contained in:
Adam Vogt 2011-06-09 04:07:22 +00:00
parent dea9cdea5e
commit 334344b804
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
tests/genMain.hs
View File

@ -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