suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
262913fabd
tock-mirror/RainParseTest.hs
Neil Brown 262913fabd Rain: added parsing of output statements
2007-08-22 10:21:20 +00:00

301 lines
13 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") )
--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))] )
]
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)
,fail ("boolean",RP.dataType)
,fail ("uint24",RP.dataType)
,fail ("int0",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)
]
testComm :: [ParseTest A.Process]
testComm =
[
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)
]
--Returns the list of tests:
tests :: Test
tests = TestList
[
parseTest testExp0,parseTest testExp1,
parseTests testWhile,
parseTests testSeq,
parseTests testPar,
parseTests testEach,
parseTests testIf,
parseTests testAssign,
parseTests testDataType,
parseTests testComm,
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