Changed tocktest so you can pass it -v options for use with the automatic tests
This commit is contained in:
Neil Brown
parent
1c1860ce7e
commit
9c4b8e8df1
22
TestMain.hs
22
TestMain.hs
|
|
@ -64,19 +64,19 @@ import System.IO
|
|||
import Test.HUnit
|
||||
|
||||
import qualified AnalyseAsmTest (tests)
|
||||
import qualified ArrayUsageCheckTest (ioqcTests)
|
||||
import qualified ArrayUsageCheckTest (vioqcTests)
|
||||
import qualified BackendPassesTest (qcTests)
|
||||
import qualified CheckTest (tests)
|
||||
import qualified CommonTest (tests)
|
||||
import qualified FlowGraphTest (qcTests)
|
||||
import qualified GenerateCTest (tests)
|
||||
import qualified OccamPassesTest (tests)
|
||||
import qualified OccamTypesTest (ioTests)
|
||||
import qualified OccamTypesTest (vioTests)
|
||||
import qualified ParseRainTest (tests)
|
||||
import qualified PassTest (tests)
|
||||
import qualified PreprocessOccamTest (tests)
|
||||
import qualified RainPassesTest (tests)
|
||||
import qualified RainTypesTest (ioTests)
|
||||
import qualified RainTypesTest (vioTests)
|
||||
import qualified SimplifyAbbrevsTest (tests)
|
||||
import qualified SimplifyTypesTest (tests)
|
||||
import qualified StructureOccamTest (tests)
|
||||
|
|
@ -89,6 +89,7 @@ data TestOption =
|
|||
| OutputType Bool -- True is plain, False is erasing
|
||||
| ListTests
|
||||
| RunJust String
|
||||
| Verbose
|
||||
deriving (Eq)
|
||||
|
||||
type TestSet = (Test, [LabelledQuickCheckTest])
|
||||
|
|
@ -109,7 +110,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
|
|||
Right level -> return level
|
||||
Left unknown -> err $ "Unknown level: " ++ unknown
|
||||
|
||||
allSets <- sequence tests
|
||||
allSets <- sequence $ tests opts
|
||||
let labelled = getLabels allSets
|
||||
selectedSets <-
|
||||
case (find (== ListTests) opts, findJust opts) of
|
||||
|
|
@ -144,6 +145,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
|
|||
, Option [] ["plain"] (NoArg (OutputType True)) "Show the test output as plain text"
|
||||
, Option ['l'] ["list-tests"] (NoArg (ListTests)) "Show the top-level test names"
|
||||
, Option ['f'] ["filter"] (ReqArg RunJust "TESTNAME") "Run just the tests that have this in their name (use -l to list)"
|
||||
, Option ['v'] ["verbose"] (NoArg Verbose) "be more verbose (use multiple times for more detail)"
|
||||
]
|
||||
|
||||
findLevel :: [TestOption] -> Either String (Maybe QuickCheckLevel)
|
||||
|
|
@ -181,27 +183,29 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
|
|||
getLabel _ t@(TestLabel label _, _) = (label, t)
|
||||
getLabel n t = ("Unknown test: " ++ show n, t)
|
||||
|
||||
tests :: [IO TestSet]
|
||||
tests = [
|
||||
tests :: [TestOption] -> [IO TestSet]
|
||||
tests opts = [
|
||||
noqc AnalyseAsmTest.tests
|
||||
,ArrayUsageCheckTest.ioqcTests
|
||||
,ArrayUsageCheckTest.vioqcTests v
|
||||
,return BackendPassesTest.qcTests
|
||||
,noqc CheckTest.tests
|
||||
,noqc CommonTest.tests
|
||||
,return FlowGraphTest.qcTests
|
||||
,noqc GenerateCTest.tests
|
||||
,noqc OccamPassesTest.tests
|
||||
,noqcButIO OccamTypesTest.ioTests
|
||||
,noqcButIO $ OccamTypesTest.vioTests v
|
||||
,noqc ParseRainTest.tests
|
||||
,noqc PassTest.tests
|
||||
,noqc PreprocessOccamTest.tests
|
||||
,noqc RainPassesTest.tests
|
||||
,noqcButIO RainTypesTest.ioTests
|
||||
,noqcButIO $ RainTypesTest.vioTests v
|
||||
,noqc SimplifyAbbrevsTest.tests
|
||||
,noqc SimplifyTypesTest.tests
|
||||
,noqc StructureOccamTest.tests
|
||||
,noqc UsageCheckTest.tests
|
||||
]
|
||||
where
|
||||
v = length $ filter (== Verbose) opts
|
||||
|
||||
noqc :: Test -> IO (Test, [LabelledQuickCheckTest])
|
||||
noqc t = return (t,[])
|
||||
|
|
|
|||
|
|
@ -80,6 +80,7 @@ findRepSolutions reps bks
|
|||
| bk <- bks]) maxInt of
|
||||
Right problems -> do
|
||||
probs <- formatProblems [(vm, prob) | (_,vm,prob) <- problems]
|
||||
debug $ "Problems in findRepSolutions:\n" ++ probs
|
||||
case mapMaybe solve problems of
|
||||
[] -> return Nothing -- No solutions, safe
|
||||
xs -> liftM (Just . unlines) $ mapM format xs
|
||||
|
|
@ -148,7 +149,7 @@ checkArrayUsage (m,p) = mapM_ (checkIndexes m) $ Map.toList $
|
|||
Right [] -> return () -- No problems to work with
|
||||
Right problems -> do
|
||||
probs <- formatProblems [(vm, prob) | (_,vm,prob) <- problems]
|
||||
debug probs
|
||||
debug $ "Problems in checkArrayUsage:\n" ++ probs
|
||||
case mapMaybe solve problems of
|
||||
-- No solutions; no worries!
|
||||
[] -> return ()
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ You should have received a copy of the GNU General Public License along
|
|||
with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
-}
|
||||
|
||||
module ArrayUsageCheckTest (ioqcTests) where
|
||||
module ArrayUsageCheckTest (vioqcTests) where
|
||||
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.State
|
||||
|
|
@ -1164,8 +1164,8 @@ qcOmegaPrune = [("Omega Test Pruning", scaleQC (100,1000,10000,50000) prop)]
|
|||
result = undefined -- TODO replace solveAndPrune: solveProblem [] inp
|
||||
-}
|
||||
|
||||
ioqcTests :: IO (Test, [LabelledQuickCheckTest])
|
||||
ioqcTests
|
||||
vioqcTests :: Int -> IO (Test, [LabelledQuickCheckTest])
|
||||
vioqcTests v
|
||||
= seqPair
|
||||
(liftM (TestLabel "ArrayUsageCheckTest" . TestList) $ sequence $
|
||||
map return [
|
||||
|
|
@ -1173,7 +1173,7 @@ ioqcTests
|
|||
,testIndexes
|
||||
,testMakeEquations
|
||||
]
|
||||
++ map (automaticTest FrontendOccam)
|
||||
++ map (automaticTest FrontendOccam v)
|
||||
["testcases/automatic/usage-check-1.occ.test"
|
||||
,"testcases/automatic/usage-check-2.occ.test"
|
||||
,"testcases/automatic/usage-check-3.occ.test"
|
||||
|
|
|
|||
|
|
@ -66,33 +66,32 @@ data AutoTest = AutoTest
|
|||
, bodies :: [TestBody]
|
||||
}
|
||||
|
||||
automaticTest :: CompFrontend -> FilePath -> IO Test
|
||||
automaticTest fr fileName = readFile fileName >>* performTest fr fileName
|
||||
automaticTest :: CompFrontend -> Int -> FilePath -> IO Test
|
||||
automaticTest fr verb fileName = readFile fileName >>* performTest fr verb fileName
|
||||
|
||||
-- Bit of a hard-hack, until usage-checking is on by default:
|
||||
defaultState :: CompFrontend -> CompState
|
||||
defaultState fr = emptyState {csUsageChecking = True, csFrontend = fr}
|
||||
defaultState :: CompFrontend -> Int -> CompState
|
||||
defaultState fr v = emptyState {csVerboseLevel = v, csFrontend = fr}
|
||||
|
||||
-- | Tests if compiling the given source gives any errors.
|
||||
-- If there are errors, they are returned. Upon success, Nothing is returned
|
||||
testOccam :: String -> IO (Maybe String)
|
||||
testOccam source = do (result,_) <- runPassM (defaultState FrontendOccam) compilation
|
||||
return $ case result of
|
||||
testOccam :: Int -> String -> IO (Maybe String)
|
||||
testOccam v source = do (result,_) <- runPassM (defaultState FrontendOccam v) compilation
|
||||
return $ case result of
|
||||
Left (_,err) -> Just err
|
||||
Right _ -> Nothing
|
||||
where
|
||||
compilation = preprocessOccamSource source
|
||||
>>= parseOccamProgram
|
||||
>>= runPasses (getPassList $ defaultState FrontendOccam)
|
||||
>>= runPasses (getPassList $ defaultState FrontendOccam v)
|
||||
|
||||
testRain :: String -> IO (Maybe String)
|
||||
testRain source = do (result,_) <- runPassM (defaultState FrontendRain) compilation
|
||||
return $ case result of
|
||||
testRain :: Int -> String -> IO (Maybe String)
|
||||
testRain v source = do (result,_) <- runPassM (defaultState FrontendRain v) compilation
|
||||
return $ case result of
|
||||
Left (_,err) -> Just err
|
||||
Right _ -> Nothing
|
||||
where
|
||||
compilation = parseRainProgram "<test>" source
|
||||
>>= runPasses (getPassList $ defaultState FrontendRain)
|
||||
>>= runPasses (getPassList $ defaultState FrontendRain v)
|
||||
|
||||
-- | Substitutes each substitution into the prologue
|
||||
substitute :: AutoTest -> Either String [(Bool, String, String)]
|
||||
|
|
@ -113,8 +112,8 @@ substitute t = sequence [ do ls <- execWriterT $ subst n (prologueLines t, ss)
|
|||
|
||||
|
||||
-- | Given a file's contents, tests it
|
||||
performTest :: CompFrontend -> String -> String -> Test
|
||||
performTest fr fileName fileContents
|
||||
performTest :: CompFrontend -> Int -> String -> String -> Test
|
||||
performTest fr v fileName fileContents
|
||||
= case parseTestFile fileContents of
|
||||
Left err -> TestCase $ assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err
|
||||
Right test -> TestLabel fileName $ TestList $
|
||||
|
|
@ -126,7 +125,7 @@ performTest fr fileName fileContents
|
|||
performTest' :: (Bool, String, String) -> Test
|
||||
performTest' (expPass, testName, testText)
|
||||
= TestCase $
|
||||
do result <- (if fr == FrontendOccam then testOccam else testRain) testText
|
||||
do result <- (if fr == FrontendOccam then testOccam else testRain) v testText
|
||||
case result of
|
||||
Just err -> if expPass then assertFailure (testName ++ " failed with error: " ++ err) else return ()
|
||||
Nothing -> if expPass then return () else assertFailure (testName ++ " expected to fail but passed")
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-- #ignore-exports
|
||||
|
||||
-- | Tests for 'OccamTypes'.
|
||||
module OccamTypesTest (ioTests) where
|
||||
module OccamTypesTest (vioTests) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Data.Generics
|
||||
|
|
@ -631,12 +631,12 @@ testOccamTypes = TestList
|
|||
|
||||
--}}}
|
||||
|
||||
ioTests :: IO Test
|
||||
ioTests = liftM (TestLabel "OccamTypesTest" . TestList) $ sequence $
|
||||
vioTests :: Int -> IO Test
|
||||
vioTests v = liftM (TestLabel "OccamTypesTest" . TestList) $ sequence $
|
||||
map return
|
||||
[ testOccamTypes
|
||||
]
|
||||
++ map (automaticTest FrontendOccam)
|
||||
++ map (automaticTest FrontendOccam v)
|
||||
[ "testcases/automatic/direction-decorators-1.occ.test"
|
||||
, "testcases/automatic/direction-decorators-2.occ.test"
|
||||
, "testcases/automatic/direction-decorators-3.occ.test"
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
-}
|
||||
|
||||
-- | A module testing things from the RainTypes module.
|
||||
module RainTypesTest (ioTests) where
|
||||
module RainTypesTest (vioTests) where
|
||||
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Error
|
||||
|
|
@ -108,10 +108,10 @@ testUnify = TestList [] {-
|
|||
where
|
||||
names = take (min (length xs) (length ys)) $ map (:[]) ['a'..]
|
||||
-}
|
||||
ioTests :: IO Test
|
||||
ioTests = liftM (TestLabel "RainTypesTest" . TestList) $ sequence
|
||||
vioTests :: Int -> IO Test
|
||||
vioTests v = liftM (TestLabel "RainTypesTest" . TestList) $ sequence
|
||||
[
|
||||
return constantFoldTest
|
||||
,return testUnify
|
||||
,automaticTest FrontendRain "testcases/automatic/unify-types-1.rain.test"
|
||||
,automaticTest FrontendRain v "testcases/automatic/unify-types-1.rain.test"
|
||||
]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user