Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/1b10c87df24acaf5773df852727dc85a3e500e6e >--------------------------------------------------------------- commit 1b10c87df24acaf5773df852727dc85a3e500e6e Author: Ian Lynagh <[email protected]> Date: Fri Jul 8 01:51:18 2011 +0100 Remove old ./quickcheck/ stuff >--------------------------------------------------------------- quickcheck/HeaderInfoTests.hs | 129 ----------------------------------------- quickcheck/README | 9 --- quickcheck/RunTests.hs | 62 -------------------- 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 6f8bef6..0000000 --- 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 251bc80..0000000 --- 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 4aabb48..0000000 --- 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 cff728a..0000000 --- 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 _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
