Changed the test harness to get some tests inside the IO monad. This allows all the tests to be run, not just until the first failure

TestMain.hs

@@ -39,6 +39,7 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 -- * "RainUsageCheckTest"
 module TestMain () where
 
+import Control.Monad
 import System.Console.GetOpt
 import System.Environment
 import Test.HUnit
@@ -68,9 +69,10 @@ main = do opts <- getArgs >>* getOpt RequireOrder options
                        ([Left unknownLevel], [], []) -> err ("Unknown level: " ++ unknownLevel)
                        (_,_,errs) -> err (concat errs)
 
-          runTestTT hunitTests
+          hunitTests >>= runTestTT
           case qcLevel of
-            Just level -> sequence_ $ applyAll level qcTests
+            -- Monadic mess!
+            Just level -> join $ liftM sequence_ $ (liftM $ applyAll level) qcTests
             Nothing -> return ()
   where
     err msg = ioError (userError (msg ++ usageInfo header options))
@@ -87,14 +89,16 @@ main = do opts <- getArgs >>* getOpt RequireOrder options
                      "extensive" -> Right $ Just QC_Extensive
                      unknown -> Left unknown
 
-    hunitTests = TestList $ map fst tests
-    qcTests = concatMap snd tests
+    hunitTests :: IO Test
+    hunitTests = sequence tests >>* (TestList . fst . unzip)
+    qcTests :: IO [QuickCheckTest]
+    qcTests = concatMapM (liftM snd) tests
 
     tests = [
               ArrayUsageCheckTest.qcTests
               ,noqc BackendPassesTest.tests
               ,noqc CommonTest.tests
-              ,FlowGraphTest.qcTests
+              ,return FlowGraphTest.qcTests
               ,noqc GenerateCTest.tests
               ,noqc ParseRainTest.tests
               ,noqc PassTest.tests
@@ -103,5 +107,6 @@ main = do opts <- getArgs >>* getOpt RequireOrder options
               ,noqc RainUsageCheckTest.tests
             ]
 
-    noqc :: Test -> (Test, [QuickCheckTest])
-    noqc t = (t,[])
+    noqc :: Test -> IO (Test, [QuickCheckTest])
+    noqc t = return (t,[])
+

common/TestHarness.hs

@@ -46,8 +46,8 @@ import PassList
 import PreprocessOccam
 import Utils
 
-automaticTest :: FilePath -> Test
-automaticTest fileName = TestCase $ readFile fileName >>= performTest
+automaticTest :: FilePath -> IO Test
+automaticTest fileName = readFile fileName >>* performTest
 
 -- Bit of a hard-hack, until usage-checking is on by default:
 defaultState :: CompState
@@ -63,20 +63,21 @@ testOccam source = do result <- evalStateT (runErrorT compilation) defaultState
   where
     compilation = preprocessOccamSource source >>= parseOccamProgram >>= runPasses (getPassList defaultState)
 -- | Given a file's contents, tests it
-performTest :: String -> Assertion
+performTest :: String -> Test
 performTest fileName
   = case parseTestFile fileName of
-      Left err -> assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err
-      Right (prologue,tests) -> mapM_ performTest' (substitute prologue tests)
+      Left err -> TestCase $ assertFailure $ "Error processing file \"" ++ fileName ++ "\": " ++ err
+      Right (prologue,tests) -> TestList $ map performTest' (substitute prologue tests)
       
   where
     -- Substitutes each substitution into the prologue
     substitute :: String -> [(Bool, String, String)] -> [(Bool, String, String)]
     substitute prologue = map (\(a,b,subst) -> (a,b,subRegex (mkRegex "%%") prologue subst))
     
-    performTest' :: (Bool, String, String) -> Assertion
+    performTest' :: (Bool, String, String) -> Test
     performTest' (expPass, testName, testText)
-      = do result <- testOccam testText
+      = TestCase $ 
+        do result <- testOccam 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")

transformations/ArrayUsageCheckTest.hs

@@ -31,7 +31,6 @@ import Test.QuickCheck hiding (check)
 
 import ArrayUsageCheck
 import qualified AST as A
-import PrettyShow
 import TestHarness
 import TestUtils hiding (m)
 import Utils
@@ -713,15 +712,18 @@ qcOmegaPrune = [scaleQC (100,1000,10000,50000) prop]
         result = undefined -- TODO replace solveAndPrune: solveProblem [] inp
     -}
     
-qcTests :: (Test, [QuickCheckTest])
-qcTests = (TestList
- [
-   testArrayCheck
-  ,testIndexes
-  ,testMakeEquations
-  ,automaticTest "testcases/automatic/usage-check-1.occ.test"
- ]
- ,qcOmegaEquality ++ qcOmegaPrune)
+qcTests :: IO (Test, [QuickCheckTest])
+qcTests
+  = do usageCheckTest <- automaticTest "testcases/automatic/usage-check-1.occ.test"
+       return
+        (TestList
+        [
+          testArrayCheck
+         ,testIndexes
+         ,testMakeEquations
+         ,usageCheckTest
+        ]
+        ,qcOmegaEquality ++ qcOmegaPrune)