Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 56b5d5edcf
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

executable file 56 lines (48 sloc) 2.208 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
#!/usr/bin/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)
-- Other options (beginning with + or -) are passed unchanged to hugs.
--
-- Change the first line of this file to the location of runhugs on your
-- system.
-- Make the file executable.
--
-- TODO:
-- someone on #haskell asked about supporting QC tests inside LaTeX, ex. \{begin} \{end}, how?
-- add a verbosity switch that uses verboseCheck instead of quickCheck

import System
import List

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 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 ((":l "++file):
[(if namesOpt=="+names" then
"putStr \""++p++": \" >> "
else "") ++
-- The stdArgs settings here are actually those defined by stdArgs, but they're here for easy changing.
"Test.QuickCheck.quickCheckWith (stdArgs { maxSuccess = 100, maxDiscard = 500, maxSize = 100}) "++p | p<-names])
system ("ghci -v0 "++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)
Something went wrong with that request. Please try again.