New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add a test-suite section for testing QuickCheck properties #6

Merged
merged 3 commits into from Feb 21, 2017
Jump to file or symbol
Failed to load files and symbols.
+51 −0
Diff settings

Always

Just for now

View
@@ -23,3 +23,12 @@ library
, mtl >= 2.2 && < 2.3
, transformers >= 0.4 && < 0.5
, QuickCheck >= 2.1 && < 3.0
test-suite discordia
type: exitcode-stdio-1.0
main-is: Discordia.hs
other-modules: MaitreD, MaitreDTests
default-language: Haskell2010
build-depends: base >= 4.8 && < 4.9
, time >= 1.5 && < 1.6
, QuickCheck >= 2.1 && < 3.0
View
@@ -0,0 +1,42 @@
-- This module implements a basic Test Runner for testing QuickCheck properties.
-- It's mostly identical to what xmonad does. [1][2]
-- Given the (current) size of this codebase, that's the simplest thing that can
-- possibly work [3], without taking on needless dependencies on other packages.
-- It's named Discordia, after Eris (/ˈɪərɪs, ˈɛrɪs/; Greek: Ἔρις, "Strife") the
-- Greek goddess of strife 'n discord. Eris is the equivalent of Latin Discordia
-- which means "discord".
--
-- 1. https://github.com/xmonad/xmonad/blob/f03d2cdf74288bb3632b601ccd43bf02b0da4532/tests/Properties.hs#L27-L44
--
-- 2. xmonad scores currently 22 points in the (Haskell) Reddit: "What are some
-- examples of really good Haskell code?"
-- https://www.reddit.com/r/haskell/comments/2udvkh/what_are_some_examples_of_really_good_haskell_code/
--
-- 3. http://wiki.c2.com/?DoTheSimplestThingThatCouldPossiblyWork
--
import Control.Monad (unless)
import MaitreDTests
import Test.QuickCheck (Property, Result (..), maxSize, maxSuccess,
property, quickCheckWithResult, stdArgs)
import Text.Printf (printf)
tests :: [(String, Property)]
tests =
[ ("tryAccept behaves correctly when it can accept"
, property tryAcceptBehavesCorrectlyWhenItCanAccept)
, ("tryAccept behaves correctly when it can not accept"
, property tryAcceptBehavesCorrectlyWhenItCanNotAccept) ]
main :: IO ()
main = do
let args = stdArgs { maxSuccess = 100, maxSize = 100 }
qc t = do
c <- quickCheckWithResult args t
case c of
Success{} -> return True
_ -> return False
perform (s, t) = printf "%-35s: " s >> qc t
n <- length . filter not <$> mapM perform tests
unless (n == 0) (error (show n ++ " test(s) failed"))
ProTip! Use n and p to navigate between commits in a pull request.