Tests/Properties.hs

   1 module Tests.Properties where
   2 import Test.QuickCheck
   3 import Control.Monad
   4 import Text.Printf
   5 import System.Exit
   6 import System.IO
   7 import qualified Data.Set as S
   8 import qualified Data.Map as M
   9 import Infinity.Core
  10
  11 instance Arbitrary Server where
  12     arbitrary = do
  13       n      <- choose (1,20)  -- length of strings
  14       k      <- choose (1,30)  -- random amount of chans/admins
  15       nick   <- vector n :: Gen [Char]
  16       real   <- vector n :: Gen [Char]
  17       pass   <- vector n :: Gen [Char]
  18       chans  <- mapM (vector :: Int -> Gen [Char]) $ replicate k n
  19       addr   <- vector n :: Gen [Char]
  20       port   <- choose (1,9000)
  21       admins <- mapM (vector :: Int -> Gen [Char]) $ replicate k n
  22       return $ Server addr port (S.fromList chans) nick pass real (S.fromList admins)
  23
  24 instance Arbitrary Bot where
  25     arbitrary = do
  26       n     <- choose (1,20) -- random number of servers
  27       servs <- vector n :: Gen [Server]
  28       return $ Bot (M.fromList $ zip servs (repeat stdout)) -- we use stdout so we don't get errs since it always exists
  29
  30 -- | Properties
  31 prop_partc_idempotent s c = (joinchan c (joinchan c s)) == joinchan c s
  32     where types = (s::Server,c::String)
  33
  34 prop_joinc_idempotent s c = (partchan c (partchan c s)) == partchan c s
  35     where types = (s::Server,c::String)
  36
  37 -- the below test slightly violates procedure, but we have to do it this way
  38 -- so we can get a more proper test. if we use ==> to check that the random
  39 -- channel name is already a member of the server's randomly generated channels,
  40 -- before running partchan, then joinchan, the input space is too large so chances are it
  41 -- will fail because quickcheck will give up on generation, resulting in failure.
  42 -- on the other hand, without that constraint, we will part a channel, returning
  43 -- the same server (since the generated string probably isn't a part of the generated
  44 -- channels,) then join that channel, which will result in a false negative.
  45 -- therefore, we run this over a server we can make sure that has that channel apart of
  46 -- it, since the above tests prove joinchan is idempotent anyway.
  47 prop_joinpart_inverse s c = (joinchan c (partchan c s')) == s'
  48     where types = (s::Server,c::String)
  49           s'    = joinchan c s
  50
  51 prop_partjoin_inverse s c = (partchan c (joinchan c s)) == s
  52     where types = (s::Server,c::String)
  53
  54 prop_newadmin_idempotent s n = (newadmin n (newadmin n s)) == newadmin n s
  55     where types = (s::Server,n::String)
  56
  57 prop_deladmin_idempotent s n = (deladmin n (deladmin n s)) == deladmin n s
  58     where types = (s::Server,n::String)
  59
  60 -- see above (prop_joinpart_inverse) for an explanation of this test
  61 prop_newdel_inverse s n = (newadmin n (deladmin n s')) == s'
  62     where types = (s::Server,n::String)
  63           s'    = newadmin n s
  64
  65 prop_delnew_inverse s n = (deladmin n (newadmin n s)) == s
  66     where types = (s::Server,n::String)
  67
  68 prop_servexists b s = (servexists b' s) == True
  69     where types = (b::Bot,s::Server)
  70           b'    = joinserv stdout s b
  71
  72 prop_partserv_idempotent s b = (partserv s (partserv s b)) == partserv s b
  73     where types = (s::Server,b::Bot)
  74
  75 prop_joinserv_idempotent s b = (joinserv stdout s (joinserv stdout s b)) == joinserv stdout s b
  76     where types = (s::Server,b::Bot)
  77
  78 prop_partjoinserv_inverse s b = (partserv s (joinserv stdout s b)) == b
  79     where types = (s::Server,b::Bot)
  80
  81 prop_joinpartserv_inverse s b = (joinserv stdout s (partserv s b')) == b'
  82     where types = (s::Server,b::Bot)
  83           b'    = joinserv stdout s b
  84
  85 -- | Invariants table
  86 invariants = [ ("joinchan c (joinchan c s) == joinchan c s",
  87                 quickCheck' prop_joinc_idempotent)
  88              , ("partchan c (partchan c s) == partchan c s",
  89                 quickCheck' prop_partc_idempotent)
  90              , ("partchan c (joinchan c s) == s",
  91                 quickCheck' prop_partjoin_inverse)
  92              , ("joinchan c (partchan c s) == s",
  93                 quickCheck' prop_joinpart_inverse)
  94              , ("newadmin n (newadmin n s) == newadmin n s",
  95                 quickCheck' prop_newadmin_idempotent)
  96              , ("deladmin n (deladmin n s) == deladmin n s",
  97                 quickCheck' prop_deladmin_idempotent)
  98              , ("newadmin n (deladmin n s) == s",
  99                 quickCheck' prop_newdel_inverse)
 100              , ("deladmin n (newadmin n s) == s",
 101                 quickCheck' prop_delnew_inverse)
 102              , ("servexists b s == True",
 103                 quickCheck' prop_servexists)
 104              , ("partserv s (partserv s b) == b",
 105                 quickCheck' prop_partserv_idempotent)
 106              , ("joinserv undef s (joinserv undef s b) == b",
 107                 quickCheck' prop_joinserv_idempotent)
 108              , ("partserv s (joinserv undef s b) == b",
 109                 quickCheck' prop_partjoinserv_inverse)
 110              , ("joinserv undef s (partserv s b) == b",
 111                 quickCheck' prop_joinpartserv_inverse)
 112              ]
 113
 114 main = do
 115   b <- mapM (\(s,t) -> printf "%s:\t\t" s >> t) invariants
 116   printf "%d tests passed.\n" $ (length . filter id) b
 117   if (not . and $ b) then
 118     printf "Err: Not all tests passed.\n" >> exitWith (ExitFailure (-1))
 119    else printf "Success, all tests passed.\n"