Permalink
Browse files

use test.framework rather than an inelastic qcWith shortcut

  • Loading branch information...
1 parent e5abd6a commit 3ded655925c736e34a4d268b11f80240d9e31c93 @clux committed Mar 27, 2012
Showing with 24 additions and 25 deletions.
  1. +1 −1 Game/Tournament.hs
  2. +19 −22 tests/Properties.hs
  3. +4 −2 tournament.cabal
View
@@ -91,7 +91,7 @@ robin n = map (filter notDummy . toPairs) rounds where
robinPermute :: [a] -> [a]
robinPermute [] = []
robinPermute [x] = [x]
-robinPermute (x:xs) = x : last xs : init xs -- know xs != []
+robinPermute (x:xs) = x : last xs : init xs -- know not null xs
-- -----------------------------------------------------------------------------
-- Duel elimination
View
@@ -6,6 +6,9 @@ import qualified Game.Tournament as T
import Test.QuickCheck
import Data.List ((\\), nub, genericLength)
import Control.Monad (liftM)
+import Test.Framework (defaultMain, testGroup)
+--import Test.Framework.Providers.HUnit
+import Test.Framework.Providers.QuickCheck2 (testProperty)
-- helper instances for positive short ints
newtype RInt = RInt {rInt :: Int} deriving (Eq, Ord, Show, Num, Integral, Real, Enum)
@@ -39,7 +42,7 @@ groupsProp3 (n', s') = n `mod` s == 0 ==>
-- sum of seeds is perfect when groups are full and even sized
groupsProp4 :: GroupArgs -> Property
-groupsProp4 (n', s') = n `mod` s == 0 && even (n `div` s) ==>
+groupsProp4 (n', s') = n `mod` s == 0 && even s ==>
maximum gsums == minimum gsums where
gsums = map sum $ n `T.inGroupsOf` s
(n, s) = (fromIntegral n', fromIntegral s')
@@ -75,27 +78,21 @@ robinProp4 n = all (\i -> [1..n] \\ combatants i == [i]) [1..n] where
-- -----------------------------------------------------------------------------
-- Test harness
+tests = [
+ testGroup "robin" [
+ testProperty "robin num rounds" robinProp1
+ , testProperty "robin num matches" robinProp2
+ , testProperty "robin unique round players" robinProp3
+ , testProperty "robin all plaid all" robinProp4
+ ]
+ , testGroup "inGroupsOf" [
+ testProperty "group sizes all <= input s" groupsProp1
+ , testProperty "group includes all [1..n]" groupsProp2
+ , testProperty "group sum of seeds max diff" groupsProp3
+ , testProperty "group sum of seeds min diff" groupsProp4
+ ]
+ ]
-qc = quickCheckWith stdArgs {
- maxSuccess = 50
- , chatty = True
- }
main :: IO ()
-main = do
- putStrLn "test robin:"
- {-mapM_ qc [
- robinProp1
- , robinProp2
- , robinProp3
- , robinProp4
- ]-}
- --putStrLn "test inGroupsOf"
- mapM_ qc [
- groupsProp1
- , groupsProp2
- ]
- -- need a better thing to use as qc
- -- else its type becomes rigid after one run
-
- putStrLn "done"
+main = defaultMain tests
View
@@ -43,6 +43,8 @@ executable tournament-test
main-is : tests/Properties.hs
other-modules : Game.Tournament
build-depends :
- base >= 4.0 && < 5.0
- , QuickCheck == 2.4.*
+ base >= 4.0 && < 5.0
+ , QuickCheck == 2.4.*
+ , test-framework-quickcheck2 == 0.2.*
+ , test-framework == 0.6.*
ghc-options : -W

0 comments on commit 3ded655

Please sign in to comment.