diff --git a/common/TestUtil.hs b/common/TestUtil.hs index 20b3c3d..832cf5a 100644 --- a/common/TestUtil.hs +++ b/common/TestUtil.hs @@ -118,6 +118,17 @@ intLiteral n = A.Literal emptyMeta A.Int $ A.IntLiteral emptyMeta (show n) intLiteralPattern :: Integer -> Pattern intLiteralPattern = (stopCaringPattern emptyMeta) . mkPattern . intLiteral + +-- | Creates an integer literal 'A.Expression' with the given integer. +int64Literal :: Integer -> A.Expression +int64Literal n = A.Literal emptyMeta A.Int64 $ A.IntLiteral emptyMeta (show n) + +-- | Creates a 'Pattern' to match an 'A.Expression' instance. +-- @'assertPatternMatch' ('intLiteralPattern' x) ('intLiteral' x)@ will always succeed. +-- All meta tags are ignored. +int64LiteralPattern :: Integer -> Pattern +int64LiteralPattern = (stopCaringPattern emptyMeta) . mkPattern . int64Literal + -- | Creates a pair of variable lists, given a pair of variable-name lists as input. makeNamesWR :: ([String],[String]) -> ([A.Variable],[A.Variable]) makeNamesWR (x,y) = (map variable x,map variable y) diff --git a/frontends/RainTypesTest.hs b/frontends/RainTypesTest.hs index f521033..9ffc38b 100644 --- a/frontends/RainTypesTest.hs +++ b/frontends/RainTypesTest.hs @@ -18,16 +18,39 @@ with this program. If not, see . module RainTypesTest where -import Test.HUnit +import Test.HUnit hiding (State) import TestUtil import RainTypes import TreeUtil +import qualified AST as A +import CompState +import Control.Monad.State constantFoldTest :: Test constantFoldTest = TestList [ - TestCase $ assertPatternMatch "constantFoldTest 0" (buildExprPattern $ Var "x") (buildExpr $ Var "x") + 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)) ] + where + two63 :: Integer + two63 = 9223372036854775808 + + foldVar :: Int -> ExprHelper -> Test + foldVar n e = testPass ("constantFoldTest " ++ show n) (buildExprPattern e) (constantFoldPass $ buildExpr e) state + + foldCon :: Int -> ExprHelper -> ExprHelper -> Test + foldCon n exp orig = testPass ("constantFoldTest " ++ show n) (buildExprPattern exp) (constantFoldPass $ buildExpr orig) state + + state :: State CompState () + state = return () + + lit :: Integer -> ExprHelper + lit n = Lit $ int64Literal n tests :: Test tests = TestList