mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-14 19:45:44 -07:00
Roll testing into the main executable, use Cabal to build the tests
This commit is contained in:
7
Main.hs
7
Main.hs
@@ -22,6 +22,10 @@ import System.Info
|
|||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Posix.Process (executeFile)
|
import System.Posix.Process (executeFile)
|
||||||
|
|
||||||
|
#ifdef TESTING
|
||||||
|
import qualified Properties
|
||||||
|
#endif
|
||||||
|
|
||||||
-- | The entry point into xmonad. Attempts to compile any custom main
|
-- | The entry point into xmonad. Attempts to compile any custom main
|
||||||
-- for xmonad, and if it doesn't find one, just launches the default.
|
-- for xmonad, and if it doesn't find one, just launches the default.
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
@@ -34,6 +38,9 @@ main = do
|
|||||||
["--recompile"] -> recompile False >> return ()
|
["--recompile"] -> recompile False >> return ()
|
||||||
["--recompile-force"] -> recompile True >> return ()
|
["--recompile-force"] -> recompile True >> return ()
|
||||||
["--version"] -> putStrLn "xmonad 0.5"
|
["--version"] -> putStrLn "xmonad 0.5"
|
||||||
|
#ifdef TESTING
|
||||||
|
("--run-tests":_) -> Properties.main
|
||||||
|
#endif
|
||||||
_ -> fail "unrecognized flags"
|
_ -> fail "unrecognized flags"
|
||||||
|
|
||||||
-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no
|
-- | Build "~/.xmonad/xmonad.hs" with ghc, then execute it. If there are no
|
||||||
|
@@ -1,8 +0,0 @@
|
|||||||
module Main where
|
|
||||||
|
|
||||||
import qualified Properties
|
|
||||||
|
|
||||||
-- This will run all of the QC files for xmonad core. Currently, that's just
|
|
||||||
-- Properties. If any more get added, sequence the main actions together.
|
|
||||||
main = do
|
|
||||||
Properties.main
|
|
@@ -1,4 +1,4 @@
|
|||||||
{-# OPTIONS -fglasgow-exts #-}
|
{-# OPTIONS -fglasgow-exts -w #-}
|
||||||
module Properties where
|
module Properties where
|
||||||
|
|
||||||
import XMonad.StackSet hiding (filter)
|
import XMonad.StackSet hiding (filter)
|
||||||
@@ -52,7 +52,6 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
|
|||||||
| s <- ls ]
|
| s <- ls ]
|
||||||
|
|
||||||
return $ fromList (fromIntegral n, sds,fs,ls,lay)
|
return $ fromList (fromIntegral n, sds,fs,ls,lay)
|
||||||
coarbitrary = error "no coarbitrary for StackSet"
|
|
||||||
|
|
||||||
|
|
||||||
-- | fromList. Build a new StackSet from a list of list of elements,
|
-- | fromList. Build a new StackSet from a list of list of elements,
|
||||||
@@ -652,7 +651,7 @@ noOverlaps xs = and [ verts a `notOverlap` verts b
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- fmap (drop 1) getArgs
|
||||||
let n = if null args then 100 else read (head args)
|
let n = if null args then 100 else read (head args)
|
||||||
(results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-25s: " s >> a n) tests
|
(results, passed) <- liftM unzip $ mapM (\(s,a) -> printf "%-25s: " s >> a n) tests
|
||||||
printf "Passed %d tests!\n" (sum passed)
|
printf "Passed %d tests!\n" (sum passed)
|
||||||
@@ -941,6 +940,7 @@ instance Arbitrary EmptyStackSet where
|
|||||||
l <- arbitrary
|
l <- arbitrary
|
||||||
-- there cannot be more screens than workspaces:
|
-- there cannot be more screens than workspaces:
|
||||||
return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds
|
return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds
|
||||||
|
coarbitrary = error "coarbitrary EmptyStackSet"
|
||||||
|
|
||||||
-- | Generates a value that satisfies a predicate.
|
-- | Generates a value that satisfies a predicate.
|
||||||
suchThat :: Gen a -> (a -> Bool) -> Gen a
|
suchThat :: Gen a -> (a -> Bool) -> Gen a
|
||||||
|
@@ -48,6 +48,7 @@ library
|
|||||||
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
|
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
|
||||||
ghc-prof-options: -prof -auto-all
|
ghc-prof-options: -prof -auto-all
|
||||||
extensions: CPP
|
extensions: CPP
|
||||||
|
|
||||||
if flag(testing)
|
if flag(testing)
|
||||||
buildable: False
|
buildable: False
|
||||||
|
|
||||||
@@ -59,5 +60,11 @@ executable xmonad
|
|||||||
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
|
ghc-options: -funbox-strict-fields -Wall -optl-Wl,-s
|
||||||
ghc-prof-options: -prof -auto-all
|
ghc-prof-options: -prof -auto-all
|
||||||
extensions: CPP
|
extensions: CPP
|
||||||
|
|
||||||
if flag(testing)
|
if flag(testing)
|
||||||
|
cpp-options: -DTESTING
|
||||||
|
hs-source-dirs: . tests/
|
||||||
|
build-depends: QuickCheck
|
||||||
ghc-options: -Werror
|
ghc-options: -Werror
|
||||||
|
if flag(testing) && flag(small_base)
|
||||||
|
build-depends: random
|
||||||
|
Reference in New Issue
Block a user