Remove old ./quickcheck/ stuff
authorIan Lynagh <igloo@earth.li>
Fri, 8 Jul 2011 00:51:18 +0000 (01:51 +0100)
committerIan Lynagh <igloo@earth.li>
Fri, 8 Jul 2011 12:12:04 +0000 (13:12 +0100)
quickcheck/HeaderInfoTests.hs [deleted file]
quickcheck/README [deleted file]
quickcheck/RunTests.hs [deleted file]
quickcheck/run.sh [deleted file]

diff --git a/quickcheck/HeaderInfoTests.hs b/quickcheck/HeaderInfoTests.hs
deleted file mode 100644 (file)
index 6f8bef6..0000000
+++ /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 (file)
index 251bc80..0000000
+++ /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 (file)
index 4aabb48..0000000
+++ /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 (file)
index cff728a..0000000
+++ /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