module Language.VintageBasic.Parser_test where import Test.HUnit import Text.ParserCombinators.Parsec(parse) import Text.ParserCombinators.Parsec.Pos import Language.VintageBasic.Asserts import Language.VintageBasic.Builtins import Language.VintageBasic.LexCommon(Tagged(..)) import Language.VintageBasic.Parser import Language.VintageBasic.Result import Language.VintageBasic.Syntax import Language.VintageBasic.Tokenizer(taggedTokensP) tokenize source = let (Right taggedToks) = parse taggedTokensP "" source in taggedToks goodStatements source expectedColAndStatements = TestCase $ assertParseResult withCol SyntaxError statementListP (tokenize source) expectedColAndStatements badStatements parser source expectedError = TestCase $ assertParseError withCol SyntaxError statementListP (tokenize source) expectedError goodExpr source expectedExpr = TestCase $ assertParseResult id SyntaxError exprP (tokenize source) expectedExpr badExpr source expectedError = TestCase $ assertParseError id SyntaxError exprP (tokenize source) expectedError test_parses_multiple_statements = goodStatements ":?::?: " [(2,PrintS []), (5,PrintS [])] test_parse_bare_print = goodStatements "PRINT" [(1,PrintS [])] test_parse_print_string = goodStatements "PRINT\"hello\"" [(1,PrintS [LitX (StringLit "hello")])] test_parse_print_string_ending_in_semicolon = goodStatements "PRINT\"hello\";" [(1,PrintS [LitX (StringLit "hello"), EmptySeparatorX])] test_parse_print_string_ending_in_comma = goodStatements "PRINT\"hello\"," [(1,PrintS [LitX (StringLit "hello"), NextZoneX])] test_parse_print_with_semicolon_separated_parts = goodStatements "PRINT\"hello\";\"there\"" [(1,PrintS [LitX (StringLit "hello"), EmptySeparatorX, LitX (StringLit "there")])] test_parse_print_with_juxtaposed_parts = goodStatements "PRINT\"hello\"\"there\"" [(1,PrintS [LitX (StringLit "hello"), LitX (StringLit "there")])] test_parse_print_with_comma_separated_parts = goodStatements "PRINT\"hello\",\"there\"" [(1,PrintS [LitX (StringLit "hello"), NextZoneX, LitX (StringLit "there")])] test_parse_print_with_a_comma_at_the_start = goodStatements "PRINT,\"hello\"" [(1,PrintS [NextZoneX, LitX (StringLit "hello")])] test_parse_let = goodStatements "LETA=1" [(1,LetS (ScalarVar (VarName FloatType "A")) (LitX (FloatLit 1.0)))] test_parse_let_wo_keyword = goodStatements "A=1" [(1,LetS (ScalarVar (VarName FloatType "A")) (LitX (FloatLit 1.0)))] test_parse_multiple_dims = goodStatements "DIMA$(5),G(14,20)" [(1,DimS [(VarName StringType "A", [(LitX (FloatLit 5))]), (VarName FloatType "G", [(LitX (FloatLit 14)), (LitX (FloatLit 20))])])] test_parse_goto = goodStatements "GOTO20" [(1,GotoS 20)] test_ignores_space_after_target = goodStatements "GOTO20 " [(1,GotoS 20)] test_parse_gosub = goodStatements "GOSUB20" [(1,GosubS 20)] test_parse_on_goto = goodStatements "ON3GOTO10,20,40" [(1,OnGotoS (LitX (FloatLit 3)) [10,20,40])] test_parse_on_gosub = goodStatements "ON3GOSUB10,20,40" [(1,OnGosubS (LitX (FloatLit 3)) [10,20,40])] test_parse_data = goodStatements "DATA4,5,\"THIS,WORKS\"" [(1,DataS "4,5,\"THIS,WORKS\"")] test_parse_read = goodStatements "READA$(5),B" [(1,ReadS [ArrVar (VarName StringType "A") [(LitX (FloatLit 5))], ScalarVar (VarName FloatType "B")])] test_parse_restore = goodStatements "RESTORE" [(1,RestoreS Nothing)] test_parse_restore_with_line_number = goodStatements "RESTORE20" [(1,RestoreS (Just 20))] test_parse_def_fn = goodStatements "DEFFNAN1$(B,CD$)=4+B" [(1,DefFnS (VarName StringType "AN1") [(VarName FloatType "B"), (VarName StringType "CD")] (BinX AddOp (LitX (FloatLit 4)) (VarX (ScalarVar (VarName FloatType "B")))))] test_parse_fn = goodStatements "?FNAN2$(1,\"X\")" [(1,PrintS [FnX (VarName StringType "AN2") [(LitX (FloatLit 1)), (LitX (StringLit "X"))]])] test_parse_end = goodStatements "END" [(1,EndS)] test_parse_stop = goodStatements "STOP" [(1,StopS)] fl v = LitX (FloatLit v) sl s = LitX (StringLit s) fv s = VarX (ScalarVar (VarName FloatType s)) iv s = VarX (ScalarVar (VarName IntType s)) sv s = VarX (ScalarVar (VarName StringType s)) test_primitive_expressions = TestList [ "round number" ~: goodExpr "234" (fl 234), "float" ~: goodExpr "2.3" (fl 2.3), "string" ~: goodExpr "\"Work\"" (sl "Work"), "builtin" ~: goodExpr "SIN(1)" (BuiltinX SinBI [(fl 1)]), "builtin2" ~: goodExpr "LEFT$(A$,1)" (BuiltinX LeftBI [sv "A", fl 1]), "fn" ~: goodExpr "FNAB(1,2,3)" (FnX (VarName FloatType "AB") [fl 1, fl 2, fl 3]), "float var" ~: goodExpr "BR" (fv "BR"), "int var" ~: goodExpr "BR%" (iv "BR"), "string var" ~: goodExpr "BR$" (sv "BR"), "array var" ~: goodExpr "AB(20, 5)" (VarX (ArrVar (VarName FloatType "AB") [fl 20, fl 5])) ] test_operators = TestList [ "unary +" ~: goodExpr "+A" (fv "A"), "unary -" ~: goodExpr "-A" (MinusX (fv "A")), "num add" ~: goodExpr "1+2" (BinX AddOp (fl 1) (fl 2)), "num sub" ~: goodExpr "1-2" (BinX SubOp (fl 1) (fl 2)), "num mul" ~: goodExpr "1*2" (BinX MulOp (fl 1) (fl 2)), "num div" ~: goodExpr "1/2" (BinX DivOp (fl 1) (fl 2)), "num pow" ~: goodExpr "1^2" (BinX PowOp (fl 1) (fl 2)), "num eq" ~: goodExpr "1=2" (BinX EqOp (fl 1) (fl 2)), "num ne" ~: goodExpr "1<>2" (BinX NEOp (fl 1) (fl 2)), "num lt" ~: goodExpr "1<2" (BinX LTOp (fl 1) (fl 2)), "num gt" ~: goodExpr "1>2" (BinX GTOp (fl 1) (fl 2)), "string concat" ~: goodExpr "\"A\"+\"B\"" (BinX AddOp (sl "A") (sl "B")), "string lt" ~: goodExpr "\"A\"<\"B\"" (BinX LTOp (sl "A") (sl "B")), "string gt" ~: goodExpr "\"A\">\"B\"" (BinX GTOp (sl "A") (sl "B")), "string eq" ~: goodExpr "\"A\"=\"B\"" (BinX EqOp (sl "A") (sl "B")), "and" ~: goodExpr "1=2AND3=4" (BinX AndOp (BinX EqOp (fl 1) (fl 2)) (BinX EqOp (fl 3) (fl 4))), "or" ~: goodExpr "1=2OR3=4" (BinX OrOp (BinX EqOp (fl 1) (fl 2)) (BinX EqOp (fl 3) (fl 4))), "not" ~: goodExpr "NOT1" (NotX (fl 1)) ] test_associativity = TestList [ "or assoc" ~: goodExpr "1OR2OR3" (BinX OrOp (BinX OrOp (fl 1) (fl 2)) (fl 3)), "and assoc" ~: goodExpr "1AND2AND3" (BinX AndOp (BinX AndOp (fl 1) (fl 2)) (fl 3)), "eq assoc" ~: goodExpr "1=2=3" (BinX EqOp (BinX EqOp (fl 1) (fl 2)) (fl 3)), "ne assoc" ~: goodExpr "1<>2<>3" (BinX NEOp (BinX NEOp (fl 1) (fl 2)) (fl 3)), "lt assoc" ~: goodExpr "1<2<3" (BinX LTOp (BinX LTOp (fl 1) (fl 2)) (fl 3)), "le assoc" ~: goodExpr "1<=2<=3" (BinX LEOp (BinX LEOp (fl 1) (fl 2)) (fl 3)), "gt assoc" ~: goodExpr "1>2>3" (BinX GTOp (BinX GTOp (fl 1) (fl 2)) (fl 3)), "ge assoc" ~: goodExpr "1>=2>=3" (BinX GEOp (BinX GEOp (fl 1) (fl 2)) (fl 3)), "add assoc" ~: goodExpr "1+2+3" (BinX AddOp (BinX AddOp (fl 1) (fl 2)) (fl 3)), "sub assoc" ~: goodExpr "1-2-3" (BinX SubOp (BinX SubOp (fl 1) (fl 2)) (fl 3)), "mul assoc" ~: goodExpr "1*2*3" (BinX MulOp (BinX MulOp (fl 1) (fl 2)) (fl 3)), "div assoc" ~: goodExpr "1/2/3" (BinX DivOp (BinX DivOp (fl 1) (fl 2)) (fl 3)), "pow assoc" ~: goodExpr "1^2^3" (BinX PowOp (fl 1) (BinX PowOp (fl 2) (fl 3))) ] test_precedence = TestList [ "and beats or" ~: goodExpr "1OR2AND3" (BinX OrOp (fl 1) (BinX AndOp (fl 2) (fl 3))), "not beats and" ~: goodExpr "NOT1AND2" (BinX AndOp (NotX (fl 1)) (fl 2)), "eq beats not" ~: goodExpr "NOT1=2" (NotX (BinX EqOp (fl 1) (fl 2))), "eq class" ~: goodExpr "1=2<>3<4<=5>6>=7" (BinX GEOp (BinX GTOp (BinX LEOp (BinX LTOp (BinX NEOp (BinX EqOp (fl 1) (fl 2)) (fl 3)) (fl 4)) (fl 5)) (fl 6)) (fl 7)), "eq class rev" ~: goodExpr "1>=2>3<=4<5<>6=7" (BinX EqOp (BinX NEOp (BinX LTOp (BinX LEOp (BinX GTOp (BinX GEOp (fl 1) (fl 2)) (fl 3)) (fl 4)) (fl 5)) (fl 6)) (fl 7)), "add beats eq" ~: goodExpr "1=2+3" (BinX EqOp (fl 1) (BinX AddOp (fl 2) (fl 3))), "add class" ~: goodExpr "1+2-3" (BinX SubOp (BinX AddOp (fl 1) (fl 2)) (fl 3)), "add class rev" ~: goodExpr "1-2+3" (BinX AddOp (BinX SubOp (fl 1) (fl 2)) (fl 3)), "mul beats add" ~: goodExpr "1+2*3" (BinX AddOp (fl 1) (BinX MulOp (fl 2) (fl 3))), "mul class" ~: goodExpr "1*2/3" (BinX DivOp (BinX MulOp (fl 1) (fl 2)) (fl 3)), "mul class rev" ~: goodExpr "1/2*3" (BinX MulOp (BinX DivOp (fl 1) (fl 2)) (fl 3)), "pow beats mul" ~: goodExpr "1*2^3" (BinX MulOp (fl 1) (BinX PowOp (fl 2) (fl 3))), "unary - beats pow" ~: goodExpr "-A^B" (BinX PowOp (MinusX (fv "A")) (fv "B")) ] test_parentheses = TestList [ goodExpr "(1+2)*3" (BinX MulOp (ParenX (BinX AddOp (fl 1) (fl 2))) (fl 3)), goodExpr "-(1+2)*3" (BinX MulOp (MinusX (ParenX (BinX AddOp (fl 1) (fl 2)))) (fl 3)), goodExpr "(1+(2-3))*4" (BinX MulOp (ParenX (BinX AddOp (fl 1) (ParenX (BinX SubOp (fl 2) (fl 3))))) (fl 4)) ] test_embedded_spaces_are_ignored = TestList [ goodExpr "1 * 2 +3- 4" (BinX SubOp (BinX AddOp (BinX MulOp (fl 1) (fl 2)) (fl 3)) (fl 4)), goodExpr "CHR$ ( A ) " (BuiltinX ChrBI [fv "A"]) ] test_bad_expressions = TestList [ "starting with operator" ~: badExpr "/4" "UNEXPECTED /", "ending with operator" ~: badExpr "4/" "UNEXPECTED END OF LINE", "double operator" ~: badExpr "4/*4" "UNEXPECTED *" ]