Added Makefile and horrifying test framework
This commit is contained in:
parent
4557f4acd3
commit
c6a05179e0
|
@ -0,0 +1,11 @@
|
||||||
|
all: .tests shpell
|
||||||
|
true
|
||||||
|
|
||||||
|
shpell:
|
||||||
|
ghc --make shpell #GHC handles the dependencies
|
||||||
|
|
||||||
|
.tests: *.hs */*.hs
|
||||||
|
./test/runQuack && touch .tests
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -f .tests shpell *.hi *.o Shpell/*.hi Shpell/*.o
|
|
@ -0,0 +1,65 @@
|
||||||
|
#!/usr/bin/env runhaskell
|
||||||
|
-- #!/usr/bin/env runhugs
|
||||||
|
-- $Id: quickcheck,v 1.4 2003/01/08 15:09:22 shae Exp $
|
||||||
|
-- This file defines a command
|
||||||
|
-- quickCheck <options> <files>
|
||||||
|
-- which invokes quickCheck on all properties defined in the files given as
|
||||||
|
-- arguments, by generating an input script for hugs and then invoking it.
|
||||||
|
-- quickCheck recognises the options
|
||||||
|
-- +names print the name of each property before checking it
|
||||||
|
-- -names do not print property names (the default)
|
||||||
|
-- +verbose displays each test case before running
|
||||||
|
-- -verbose do not displays each test case before running (the default)
|
||||||
|
-- Other options (beginning with + or -) are passed unchanged to hugs.
|
||||||
|
--
|
||||||
|
-- Change the first line of this file to the location of runhaskell or runhugs
|
||||||
|
-- on your system.
|
||||||
|
-- Make the file executable.
|
||||||
|
--
|
||||||
|
-- TODO:
|
||||||
|
-- someone on #haskell asked about supporting QC tests inside LaTeX, ex. \{begin} \{end}, how?
|
||||||
|
|
||||||
|
import System.Cmd
|
||||||
|
import System.Directory (findExecutable)
|
||||||
|
import System.Environment
|
||||||
|
import Data.List
|
||||||
|
import Data.Maybe (fromJust)
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do as<-getArgs
|
||||||
|
sequence_ (map (process (filter isOption as))
|
||||||
|
(filter (not.isOption) as))
|
||||||
|
|
||||||
|
-- ugly hack for .lhs files, is there a better way?
|
||||||
|
unlit [] = []
|
||||||
|
unlit x = if (head x) == '>' then (tail x) else x
|
||||||
|
|
||||||
|
process opts file =
|
||||||
|
let (namesOpt,opts') = getOption "names" "-names" opts
|
||||||
|
(verboseOpt,opts'') = getOption "verbose" "-verbose" opts' in
|
||||||
|
do xs<-readFile file
|
||||||
|
let names = nub$ filter (\x -> (("> prop_" `isPrefixOf` x) || ("prop_" `isPrefixOf` x)))
|
||||||
|
(map (fst.head.lex.unlit) (lines xs))
|
||||||
|
if null names then
|
||||||
|
putStr (file++": no properties to check\n")
|
||||||
|
else do writeFile "hugsin"$
|
||||||
|
unlines ((":load "++file):
|
||||||
|
":m +Test.QuickCheck":
|
||||||
|
"let quackCheck p = quickCheckWith (stdArgs { maxSuccess = 1 }) p ":
|
||||||
|
[(if namesOpt=="+names" then
|
||||||
|
"putStr \""++p++": \" >> "
|
||||||
|
else "") ++
|
||||||
|
("quackCheck ")
|
||||||
|
++ p | p<-names])
|
||||||
|
-- To use ghci
|
||||||
|
ghci <- findExecutable "ghci"
|
||||||
|
system (fromJust ghci ++options opts''++" <hugsin")
|
||||||
|
return ()
|
||||||
|
|
||||||
|
isOption xs = head xs `elem` "-+"
|
||||||
|
|
||||||
|
options opts = unwords ["\""++opt++"\"" | opt<-opts]
|
||||||
|
|
||||||
|
getOption name def opts =
|
||||||
|
let opt = head [opt | opt<-opts++[def], isPrefixOf name (drop 1 opt)] in
|
||||||
|
(opt, filter (/=opt) opts)
|
|
@ -0,0 +1,19 @@
|
||||||
|
#!/bin/bash
|
||||||
|
# Todo: Find a way to make this not suck.
|
||||||
|
|
||||||
|
[[ -e test/quackCheck.hs ]] || { echo "Are you running me from the wrong directory?"; exit 1; }
|
||||||
|
|
||||||
|
find . -name '*.hs' -exec bash -c '
|
||||||
|
grep -v "^module " "$1" > quack.tmp.hs
|
||||||
|
./test/quackCheck.hs +names quack.tmp.hs
|
||||||
|
' -- {} \; 2>&1 | grep -i FAIL
|
||||||
|
result=$?
|
||||||
|
rm -f quack.tmp.hs hugsin
|
||||||
|
|
||||||
|
if [[ $result == 0 ]]
|
||||||
|
then
|
||||||
|
exit 1
|
||||||
|
else
|
||||||
|
exit 0
|
||||||
|
fi
|
||||||
|
|
Loading…
Reference in New Issue