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

402 lines
18 KiB
Haskell
Raw Blame History

{-
Tock: a compiler for parallel languages
Copyright (C) 2007 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/>.
-}
module RainParseTest (tests) where
import qualified RainParse as RP
import qualified AST as A
import qualified LexRain as L
import Text.ParserCombinators.Parsec (runParser,eof)
import Test.HUnit
import Metadata (Meta,emptyMeta)
import Prelude hiding (fail)
import TestUtil
import Pattern
import TreeUtil
import CompState
data ParseTest a = Show a => ExpPass (String, RP.RainParser a , (a -> Assertion)) | ExpFail (String, RP.RainParser a)
pass :: Show a => (String, RP.RainParser a , (a -> Assertion)) -> ParseTest a
pass x = ExpPass x
fail :: Show a => (String, RP.RainParser a) -> ParseTest a
fail x = ExpFail x
--Runs a parse test, given a tuple of: (source text, parser function, assert)
testParsePass :: Show a => (String, RP.RainParser a , (a -> Assertion)) -> Assertion
testParsePass (text,prod,test)
= do lexOut <- (L.runLexer "<test>" text)
case lexOut of
Left m -> assertFailure $ "Parse error in:\n" ++ text ++ "\n***at: " ++ (show m)
Right toks -> case (runParser parser emptyState "<test>" toks) of
Left error -> assertFailure $ "Parse error in:\n" ++ text ++ "\n***" ++ (show error)
Right result -> ((return result) >>= test)
where parser = do { p <- prod ; eof ; return p}
--Adding the eof parser above ensures that all the input is consumed from a test. Otherwise
--tests such as "seq {}}" would succeed, because the final character simply wouldn't be parsed -
--which would ruin the point of the test
testParseFail :: Show a => (String, RP.RainParser a) -> Assertion
testParseFail (text,prod)
= do lexOut <- (L.runLexer "<test>" text)
case lexOut of
Left error -> return ()
Right toks -> case (runParser parser emptyState "<test>" toks) of
Left error -> return ()
Right result -> assertFailure ("Test was expected to fail:\n***BEGIN CODE***\n" ++ text ++ "\n*** END CODE ***\n")
where parser = do { p <- prod ; eof ; return p}
testExp0 = pass ("b",RP.expression,
assertEqual "Variable Expression Test" (exprVariable "b") )
testExp1 = pass ("b == c",RP.expression,
assertEqual "Operator Expression Test" $ A.Dyadic emptyMeta A.Eq (exprVariable "b") (exprVariable "c") )
testLiteral :: [ParseTest A.Expression]
testLiteral =
[
--Int literals:
pass ("0", RP.literal, assertEqual "testLiteral 0" (intLiteral 0))
--2^32:
,pass ("4294967296", RP.literal, assertEqual "testLiteral 1" (intLiteral 4294967296))
--2^64:
,pass ("18446744073709551616", RP.literal, assertEqual "testLiteral 2" (intLiteral 18446744073709551616))
--2^100: We should be able to parse this, but it will be rejected at a later stage:
,pass ("1267650600228229401496703205376", RP.literal, assertEqual "testLiteral 3" (intLiteral 1267650600228229401496703205376))
--Non-integers currently unsupported:
,fail ("0.",RP.literal)
,fail ("0.0",RP.literal)
,fail (".0",RP.literal)
,fail ("0x0",RP.literal)
,fail ("0a0",RP.literal)
,fail ("0a",RP.literal)
--Identifiers are not literals (except true and false):
,pass ("true", RP.literal, assertEqual "testLiteral 100" (A.True m))
,pass ("false", RP.literal, assertEqual "testLiteral 101" (A.False m))
,fail ("x",RP.literal)
,fail ("x0",RP.literal)
,fail ("TRUE",RP.literal)
,fail ("FALSE",RP.literal)
--Strings:
,pass ("\"\"", RP.literal, assertPatternMatch "testLiteral 201" $ makeLiteralStringPattern "")
,pass ("\"abc\"", RP.literal, assertPatternMatch "testLiteral 202" $ makeLiteralStringPattern "abc")
,pass ("\"abc\\n\"", RP.literal, assertPatternMatch "testLiteral 203" $ makeLiteralStringPattern "abc\n")
,pass ("\"a\\\"bc\"", RP.literal, assertPatternMatch "testLiteral 204" $ makeLiteralStringPattern "a\"bc")
,fail ("\"",RP.literal)
,fail ("\"\"\"",RP.literal)
,fail ("a\"\"",RP.literal)
,fail ("\"\"a",RP.literal)
,fail ("\"\\\"",RP.literal)
]
--Helper function for ifs:
makeIf :: [(A.Expression,A.Process)] -> A.Process
makeIf list = A.If m $ A.Several m (map makeChoice list)
where
makeChoice :: (A.Expression,A.Process) -> A.Structured
makeChoice (exp,proc) = A.OnlyC m $ A.Choice m exp proc
dyExp :: A.DyadicOp -> A.Variable -> A.Variable -> A.Expression
dyExp op v0 v1 = A.Dyadic m op (A.ExprVariable m v0) (A.ExprVariable m v1)
testIf :: [ParseTest A.Process]
testIf =
[
pass ("if (a) ;",RP.statement,
assertEqual "If Test 0" $ makeIf [(exprVariable "a",A.Skip m),(A.True m,A.Skip m)])
,pass ("if (a) ; else ;",RP.statement,
assertEqual "If Test 1" $ makeIf [(exprVariable "a",A.Skip m),(A.True m,A.Skip m)])
,pass ("if (a) ; else a = b;",RP.statement,
assertEqual "If Test 2" $ makeIf [(exprVariable "a",A.Skip m),(A.True m,makeSimpleAssign "a" "b")])
,pass ("if (a) ; else if (b) ; ",RP.statement,
assertEqual "If Test 3" $ makeIf [(exprVariable "a",A.Skip m),(A.True m,makeIf [(exprVariable "b",A.Skip m),(A.True m,A.Skip m)])])
,pass ("if (a) ; else if (b) ; else ; ",RP.statement,
assertEqual "If Test 4" $ makeIf [(exprVariable "a",A.Skip m),(A.True m,makeIf [(exprVariable "b",A.Skip m),(A.True m,A.Skip m)])])
,pass ("if (a) c = d; else if (b) e = f; else g = h;",RP.statement,
assertEqual "If Test 5" $ makeIf [(exprVariable "a",makeSimpleAssign "c" "d"),(A.True m,makeIf [(exprVariable "b",makeSimpleAssign "e" "f"),(A.True m,makeSimpleAssign "g" "h")])])
--TODO add fail tests, maybe {} brackets
]
testAssign :: [ParseTest A.Process]
testAssign =
[
pass ("a = b;",RP.statement,
assertEqual "Assign Test 0" $ makeSimpleAssign "a" "b")
,fail ("a != b;",RP.statement)
,pass ("a += b;",RP.statement,
assertEqual "Assign Test 1" $ makeAssign (variable "a") (dyExp A.Plus (variable ("a")) (variable ("b")) ) )
,fail ("a + = b;",RP.statement)
]
testWhile :: [ParseTest A.Process]
testWhile =
[
pass ("while (a) ;",RP.statement,
assertEqual "While Test" $ A.While emptyMeta (exprVariable "a") (A.Skip emptyMeta) )
,fail ("while (a)",RP.statement)
,fail ("while () ;",RP.statement)
,fail ("while () {}",RP.statement)
,fail ("while ;",RP.statement)
,fail ("while {}",RP.statement)
,fail ("while ",RP.statement)
]
testSeq :: [ParseTest A.Process]
testSeq =
[
pass ("seq { }",RP.statement,
assertEqual "Empty Seq Test" $ A.Seq m $ A.Several m [] )
,pass ("seq { ; ; }",RP.statement,
assertEqual "Seq Skip Test" $ A.Seq m $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m (A.Skip m))] )
,pass ("{ }",RP.statement,
assertEqual "Empty Unlabelled-Seq Test" $ A.Seq m $ A.Several m [] )
,pass ("{ ; ; }",RP.statement,
assertEqual "Unlabelled-Seq Skip Test" $ A.Seq m $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m (A.Skip m))] )
,pass ("{ { } }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 0" $ A.Seq m $ A.Several m [A.OnlyP m $ A.Seq m (A.Several m [])] )
,pass ("seq { { } }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 1" $ A.Seq m $ A.Several m [A.OnlyP m $ A.Seq m (A.Several m [])] )
,pass ("{ seq { } }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 2" $ A.Seq m $ A.Several m [A.OnlyP m $ A.Seq m (A.Several m [])] )
,pass ("{ ; {} }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 3" $ A.Seq m $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m $ A.Seq m (A.Several m []))] )
,pass ("seq { ; {} }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 4" $ A.Seq m $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m $ A.Seq m (A.Several m []))] )
,pass ("{ ; seq {} }",RP.statement,
assertEqual "Unlabelled-Seq Nest Test 5" $ A.Seq m $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m $ A.Seq m (A.Several m []))] )
,fail ("seq",RP.statement)
,fail ("seq ;",RP.statement)
,fail ("seq {",RP.statement)
,fail ("seq }",RP.statement)
,fail ("{",RP.statement)
,fail ("}",RP.statement)
,fail ("seq seq {}",RP.statement)
,fail ("seq seq",RP.statement)
,fail ("seq {}}",RP.statement)
,fail ("seq {{}",RP.statement)
--should fail, because it is two statements, not one:
,fail ("seq {};",RP.statement)
,fail ("{};",RP.statement)
]
testPar :: [ParseTest A.Process]
testPar =
[
pass ("par { }",RP.statement,
assertEqual "Empty Par Test" $ A.Par m A.PlainPar $ A.Several m [] )
,pass ("par { ; ; }",RP.statement,
assertEqual "Par Skip Test" $ A.Par m A.PlainPar $ A.Several m [(A.OnlyP m (A.Skip m)),(A.OnlyP m (A.Skip m))] )
]
-- | Test innerBlock, particularly with declarations mixed with statements:
testBlock :: [ParseTest A.Structured]
testBlock =
[
pass("{ a = b; }",RP.innerBlock,assertPatternMatch "testBlock 0" (tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]) )
,pass("{ a = b; b = c; }",RP.innerBlock,assertPatternMatch "testBlock 1" (tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"]) )
,pass("{ uint8: x; a = b; }",RP.innerBlock,assertPatternMatch "testBlock 2" $ tag2 A.Several DontCare [tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]
])
,pass("{ uint8: x; a = b; b = c; }",RP.innerBlock,assertPatternMatch "testBlock 2" $ tag2 A.Several DontCare [tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b",tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c"]
])
,pass("{ b = c; uint8: x; a = b; }",RP.innerBlock,assertPatternMatch "testBlock 2" $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "b" "c",
tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte) $ tag2 A.Several DontCare
[tag2 A.OnlyP DontCare $ makeSimpleAssignPattern "a" "b"]
])
]
testEach :: [ParseTest A.Process]
testEach =
[
pass ("seqeach (c : \"1\") c = 7;", RP.statement,
assertPatternMatch "Each Test 0" (stopCaringPattern m $ mkPattern $ A.Seq m $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "1")) $
A.OnlyP m $ (makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "7"))) ))
,pass ("pareach (c : \"345\") {c = 1; c = 2;}", RP.statement,
assertEqual "Each Test 1" $ A.Par m A.PlainPar $ A.Rep m (A.ForEach m (simpleName "c") (makeLiteralString "345")) $
A.OnlyP m $ makeSeq[(makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "1"))),(makeAssign (variable "c") (A.Literal m A.Int (A.IntLiteral m "2")))] )
]
testTopLevelDecl :: [ParseTest A.Structured]
testTopLevelDecl =
[
pass ("process noargs() {}", RP.topLevelDecl,
assertPatternMatch "testTopLevelDecl 0" $ tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "noargs") $ tag4 A.Proc DontCare A.PlainSpec ([] :: [A.Formal])
(tag2 A.Seq DontCare $ tag2 A.Several DontCare ([] :: [A.Structured]))
)
(tag2 A.OnlyP DontCare $ tag1 A.Main DontCare)
)
, pass ("process onearg(int: x) {x = 0;}", RP.topLevelDecl,
assertPatternMatch "testTopLevelDecl 1" $ tag3 A.Spec DontCare
(tag3 A.Specification DontCare (simpleNamePattern "onearg") $ tag4 A.Proc DontCare A.PlainSpec [tag3 A.Formal A.ValAbbrev A.Int (simpleNamePattern "x")]
(tag2 A.Seq DontCare $ tag2 A.Several DontCare [tag2 A.OnlyP DontCare $ makeAssignPattern (variablePattern "x") (intLiteralPattern 0)]) )
(tag2 A.OnlyP DontCare $ tag1 A.Main DontCare)
)
, fail ("process", RP.topLevelDecl)
, fail ("process () {}", RP.topLevelDecl)
, fail ("process foo", RP.topLevelDecl)
, fail ("process foo ()", RP.topLevelDecl)
, fail ("process foo () {", RP.topLevelDecl)
, fail ("process foo ( {} )", RP.topLevelDecl)
, fail ("process foo (int: x)", RP.topLevelDecl)
, fail ("process foo (int x) {}", RP.topLevelDecl)
]
nonShared :: A.ChanAttributes
nonShared = A.ChanAttributes { A.caWritingShared = False, A.caReadingShared = False}
testDataType :: [ParseTest A.Type]
testDataType =
[
pass ("bool",RP.dataType,assertEqual "testDataType 0" A.Bool)
,pass ("int",RP.dataType,assertEqual "testDataType 1" A.Int)
,pass ("uint8",RP.dataType,assertEqual "testDataType 2" A.Byte)
,pass ("uint16",RP.dataType,assertEqual "testDataType 3" A.UInt16)
,pass ("uint32",RP.dataType,assertEqual "testDataType 4" A.UInt32)
,pass ("uint64",RP.dataType,assertEqual "testDataType 5" A.UInt64)
,pass ("sint8",RP.dataType,assertEqual "testDataType 6" A.Int8)
,pass ("sint16",RP.dataType,assertEqual "testDataType 7" A.Int16)
,pass ("sint32",RP.dataType,assertEqual "testDataType 8" A.Int32)
,pass ("sint64",RP.dataType,assertEqual "testDataType 9" A.Int64)
,pass ("boolean",RP.dataType,assertEqual "testDataType 10" $ A.UserDataType $ typeName "boolean")
,pass ("uint24",RP.dataType,assertEqual "testDataType 11" $ A.UserDataType $ typeName "uint24")
,pass ("int0",RP.dataType,assertEqual "testDataType 12" $ A.UserDataType $ typeName "int0")
,fail ("bool bool",RP.dataType)
,pass ("?int",RP.dataType,assertEqual "testDataType 102" $ A.Chan A.DirInput nonShared A.Int)
,pass ("! bool",RP.dataType,assertEqual "testDataType 103" $ A.Chan A.DirOutput nonShared A.Bool)
--These types should succeed in the *parser* -- they would be thrown out further down the line:
,pass ("??int",RP.dataType,assertEqual "testDataType 104" $ A.Chan A.DirInput nonShared $ A.Chan A.DirInput nonShared A.Int)
,pass ("? ? int",RP.dataType,assertEqual "testDataType 105" $ A.Chan A.DirInput nonShared $ A.Chan A.DirInput nonShared A.Int)
,pass ("!!bool",RP.dataType,assertEqual "testDataType 106" $ A.Chan A.DirOutput nonShared $ A.Chan A.DirOutput nonShared A.Bool)
,pass ("?!bool",RP.dataType,assertEqual "testDataType 107" $ A.Chan A.DirInput nonShared $ A.Chan A.DirOutput nonShared A.Bool)
,fail ("?",RP.dataType)
,fail ("!",RP.dataType)
,fail ("??",RP.dataType)
,fail ("int?",RP.dataType)
,fail ("bool!",RP.dataType)
,fail ("int?int",RP.dataType)
]
testDecl :: [ParseTest (Meta, A.Structured -> A.Structured)]
testDecl =
[
passd ("bool: b;",0,tag3 A.Specification DontCare (simpleNamePattern "b") $ tag2 A.Declaration DontCare A.Bool)
,passd ("uint8: x;",0,tag3 A.Specification DontCare (simpleNamePattern "x") $ tag2 A.Declaration DontCare A.Byte)
,passd ("?bool: bc;",0,tag3 A.Specification DontCare (simpleNamePattern "bc") $ tag2 A.Declaration DontCare $ A.Chan A.DirInput nonShared A.Bool)
,fail ("bool:;",RP.declaration)
,fail ("bool;",RP.declaration)
,fail (":b;",RP.declaration)
,fail ("bool:b",RP.declaration)
,fail ("bool b",RP.declaration)
,fail ("bool b;",RP.declaration)
,fail ("bool:?b;",RP.declaration)
]
where
passd :: (String,Int,Pattern) -> ParseTest (Meta, A.Structured -> A.Structured)
passd (code,index,exp) = pass(code,RP.declaration,check ("testDecl " ++ (show index)) exp)
check :: String -> Pattern -> (Meta, A.Structured -> A.Structured) -> Assertion
check msg spec (_,act) = assertPatternMatch msg (tag3 A.Spec DontCare spec $ A.Several m []) (act $ A.Several m [])
testComm :: [ParseTest A.Process]
testComm =
[
--Output:
pass ("c ! x;",RP.statement,assertEqual "testComm 0" $ A.Output m (variable "c") [A.OutExpression m (exprVariable "x")])
,pass ("c!x;",RP.statement,assertEqual "testComm 1" $ A.Output m (variable "c") [A.OutExpression m (exprVariable "x")])
,pass ("c!0+x;",RP.statement,assertEqual "testComm 2" $ A.Output m (variable "c") [A.OutExpression m $ A.Dyadic m A.Add (intLiteral 0) (exprVariable "x")])
,fail ("c!x",RP.statement)
,fail ("c!x!y;",RP.statement)
,fail ("c!x,y;",RP.statement)
,fail ("c!;",RP.statement)
,fail ("!x;",RP.statement)
,fail ("c!!x;",RP.statement)
--Input:
,pass ("c ? x;",RP.statement, assertEqual "testComm 100" $ A.Input m (variable "c") $ A.InputSimple m [A.InVariable m (variable "x")])
,pass ("c?x;",RP.statement, assertEqual "testComm 101" $ A.Input m (variable "c") $ A.InputSimple m [A.InVariable m (variable "x")])
--Fail for now, but later will probably become the extended rendezvous syntax:
,fail ("c??x;",RP.statement)
,fail ("c ? x + 0;",RP.statement)
,fail ("?x;",RP.statement)
,fail ("c ? x",RP.statement)
,fail ("c ? ;",RP.statement)
,fail ("c ? x ? y;",RP.statement)
,fail ("c ? x , y;",RP.statement)
]
--Returns the list of tests:
tests :: Test
tests = TestList
[
parseTest testExp0,parseTest testExp1,
parseTests testLiteral,
parseTests testWhile,
parseTests testSeq,
parseTests testPar,
parseTests testBlock,
parseTests testEach,
parseTests testIf,
parseTests testAssign,
parseTests testDataType,
parseTests testComm,
parseTests testDecl,
parseTests testTopLevelDecl
]
--TODO test:
-- input (incl. ext input)
-- output
-- alting
--TODO later on:
-- types (lists, tuples, maps)
-- functions
-- typedefs
where
parseTest :: Show a => ParseTest a -> Test
parseTest (ExpPass test) = TestCase (testParsePass test)
parseTest (ExpFail test) = TestCase (testParseFail test)
parseTests :: Show a => [ParseTest a] -> Test
parseTests tests = TestList (map parseTest tests)
Reference in New Issue View Git Blame Copy Permalink