Rearrange tests. See test/genMain.hs for instructions.

This commit is contained in:
Adam Vogt 2010-04-19 01:49:46 +00:00
parent c3c06a4567
commit 36bcb743d6
4 changed files with 62 additions and 2 deletions

View File

@ -1,4 +1,6 @@
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}
module Selective where
-- Tests for limitSelect-related code in L.LimitWindows.
-- To run these tests, export (select,update,Selection(..),updateAndSelect) from

View File

@ -1,4 +1,5 @@
{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module SwapWorkspaces where
import Data.List(find,union)
import Data.Maybe(fromJust)

View File

@ -1,9 +1,10 @@
{-# OPTIONS -fglasgow-exts #-}
{-# LANGUAGE ScopedTypeVariables #-}
-------------------------------------
--
-- Tests for XPrompt and ShellPrompt
--
-------------------------------------
module XPrompt where
import Data.Char
import Test.QuickCheck
@ -12,11 +13,14 @@ import Data.List
import XMonad.Prompt
import qualified XMonad.Prompt.Shell as S
import Properties
{-
instance Arbitrary Char where
arbitrary = choose ('\32', '\255')
coarbitrary c = variant (ord c `rem` 4)
-}
doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p
deepCheck p = check (defaultConfig { configMaxTest = 10000}) p
@ -40,6 +44,7 @@ prop_spliInSubListsAt (x :: Int) (str :: [Char]) =
prop_skipGetLastWord (str :: [Char]) =
skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str
-- newIndex and newCommand get only non empy lists
elemGen :: Gen ([String],String)
elemGen = do

52
tests/genMain.hs Normal file
View File

@ -0,0 +1,52 @@
{-# LANGUAGE ViewPatterns #-}
{- | generate another Main from all modules in the current directory,
extracting all functions with @prop_@.
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
-}
module Main where
import Control.Monad.List
import Data.Char
import Data.IORef
import Data.List
import qualified Data.Set as S
import System.Directory
import System.FilePath
import Text.PrettyPrint.HughesPJ
main = do
imports <- newIORef S.empty
props <- runListT $ do
f @ ((isUpper -> True) : (takeExtension -> ".hs"))
<- ListT (getDirectoryContents ".")
guard $ f `notElem` ["Main.hs", "Common.hs", "Properties.hs"]
let b = takeBaseName f
nesting <- io $ newIORef 0
decl : _ <- ListT $ (map words . lines) `fmap` readFile f
case decl of
"{-" -> io $ modifyIORef nesting succ
"-}" -> io $ modifyIORef nesting pred
_ -> return ()
0 <- io $ readIORef nesting
guard $ "prop_" `isPrefixOf` decl
io $ modifyIORef imports (S.insert b)
return (b ++ "." ++ decl)
imports <- S.toList `fmap` readIORef imports
print $ genModule imports props
genModule :: [String] -> [String] -> Doc
genModule imports props = vcat [header,imports', main ]
where
header = text "module Main where"
imports' = text "import Test.QuickCheck"
$$ vcat [ text "import qualified" <+> text im | im <- imports ]
props' = vcat [ text "quickCheck" <+> text p | p <- props ]
main = hang (text "main = do") 4 props'
io x = liftIO x