Fixed some more monomorphism restriction warnings in GenerateCTest

This commit is contained in:
Neil Brown 2008-02-08 13:35:04 +00:00
parent b037b6a8ca
commit cc29010103

View File

@ -300,6 +300,7 @@ testArraySizes = TestList
,testBothSame "genArrayLiteralElems 2" "$,$,$" $ unfolded (tcall genArrayLiteralElems [A.ArrayElemExpr undefined, A.ArrayElemArray [A.ArrayElemExpr undefined, A.ArrayElemExpr undefined]]) ,testBothSame "genArrayLiteralElems 2" "$,$,$" $ unfolded (tcall genArrayLiteralElems [A.ArrayElemExpr undefined, A.ArrayElemArray [A.ArrayElemExpr undefined, A.ArrayElemExpr undefined]])
] ]
where where
unfolded :: Override
unfolded = local (\ops -> ops {genUnfoldedExpression = override1 dollar}) unfolded = local (\ops -> ops {genUnfoldedExpression = override1 dollar})
testActuals :: Test testActuals :: Test
@ -317,7 +318,9 @@ testActuals = TestList
,testBoth "genActual 2" "@,@_sizes" "@" $ over (tcall genActual $ A.ActualVariable A.Abbrev (A.Array undefined undefined) (A.Variable undefined foo)) ,testBoth "genActual 2" "@,@_sizes" "@" $ over (tcall genActual $ A.ActualVariable A.Abbrev (A.Array undefined undefined) (A.Variable undefined foo))
] ]
where where
overActual :: Override
overActual = local (\ops -> ops {genActual = override1 at}) overActual = local (\ops -> ops {genActual = override1 at})
over :: Override
over = local (\ops -> ops {genVariable = override1 at, genExpression = override1 dollar}) over = local (\ops -> ops {genVariable = override1 at, genExpression = override1 dollar})
testArraySubscript :: Test testArraySubscript :: Test
@ -540,6 +543,7 @@ testDeclareInitFree = TestLabel "testDeclareInitFree" $ TestList
overArray _ v f = case f (\v -> A.SubscriptedVariable emptyMeta (A.Subscript emptyMeta $ intLiteral 0) v) of overArray _ v f = case f (\v -> A.SubscriptedVariable emptyMeta (A.Subscript emptyMeta $ intLiteral 0) v) of
Just p -> caret >> p >> caret Just p -> caret >> p >> caret
Nothing -> return () Nothing -> return ()
over :: Override
over = local $ \ops -> ops {genDeclaration = override3 at, genOverArray = overArray} over = local $ \ops -> ops {genDeclaration = override3 at, genOverArray = overArray}
testAllSame :: Int -> (String,String) -> A.Type -> Test testAllSame :: Int -> (String,String) -> A.Type -> Test
@ -715,6 +719,7 @@ testRetypeSizes = TestList
showBytesInParams _ t (Right _) = tell ["$(" ++ show t ++ " Right)"] showBytesInParams _ t (Right _) = tell ["$(" ++ show t ++ " Right)"]
showBytesInParams _ t v = tell ["$(" ++ show t ++ " " ++ show v ++ ")"] showBytesInParams _ t v = tell ["$(" ++ show t ++ " " ++ show v ++ ")"]
showArrSize _ sz _ = tell ["^("] >> sz >> tell [")"] showArrSize _ sz _ = tell ["^("] >> sz >> tell [")"]
over :: Override
over = local $ \ops -> ops {genBytesIn = showBytesInParams, genStop = override2 at, genArraySize = showArrSize} over = local $ \ops -> ops {genBytesIn = showBytesInParams, genStop = override2 at, genArraySize = showArrSize}
defRecord :: String -> String -> A.Type -> State CompState () defRecord :: String -> String -> A.Type -> State CompState ()
@ -787,6 +792,7 @@ testGenVariable = TestList
where where
state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t Nothing) am A.Unplaced state = do defineName (simpleName "foo") $ A.NameDef emptyMeta "foo" "foo" A.VariableName (A.Declaration emptyMeta t Nothing) am A.Unplaced
defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int defRecord "bar" "x" $ A.Array [A.Dimension 7] A.Int
over :: Override
over = local $ \ops -> ops {genArraySubscript = (\b _ subs -> at >> (tell [if b then "C" else "U"]) >> (seqComma $ map (call genExpression) subs)) over = local $ \ops -> ops {genArraySubscript = (\b _ subs -> at >> (tell [if b then "C" else "U"]) >> (seqComma $ map (call genExpression) subs))
,genDirectedVariable = (\cg _ -> dollar >> cg >> dollar)} ,genDirectedVariable = (\cg _ -> dollar >> cg >> dollar)}
@ -833,6 +839,7 @@ testAssign = TestList
--The expression won't be examined so we can use what we like: --The expression won't be examined so we can use what we like:
e = A.True emptyMeta e = A.True emptyMeta
state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t state t = defineName (simpleName "foo") $ simpleDefDecl "foo" t
over :: Override
over = local $ \ops -> ops {genVariable = override1 at, genExpression = override1 dollar} over = local $ \ops -> ops {genVariable = override1 at, genExpression = override1 dollar}
testCase :: Test testCase :: Test
@ -856,11 +863,13 @@ testCase = TestList
p = A.Skip emptyMeta p = A.Skip emptyMeta
spec :: Data a => A.Structured a -> A.Structured a spec :: Data a => A.Structured a -> A.Structured a
spec = A.Spec emptyMeta undefined spec = A.Spec emptyMeta undefined
over :: Override
over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash} over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash}
testGetTime :: Test testGetTime :: Test
testGetTime = testBoth "testGetTime 0" "ProcTime(&@);" "csp::CurrentTime(&@);" (over (tcall2 genGetTime emptyMeta undefined)) testGetTime = testBoth "testGetTime 0" "ProcTime(&@);" "csp::CurrentTime(&@);" (over (tcall2 genGetTime emptyMeta undefined))
where where
over :: Override
over = local $ \ops -> ops {genVariable = override1 at} over = local $ \ops -> ops {genVariable = override1 at}
testWait :: Test testWait :: Test
@ -870,6 +879,7 @@ testWait = TestList
,testBoth "testWait 1" "ProcAfter($);" "csp::SleepFor($);" (over (tcall2 genWait A.WaitFor undefined)) ,testBoth "testWait 1" "ProcAfter($);" "csp::SleepFor($);" (over (tcall2 genWait A.WaitFor undefined))
] ]
where where
over :: Override
over = local $ \ops -> ops {genExpression = override1 dollar} over = local $ \ops -> ops {genExpression = override1 dollar}
testIf :: Test testIf :: Test
@ -886,11 +896,13 @@ testIf = TestList
e = undefined e = undefined
p :: A.Process p :: A.Process
p = undefined p = undefined
over :: Override
over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash} over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at, genStop = override2 caret, genSpec = override2 hash}
testWhile :: Test testWhile :: Test
testWhile = testBothSame "testWhile 0" "while($){@}" (over (tcall2 genWhile undefined undefined)) testWhile = testBothSame "testWhile 0" "while($){@}" (over (tcall2 genWhile undefined undefined))
where where
over :: Override
over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at} over = local $ \ops -> ops {genExpression = override1 dollar, genProcess = override1 at}
testInput :: Test testInput :: Test