Migrate testing/Main.hs to TestFramework
authorMichal Terepeta <michal.terepeta@gmail.com>
Sat, 30 May 2015 12:18:26 +0000 (14:18 +0200)
committerMichal Terepeta <michal.terepeta@gmail.com>
Sun, 31 May 2015 09:16:00 +0000 (11:16 +0200)
This is (hopefully) a first step to cleaning up and extending
Hoopl's testsuite. In the future I'd like to add some QuickCheck
tests, so I wanted to use a testing framework that would make
it easy to handle both HUnit and QuickCheck tests.

Note that we considered using tasty (instead of test-framework),
but it doesn't support GHC <7.4, which Hoopl does support.

hoopl.cabal
testing/Main.hs
testing/Test.hs

index ac77173..200b438 100644 (file)
@@ -81,8 +81,11 @@ Test-Suite hoopl-test
   Hs-Source-Dirs:    testing src
   Build-Depends:     base >= 4.3 && < 4.9, 
                      containers >= 0.4 && < 0.6,
+                     filepath,
+                     mtl >= 2.1.3.1,
                      parsec >= 3.1.7,
-                     mtl >= 2.1.3.1
+                     test-framework < 0.9,
+                     test-framework-hunit < 0.4
   if flag(testcoverage) {
     Ghc-Options: -fhpc
   }
index a6f90f0..8b5d0ca 100644 (file)
@@ -1,20 +1,37 @@
 module Main (main) where
 
-import Test
-import System.IO
+import qualified System.FilePath as FilePath
 
--- Hardcoding test locations for now
-tests = map (\t -> "testing" ++ "/" ++ "tests" ++ "/" ++ t)
-        (["test1", "test2", "test3", "test4"] ++
-             ["if-test", "if-test2", "if-test3", "if-test4"])
-        
-test_expected_results = map (\t -> "testing" ++ "/" ++ "tests" ++ "/" ++ t)
-                        (["test1.expected", "test2.expected", "test3.expected", "test4.expected"] ++
-                         ["if-test.expected", "if-test2.expected", "if-test3.expected", "if-test4.expected"])
-        
+import qualified Test.Framework as Framework
+import qualified Test.Framework.Providers.HUnit as HUnit
+
+import qualified Test
 
 main :: IO ()
-main = do hSetBuffering stdout NoBuffering
-          hSetBuffering stderr NoBuffering
-          mapM (\(x, ex) -> putStrLn ("Test:" ++ x) >> parseTest x >> optTest x ex) (zip tests test_expected_results)
-          return ()
+main = Framework.defaultMain tests
+
+tests :: [Framework.Test]
+tests = [goldensTests]
+
+-- | All the tests that depend on reading an input file with a simple program,
+-- parsing and optimizing it and then comparing with an expected output.
+goldensTests :: Framework.Test
+goldensTests = Framework.testGroup "Goldens tests"
+    [ HUnit.testCase inputFile $ compareWithExpected inputFile expectedFile
+    | (inputFile, expectedFile) <- zip inputFiles expectedFiles ]
+  where
+    compareWithExpected = Test.optTest
+    inputFiles = [ basePath FilePath.</> test | test <- testFileNames ]
+    expectedFiles = [ basePath FilePath.</> test FilePath.<.> "expected"
+                    | test <- testFileNames ]
+    basePath = "testing" FilePath.</> "tests"
+    testFileNames =
+        [ "test1"
+        , "test2"
+        , "test3"
+        , "test4"
+        , "if-test"
+        , "if-test2"
+        , "if-test3"
+        , "if-test4"
+        ]
index f007b49..1f83c72 100644 (file)
@@ -15,8 +15,6 @@ import IR
 import Live
 import Parse (parseCode)
 import Simplify
-import Debug.Trace
-
 parse :: String -> String -> ErrorM (M [(IdLabelMap, Proc)])
 parse file text =
   case parseCode file text of
@@ -55,7 +53,6 @@ optTest' procs =
     optProc proc@(Proc {entry, body, args}) =
       do { (body',  _, _) <- analyzeAndRewriteFwd fwd (JustC [entry]) body
                              (mapSingleton entry (initFact args))
-         ; trace (showProc (proc {body=body'})) $ return ()
          ; (body'', _, _) <- analyzeAndRewriteBwd bwd (JustC [entry]) body' mapEmpty
          ; return $ proc { body = body'' } }
     -- With debugging info: 
@@ -115,7 +112,6 @@ optTest file expectedFile =
            Right p  -> do { let opted = runSimpleUniqueMonad $ runWithFuel fuel p
                                 lbmaps = runSimpleUniqueMonad $ runWithFuel fuel (liftM (fst . unzip) lps)
                                 expected = runSimpleUniqueMonad $ runWithFuel fuel exps
-                          ; mapM_ (putStrLn . showProc) opted
                           ; compareAst (toAst (zip lbmaps opted)) (toAst expected)
                           }
   where