2c4ccfbf39
I've checked these all against the Darcs history using a script (check-copyright, in my misccode collection). Anything Neil or I did as part of our PhDs is copyright University of Kent; more recent work belongs to us, as appropriate.
116 lines
3.8 KiB
Haskell
116 lines
3.8 KiB
Haskell
{-
|
|
Tock: a compiler for parallel languages
|
|
Copyright (C) 2007, 2008, 2009 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/>.
|
|
-}
|
|
|
|
-- | A module testing things from the RainTypes module.
|
|
module RainTypesTest (vioTests) where
|
|
|
|
--import Control.Monad.Error
|
|
import Control.Monad.Writer
|
|
--import Data.Generics (Data)
|
|
--import qualified Data.Map as Map
|
|
import Test.HUnit hiding (State)
|
|
|
|
|
|
--import qualified AST as A
|
|
import CompState
|
|
--import Errors
|
|
--import Metadata
|
|
--import Pass
|
|
--import Pattern
|
|
--import RainTypes
|
|
--import TagAST
|
|
import TestHarness
|
|
--import TestUtils
|
|
--import TreeUtils
|
|
--import Types
|
|
--import TypeUnification
|
|
--import Utils
|
|
|
|
|
|
-- | Tests that constants in expressions are folded properly. TODO these tests could do with a lot of expanding.
|
|
-- It may even be easiest to use QuickCheck for the testing.
|
|
constantFoldTest :: Test
|
|
constantFoldTest = TestList [] {-
|
|
[
|
|
foldVar 0 $ Var "x"
|
|
,foldVar 1 $ Dy (Var "x") A.Plus (lit 0)
|
|
|
|
,foldCon 100 (lit 2) (Dy (lit 1) A.Plus (lit 1))
|
|
,foldCon 101 (lit 65537) (Dy (lit 2) A.Plus (lit 65535))
|
|
,foldCon 102 (lit (- two63)) (Dy (lit $ two63 - 1) A.Plus (lit 1))
|
|
|
|
,foldCon 110 (Dy (Var "x") A.Plus (lit 2)) (Dy (Var "x") A.Plus (Dy (lit 1) A.Plus (lit 1)))
|
|
]
|
|
where
|
|
two63 :: Integer
|
|
two63 = 9223372036854775808
|
|
|
|
foldVar :: Int -> ExprHelper -> Test
|
|
foldVar n e = TestCase $ testPass ("constantFoldTest " ++ show n) (buildExprPattern e) constantFoldPass (buildExpr e) state
|
|
|
|
foldCon :: Int -> ExprHelper -> ExprHelper -> Test
|
|
foldCon n exp orig = TestCase $ testPass ("constantFoldTest " ++ show n) (buildExprPattern exp) constantFoldPass (buildExpr orig) state
|
|
|
|
state :: State CompState ()
|
|
state = defineVariable "x" A.Int64
|
|
|
|
lit :: Integer -> ExprHelper
|
|
lit n = Lit $ int64Literal n
|
|
-}
|
|
testUnify :: Test
|
|
testUnify = TestList [] {-
|
|
[pass [] [] []
|
|
,pass' [("a",A.Int)] []
|
|
,pass' [("a",A.Int)] [("a","a")]
|
|
,pass2 [A.Int, A.Infer] [A.Int, A.Int]
|
|
,pass2 [A.List A.Int, A.List A.Infer] [A.List A.Int, A.List A.Int]
|
|
,fail [("a", A.Int), ("b", A.List A.Infer)] [("a","b")]
|
|
,fail [("a", A.Infer)] []
|
|
,fail [("a", A.Infer), ("b", A.Infer)] [("a","b")]
|
|
|
|
-- Numeric things:
|
|
,pass2 [A.InferNum 3, A.Int32] [A.Int32, A.Int32]
|
|
]
|
|
where
|
|
pass :: [(String, A.Type)] -> [(String, String)] -> [(String, A.Type)]
|
|
-> Test
|
|
pass im u om = TestCase $ assertEqual "testUnify" (Right $ Map.fromList om)
|
|
=<< unifyRainTypes (Map.fromList $ map transformPair
|
|
id im) u
|
|
|
|
fail :: [(String, A.Type)] -> [(String, String)] -> Test
|
|
fail im u = TestCase $ case unifyRainTypes (Map.fromList im) u of
|
|
Left _ -> return ()
|
|
Right om -> assertEqual "testUnify" Nothing $ Just om
|
|
|
|
pass' :: [(String, A.Type)] -> [(String, String)] -> Test
|
|
pass' x y = pass x y x
|
|
|
|
pass2 :: [A.Type] -> [A.Type] -> Test
|
|
pass2 xs ys = pass (zip names xs) (allPairs names) (zip names ys)
|
|
where
|
|
names = take (min (length xs) (length ys)) $ map (:[]) ['a'..]
|
|
-}
|
|
vioTests :: Int -> IO Test
|
|
vioTests v = liftM (TestLabel "RainTypesTest" . TestList) $ sequence
|
|
[
|
|
return constantFoldTest
|
|
,return testUnify
|
|
,automaticTest FrontendRain v "testcases/automatic/unify-types-1.rain.test"
|
|
]
|