summaryrefslogtreecommitdiff
path: root/quickcheck
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2011-07-08 01:51:18 +0100
committerIan Lynagh <igloo@earth.li>2011-07-08 13:12:04 +0100
commit1b10c87df24acaf5773df852727dc85a3e500e6e (patch)
tree718f19be185b4342072259db446c272299fc79b3 /quickcheck
parent3ae10e5f12c2f2904cf7b1b2b1993c83ca1c554e (diff)
downloadhaskell-1b10c87df24acaf5773df852727dc85a3e500e6e.tar.gz
Remove old ./quickcheck/ stuff
Diffstat (limited to 'quickcheck')
-rw-r--r--quickcheck/HeaderInfoTests.hs129
-rw-r--r--quickcheck/README9
-rw-r--r--quickcheck/RunTests.hs62
-rw-r--r--quickcheck/run.sh23
4 files changed, 0 insertions, 223 deletions
diff --git a/quickcheck/HeaderInfoTests.hs b/quickcheck/HeaderInfoTests.hs
deleted file mode 100644
index 6f8bef6239..0000000000
--- a/quickcheck/HeaderInfoTests.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-module HeaderInfoTests
- ( prop_optionsIdentity
- , prop_languageParse
- , prop_languageError
- ) where
-
-import Test.QuickCheck
-import Test.QuickCheck.Batch
-import Data.Char
-
-import Control.Monad
-import System.IO.Unsafe
-
-import HeaderInfo
-import StringBuffer
-import SrcLoc
-
-import Language.Haskell.Extension
-
-newtype CmdOptions = CmdOptions {cmdOptions :: [String]}
- deriving Show
-
-instance Arbitrary CmdOptions where
- arbitrary = resize 30 $ liftM CmdOptions arbitrary
- coarbitrary = undefined
-
-instance Arbitrary Char where
- arbitrary = elements $ ['a'..'z']++['A'..'Z']
- coarbitrary = undefined
-
-data Options = Options
- | Options_GHC
- deriving Show
-
-instance Arbitrary Options where
- arbitrary = elements [Options,Options_GHC]
- coarbitrary = undefined
-
--- Test that OPTIONS are correctly extracted from a buffer
--- with comments and garbage.
-prop_optionsIdentity lowercase options cmds
- = not (null cmds) ==>
- all (all (not.null).cmdOptions) cmds ==>
- concatMap cmdOptions cmds == map unLoc (getOptions buffer "somefile")
- where buffer = unsafePerformIO $ stringToStringBuffer str
- str = concatMap mkPragma cmds ++
- "\n @#@# garbage #@#@ \n"
- mkPragma (CmdOptions cmd)
- = unlines [ "-- Pragma: "
- , unwords $ ["{-#", pragma]++cmd++["#-}"]
- , "{- End of pragma -}" ]
- pragma = (if lowercase then map toLower else map toUpper) $
- case options of
- Options -> "OPTIONS"
- Options_GHC -> "OPTIONS_GHC"
-
-newtype Extensions = Extensions [Extension]
- deriving Show
-
-instance Arbitrary Extensions where
- arbitrary = resize 30 $ liftM Extensions arbitrary
- coarbitrary = undefined
-
-extensions :: [Extension]
-extensions = [ OverlappingInstances
- , UndecidableInstances
- , IncoherentInstances
- , RecursiveDo
- , ParallelListComp
- , MultiParamTypeClasses
- , NoMonomorphismRestriction
- , FunctionalDependencies
- , Rank2Types
- , RankNTypes
- , PolymorphicComponents
- , ExistentialQuantification
- , ScopedTypeVariables
- , ImplicitParams
- , FlexibleContexts
- , FlexibleInstances
- , EmptyDataDecls
- , CPP
- , TypeSynonymInstances
- , TemplateHaskell
- , ForeignFunctionInterface
- , InlinePhase
- , ContextStack
- , Arrows
- , Generics
- , NoImplicitPrelude
- , NamedFieldPuns
- , PatternGuards
- , GeneralizedNewtypeDeriving
- , ExtensibleRecords
- , RestrictedTypeSynonyms
- , HereDocuments ]
-
--- derive Enum for Extension?
-instance Arbitrary Extension where
- arbitrary = elements extensions
- coarbitrary = undefined
-
--- Test that we can parse all known extensions.
-prop_languageParse lowercase (Extensions exts)
- = not (null exts) ==>
- not (isBottom (getOptions buffer "somefile"))
- where buffer = unsafePerformIO $ stringToStringBuffer str
- str = unlines [ "-- Pragma: "
- , unwords $ ["{-#", pragma, ppExts exts "" , "#-}"]
- , "{- End of pragma -}"
- , "garbage#@$#$" ]
- ppExts [e] = shows e
- ppExts (x:xs) = shows x . showChar ',' . ppExts xs
- ppExts [] = id
- pragma = (if lowercase then map toLower else map toUpper)
- "LANGUAGE"
-
--- Test that invalid extensions cause exceptions.
-prop_languageError lowercase ext
- = not (null ext) ==>
- ext `notElem` map show extensions ==>
- isBottom (foldr seq () (getOptions buffer "somefile"))
- where buffer = unsafePerformIO $ stringToStringBuffer str
- str = unlines [ "-- Pragma: "
- , unwords $ ["{-#", pragma, ext , "#-}"]
- , "{- End of pragma -}"
- , "garbage#@$#$" ]
- pragma = (if lowercase then map toLower else map toUpper)
- "LANGUAGE"
diff --git a/quickcheck/README b/quickcheck/README
deleted file mode 100644
index 251bc807e0..0000000000
--- a/quickcheck/README
+++ /dev/null
@@ -1,9 +0,0 @@
-QuickCheck for the GHC library.
-
-Requirements:
- stage2 of ghc.
-
-Usage:
- ./run.sh
- ./run.sh debug # runs quickCheck in debug mode.
- ./run.sh ghci [file] # loads [file] with the stage2 compiler.
diff --git a/quickcheck/RunTests.hs b/quickcheck/RunTests.hs
deleted file mode 100644
index 4aabb48584..0000000000
--- a/quickcheck/RunTests.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-module RunTests where
-
-import Test.QuickCheck.Batch hiding (runTests)
-import System.Exit
-import System.Environment
-
-import HeaderInfoTests as HI
-
-runUnitTests :: Bool -> IO ()
-runUnitTests debug = exitWith =<< performTests debug
-
-performTests :: Bool -> IO ExitCode
-performTests debug =
- do e1 <- exeTests "HeaderInfo" opts
- [ run HI.prop_optionsIdentity
- , run HI.prop_languageParse
- , run HI.prop_languageError ]
- return (foldr1 cat [e1])
- where opts = TestOptions 100 10 debug
- cat (e@(ExitFailure _)) _ = e
- cat _ e = e
-
-exeTests :: String -> TestOptions -> [TestOptions -> IO TestResult] -> IO ExitCode
-exeTests name scale actions =
- do putStr (rjustify 25 name ++ " : ")
- tr 1 actions [] 0 False
- where
- rjustify n s = replicate (max 0 (n - length s)) ' ' ++ s
- tr n [] xs c e = do
- putStr (rjustify (max 0 (35-n)) " (" ++ show c ++ ")\n")
- mapM_ fa xs
- if e
- then return (ExitFailure 1)
- else return ExitSuccess
- tr n (action:actions) others c e =
- do r <- action scale
- case r of
- (TestOk _ m _)
- -> do { putStr "." ;
- tr (n+1) actions others (c+m) e }
- (TestExausted s m ss)
- -> do { putStr "?" ;
- tr (n+1) actions others (c+m) e }
- (TestAborted e)
- -> do { print e;
- putStr "*" ;
- tr (n+1) actions others c True }
- (TestFailed f num)
- -> do { putStr "#" ;
- tr (n+1) actions ((f,n,num):others) (c+num) True }
- fa :: ([String],Int,Int) -> IO ()
- fa (f,n,no) =
- do putStr "\n"
- putStr (" ** test "
- ++ show (n :: Int)
- ++ " of "
- ++ name
- ++ " failed with the binding(s)\n")
- sequence_ [putStr (" ** " ++ v ++ "\n")
- | v <- f ]
- putStr "\n"
-
diff --git a/quickcheck/run.sh b/quickcheck/run.sh
deleted file mode 100644
index cff728abee..0000000000
--- a/quickcheck/run.sh
+++ /dev/null
@@ -1,23 +0,0 @@
-#!/bin/sh
-
-# I suck at bash scripting. Please feel free to make this code better.
-
-Root=../compiler
-
-ExtraOptions="-cpp -fglasgow-exts -package ghc"
-
-HC=$Root/stage2/ghc-inplace
-
-Debug="False"
-
-if [ "$1" == "debug" ]
- then
- Debug="True"
-fi
-
-if [ "$1" == "ghci" ]
- then
- $HC --interactive $ExtraOptions $2
- else
- $HC --interactive -e "runUnitTests $Debug" $ExtraOptions RunTests.hs
-fi \ No newline at end of file