Added a file for testcases for checks that use the new framework

Makefile.am

@@ -169,6 +169,7 @@ tocktest_SOURCES += backends/AnalyseAsmTest.hs
 tocktest_SOURCES += backends/BackendPassesTest.hs
 tocktest_SOURCES += backends/GenerateCTest.hs
 tocktest_SOURCES += checks/ArrayUsageCheckTest.hs
+tocktest_SOURCES += checks/CheckTest.hs
 tocktest_SOURCES += checks/UsageCheckTest.hs
 tocktest_SOURCES += common/CommonTest.hs
 tocktest_SOURCES += common/OccamEDSL.hs

TestMain.hs

@@ -24,6 +24,8 @@ with this program.  If not, see <http://www.gnu.org/licenses/>.
 --
 -- * "BackendPassesTest"
 --
+-- * "CheckTest"
+--
 -- * "CommonTest"
 --
 -- * "FlowGraphTest"
@@ -64,6 +66,7 @@ import Test.HUnit
 import qualified AnalyseAsmTest (tests)
 import qualified ArrayUsageCheckTest (ioqcTests)
 import qualified BackendPassesTest (qcTests)
+import qualified CheckTest (tests)
 import qualified CommonTest (tests)
 import qualified FlowGraphTest (qcTests)
 import qualified GenerateCTest (tests)
@@ -183,6 +186,7 @@ main = do (opts, nonOpts, errs) <- getArgs >>* getOpt RequireOrder options
               noqc AnalyseAsmTest.tests
               ,ArrayUsageCheckTest.ioqcTests
               ,return BackendPassesTest.qcTests
+              ,noqc CheckTest.tests
               ,noqc CommonTest.tests
               ,return FlowGraphTest.qcTests
               ,noqc GenerateCTest.tests

checks/CheckFramework.hs

@@ -189,6 +189,9 @@ runChecks :: CheckOptM () -> A.AST -> PassM A.AST
 runChecks (CheckOptM m) x = execStateT m (CheckOptData {ast = x, parItems = Nothing})
   >>* ast
 
+runChecksPass :: CheckOptM () -> Pass
+runChecksPass c = pass "<Check>" [] [] (mkM (runChecks c))
+
 --getParItems :: CheckOptM (ParItems ())
 --getParItems = CheckOptM (\d -> Right (d, fromMaybe (generateParItems $ ast d) (parItems d)))
 

checks/CheckTest.hs

@@ -0,0 +1,57 @@
+{-
+Tock: a compiler for parallel languages
+Copyright (C) 2008  University of Kent
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation, either version 2 of the License, or (at your
+option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+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 CheckTest (tests) where
+
+import Test.HUnit
+
+import qualified AST as A
+import CheckFramework
+import Metadata
+import TestUtils
+
+-- TEMP:
+checkUnusedVar = return ()
+
+wrapProcSeq :: A.Structured A.Process -> A.AST
+wrapProcSeq x = A.Spec emptyMeta (A.Specification emptyMeta (simpleName "foo")
+  $ A.Proc emptyMeta A.PlainSpec [] $ A.Seq emptyMeta x) (A.Only emptyMeta ())
+
+testUnusedVar :: Test
+testUnusedVar = TestList
+ [
+  test' "No vars" (A.Several emptyMeta [] :: A.AST)
+ ,test' "Used var" $ wrapProcSeq $ A.Spec emptyMeta (A.Specification emptyMeta (simpleName
+   "x") $ A.Declaration emptyMeta A.Int) $ A.Only emptyMeta $ A.Assign emptyMeta
+     [variable "x"] (A.ExpressionList emptyMeta [intLiteral 0])
+ ,test "Unused var" (wrapProcSeq $ A.Spec emptyMeta (A.Specification emptyMeta (simpleName
+   "x") $ A.Declaration emptyMeta A.Int) $ A.Only emptyMeta (A.Skip emptyMeta))
+     (wrapProcSeq $ A.Only emptyMeta (A.Skip emptyMeta))
+ ]
+ where
+   test' str src = test str src src
+   test str exp src = TestCase $ testPass str exp (runChecksPass checkUnusedVar) src (return
+     ())
+
+tests :: Test
+tests = TestLabel "CheckTest" $ TestList
+ [
+  testUnusedVar
+ ]
+
+