diff options
author | Ian Lynagh <igloo@earth.li> | 2011-07-08 01:51:18 +0100 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2011-07-08 13:12:04 +0100 |
commit | 1b10c87df24acaf5773df852727dc85a3e500e6e (patch) | |
tree | 718f19be185b4342072259db446c272299fc79b3 /quickcheck | |
parent | 3ae10e5f12c2f2904cf7b1b2b1993c83ca1c554e (diff) | |
download | haskell-1b10c87df24acaf5773df852727dc85a3e500e6e.tar.gz |
Remove old ./quickcheck/ stuff
Diffstat (limited to 'quickcheck')
-rw-r--r-- | quickcheck/HeaderInfoTests.hs | 129 | ||||
-rw-r--r-- | quickcheck/README | 9 | ||||
-rw-r--r-- | quickcheck/RunTests.hs | 62 | ||||
-rw-r--r-- | quickcheck/run.sh | 23 |
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 |