suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added more tests to the GenerateCTest module (stop, and array-related tests)

Browse Source
This commit is contained in:
Neil Brown 2007-10-03 14:08:09 +00:00
parent 96ee8ae9bd
commit d985043d62
1 changed files with 52 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
backends/GenerateCTest.hs
View File

@ -33,10 +33,20 @@ import CompState
import Errors
import GenerateC
import GenerateCPPCSP
import Metadata
import Pattern
import TestUtil
import TreeUtil
at :: CGen ()
at = tell ["@"]
dollar :: CGen ()
dollar = tell ["$"]
foo :: A.Name
foo = simpleName "foo"
-- | Asserts that the given output of a CGen pass matches the expected value.
assertGen :: String -> String -> IO (Either Errors.ErrorReport [String]) -> Assertion
assertGen n exp act
@ -71,6 +81,13 @@ testBothS testName expC expCPP act startState = TestCase $
where
state = execState startState emptyState
testBothFailS :: String -> (GenOps -> CGen ()) -> (State CompState ()) -> Test
testBothFailS testName act startState = TestCase $
do assertGenFail (testName ++ "/C") (evalStateT (runErrorT (execWriterT $ act cgenOps)) state)
assertGenFail (testName ++ "/C++") (evalStateT (runErrorT (execWriterT $ act cppgenOps)) state)
where
state = execState startState emptyState
-- Tests C output, expects C++ to fail
testCFS :: String -> String -> (GenOps -> CGen ()) -> (State CompState ()) -> Test
testCFS testName expC act startState = TestCase $
@ -95,6 +112,9 @@ testBothSameS ::
-> Test
testBothSameS n e a s = testBothS n e e a s
testBothFail :: String -> (GenOps -> CGen ()) -> Test
testBothFail a b = testBothFailS a b (return ())
testBoth :: String -> String -> String -> (GenOps -> CGen ()) -> Test
testBoth a b c d = testBothS a b c d (return ())
@ -110,6 +130,18 @@ testCPPF a b c = testCPPFS a b c (return ())
tcall :: (GenOps -> GenOps -> a -> b) -> a -> (GenOps -> b)
tcall f x = (\o -> f o o x)
tcall2 :: (GenOps -> GenOps -> a0 -> a1 -> b) -> a0 -> a1 -> (GenOps -> b)
tcall2 f x y = (\o -> f o o x y)
tcall3 :: (GenOps -> GenOps -> a0 -> a1 -> a2 -> b) -> a0 -> a1 -> a2 -> (GenOps -> b)
tcall3 f x y z = (\o -> f o o x y z)
-- | Overrides a specified function in GenOps to return the given value
override1 ::
b -- ^ The value to return for the overridden function
-> (GenOps -> a -> b) -- ^ The resulting overriden function
override1 val = (\_ _ -> val)
testGenType :: Test
testGenType = TestList
[
@ -148,11 +180,28 @@ testGenType = TestList
,testCPPF "GenType 600" "protocol_foo" (tcall genType $ A.UserProtocol (simpleName "foo"))
]
testStop :: Test
testStop =
testBoth "Stop" "occam_stop(\"foo:4:9\",\"bar\");" "throw StopException(\"foo:4:9\" \"bar\");" (tcall2 genStop (Meta (Just "foo") 4 9) "bar")
testArraySizes :: Test
testArraySizes = TestList
[
testBothSame "genArraySizesLiteral 0" "3" (tcall genArraySizesLiteral [A.Dimension 3])
,testBothSame "genArraySizesLiteral 1" "3,6,8" (tcall genArraySizesLiteral [A.Dimension 3, A.Dimension 6, A.Dimension 8])
,testBothFail "genArraySizesLiteral 2" (tcall genArraySizesLiteral [A.Dimension 6, A.UnknownDimension])
,testBothSame "genArraySizesSize 0" "[1]" (tcall genArraySizesSize [A.Dimension 7])
,testBothSame "genArraySize 0" "const int*foo_sizes=@;" (tcall3 genArraySize True at foo)
,testBothSame "genArraySize 1" "const int foo_sizes[]={@};" (tcall3 genArraySize False at foo)
]
---Returns the list of tests:
tests :: Test
tests = TestList
[
testGenType
,testStop
,testArraySizes
]