Fixed the types in various test modules to work with Polyplate
This commit is contained in:
parent
92035a82a2
commit
ccb6c7aa1d
|
@ -30,8 +30,8 @@ import qualified AST as A
|
||||||
import CompState
|
import CompState
|
||||||
import Metadata
|
import Metadata
|
||||||
import qualified OccamPasses
|
import qualified OccamPasses
|
||||||
|
import Pass
|
||||||
import TestUtils
|
import TestUtils
|
||||||
import Types
|
|
||||||
|
|
||||||
m :: Meta
|
m :: Meta
|
||||||
m = emptyMeta
|
m = emptyMeta
|
||||||
|
@ -89,7 +89,9 @@ testFoldConstants = TestList
|
||||||
, test 48 (add var (add const one)) (add var three)
|
, test 48 (add var (add const one)) (add var three)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
test :: Data a => Int -> a -> a -> Test
|
test :: (PolyplateM a (TwoOpM PassM A.Expression A.Specification) () PassM
|
||||||
|
,PolyplateM a () (TwoOpM PassM A.Expression A.Specification) PassM
|
||||||
|
,Data a) => Int -> a -> a -> Test
|
||||||
test n orig exp = TestCase $ testPass ("testFoldConstants" ++ show n)
|
test n orig exp = TestCase $ testPass ("testFoldConstants" ++ show n)
|
||||||
exp OccamPasses.foldConstants orig
|
exp OccamPasses.foldConstants orig
|
||||||
startState
|
startState
|
||||||
|
@ -136,13 +138,16 @@ testCheckConstants = TestList
|
||||||
, testFail 33 (A.Option m [lit10, lit10, lit10, var] skip)
|
, testFail 33 (A.Option m [lit10, lit10, lit10, var] skip)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
testOK :: (Show a, Data a) => Int -> a -> Test
|
testOK :: (PolyplateM a (TwoOpM PassM A.Dimension A.Option) () PassM
|
||||||
|
,PolyplateM a () (TwoOpM PassM A.Dimension A.Option) PassM
|
||||||
|
,Show a, Data a) => Int -> a -> Test
|
||||||
testOK n orig
|
testOK n orig
|
||||||
= TestCase $ testPass ("testCheckConstants" ++ show n)
|
= TestCase $ testPass ("testCheckConstants" ++ show n)
|
||||||
orig OccamPasses.checkConstants orig
|
orig OccamPasses.checkConstants orig
|
||||||
(return ())
|
(return ())
|
||||||
|
testFail :: (PolyplateM a (TwoOpM PassM A.Dimension A.Option) () PassM
|
||||||
testFail :: (Show a, Data a) => Int -> a -> Test
|
,PolyplateM a () (TwoOpM PassM A.Dimension A.Option) PassM
|
||||||
|
,Show a, Data a) => Int -> a -> Test
|
||||||
testFail n orig
|
testFail n orig
|
||||||
= TestCase $ testPassShouldFail ("testCheckConstants" ++ show n)
|
= TestCase $ testPassShouldFail ("testCheckConstants" ++ show n)
|
||||||
OccamPasses.checkConstants orig
|
OccamPasses.checkConstants orig
|
||||||
|
|
|
@ -29,8 +29,10 @@ import qualified AST as A
|
||||||
import CompState
|
import CompState
|
||||||
import Metadata
|
import Metadata
|
||||||
import qualified OccamTypes
|
import qualified OccamTypes
|
||||||
|
import Pass
|
||||||
import TestHarness
|
import TestHarness
|
||||||
import TestUtils
|
import TestUtils
|
||||||
|
import Traversal
|
||||||
|
|
||||||
m :: Meta
|
m :: Meta
|
||||||
m = emptyMeta
|
m = emptyMeta
|
||||||
|
@ -500,13 +502,21 @@ testOccamTypes = TestList
|
||||||
--}}}
|
--}}}
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
testOK :: (Show a, Data a) => Int -> a -> Test
|
testOK :: (PolyplateSpine a (OneOpQ (PassM ()) A.Variable) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Expression) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.SpecType) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Process) () (PassM ())
|
||||||
|
,Show a, Data a) => Int -> a -> Test
|
||||||
testOK n orig
|
testOK n orig
|
||||||
= TestCase $ testPass ("testOccamTypes " ++ show n)
|
= TestCase $ testPass ("testOccamTypes " ++ show n)
|
||||||
orig OccamTypes.checkTypes orig
|
orig OccamTypes.checkTypes orig
|
||||||
startState
|
startState
|
||||||
|
|
||||||
testFail :: (Show a, Data a) => Int -> a -> Test
|
testFail :: (PolyplateSpine a (OneOpQ (PassM ()) A.Variable) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Expression) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.SpecType) () (PassM ())
|
||||||
|
,PolyplateSpine a (OneOpQ (PassM ()) A.Process) () (PassM ())
|
||||||
|
,Show a, Data a) => Int -> a -> Test
|
||||||
testFail n orig
|
testFail n orig
|
||||||
= TestCase $ testPassShouldFail ("testOccamTypes " ++ show n)
|
= TestCase $ testPassShouldFail ("testOccamTypes " ++ show n)
|
||||||
OccamTypes.checkTypes orig
|
OccamTypes.checkTypes orig
|
||||||
|
|
|
@ -218,7 +218,7 @@ testUnique4 = TestCase $ testPassWithItemsStateCheck "testUnique4" exp uniquifyA
|
||||||
|
|
||||||
|
|
||||||
--Easy way to string two passes together; creates a pass-like function that applies the left-hand pass then the right-hand pass. Associative.
|
--Easy way to string two passes together; creates a pass-like function that applies the left-hand pass then the right-hand pass. Associative.
|
||||||
(>>>) :: Pass -> Pass -> Pass
|
(>>>) :: Pass t -> Pass t -> Pass t
|
||||||
(>>>) f0 f1 = Pass {passCode = passCode f1 <.< passCode f0}
|
(>>>) f0 f1 = Pass {passCode = passCode f1 <.< passCode f0}
|
||||||
|
|
||||||
--Normally, process names in Rain are not mangled. And this should be fine in all cases - but not for the main process (which would
|
--Normally, process names in Rain are not mangled. And this should be fine in all cases - but not for the main process (which would
|
||||||
|
|
|
@ -26,10 +26,12 @@ import Test.HUnit hiding (State)
|
||||||
import CompState
|
import CompState
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
import Metadata
|
import Metadata
|
||||||
|
import Pass
|
||||||
import Pattern
|
import Pattern
|
||||||
import SimplifyAbbrevs
|
import SimplifyAbbrevs
|
||||||
import TagAST
|
import TagAST
|
||||||
import TestUtils
|
import TestUtils
|
||||||
|
import Traversal
|
||||||
import TreeUtils
|
import TreeUtils
|
||||||
|
|
||||||
m :: Meta
|
m :: Meta
|
||||||
|
@ -92,7 +94,9 @@ testRemoveInitial = TestLabel "testRemoveInitial" $ TestList
|
||||||
inner)
|
inner)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
ok :: (Data a, Data b) => Int -> a -> b -> Test
|
ok :: (PolyplateM a (ExtOpMSP BaseOp) () PassM
|
||||||
|
,PolyplateM a () (ExtOpMSP BaseOp) PassM
|
||||||
|
,Data a, Data b) => Int -> a -> b -> Test
|
||||||
ok n inp exp = TestCase $ testPass ("testRemoveInitial" ++ show n)
|
ok n inp exp = TestCase $ testPass ("testRemoveInitial" ++ show n)
|
||||||
exp removeInitial inp setupState
|
exp removeInitial inp setupState
|
||||||
|
|
||||||
|
@ -148,7 +152,8 @@ testRemoveResult = TestLabel "testRemoveResult" $ TestList
|
||||||
(A.Formal A.Abbrev A.Int foo)
|
(A.Formal A.Abbrev A.Int foo)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
ok :: (Data a, Data b) => Int -> a -> b -> Test
|
ok :: (Polyplate a (OneOp A.AbbrevMode) ()
|
||||||
|
,Data a, Data b) => Int -> a -> b -> Test
|
||||||
ok n inp exp = TestCase $ testPass ("testRemoveResult" ++ show n)
|
ok n inp exp = TestCase $ testPass ("testRemoveResult" ++ show n)
|
||||||
exp removeResult inp setupState
|
exp removeResult inp setupState
|
||||||
|
|
||||||
|
|
|
@ -26,10 +26,12 @@ import Test.HUnit hiding (State)
|
||||||
import CompState
|
import CompState
|
||||||
import qualified AST as A
|
import qualified AST as A
|
||||||
import Metadata
|
import Metadata
|
||||||
|
import Pass
|
||||||
import Pattern
|
import Pattern
|
||||||
import SimplifyTypes
|
import SimplifyTypes
|
||||||
import TagAST
|
import TagAST
|
||||||
import TestUtils
|
import TestUtils
|
||||||
|
import Traversal
|
||||||
import TreeUtils
|
import TreeUtils
|
||||||
|
|
||||||
m :: Meta
|
m :: Meta
|
||||||
|
@ -49,7 +51,9 @@ testResolveNamedTypes = TestLabel "testResolveNamedTypes" $ TestList
|
||||||
(array10 A.Int)
|
(array10 A.Int)
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
ok :: (Data a, Data b) => Int -> a -> b -> Test
|
ok :: (PolyplateM a (OneOpM PassM A.Type) () PassM
|
||||||
|
,PolyplateM a () (OneOpM PassM A.Type) PassM
|
||||||
|
,Data a, Data b) => Int -> a -> b -> Test
|
||||||
ok n inp exp = TestCase $ testPass ("testResolveNamedTypes" ++ show n)
|
ok n inp exp = TestCase $ testPass ("testResolveNamedTypes" ++ show n)
|
||||||
exp resolveNamedTypes inp setupState
|
exp resolveNamedTypes inp setupState
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user