From: Siraaj Khandkar Date: Sat, 15 Sep 2018 17:20:48 +0000 (-0400) Subject: Test every book test case X-Git-Url: https://git.xandkar.net/?p=tiger.ml.git;a=commitdiff_plain;h=38ffcb1fc99ecb7a48097cbcf97b9a3062c8bfa0 Test every book test case --- diff --git a/compiler/Makefile b/compiler/Makefile index 20fdb3d..1e9b32f 100644 --- a/compiler/Makefile +++ b/compiler/Makefile @@ -2,11 +2,13 @@ MAKEFLAGS := --no-builtin-rules EXE_TYPE := byte # byte | native EXECUTABLES := tigerc tigert +OCAMLBUILD_FLAGS_PKGS := -pkg unix OCAMLBUILD_FLAGS_DIRS := -I src/exe -I src/lib/tiger OCAMLBUILD_FLAGS_COMP := -cflags '-w A' OCAMLBUILD_FLAGS_YACC := -yaccflag '-v' OCAMLBUILD := \ ocamlbuild \ + $(OCAMLBUILD_FLAGS_PKGS) \ $(OCAMLBUILD_FLAGS_COMP) \ $(OCAMLBUILD_FLAGS_DIRS) \ $(OCAMLBUILD_FLAGS_YACC) diff --git a/compiler/src/exe/tigert.ml b/compiler/src/exe/tigert.ml index bd7e12d..10b5cbe 100644 --- a/compiler/src/exe/tigert.ml +++ b/compiler/src/exe/tigert.ml @@ -1,2 +1,5 @@ let () = - Tiger.Test.run Tiger.Test_cases.all + let dir = ref "testcases" in + Arg.parse [("-dir", String (fun s -> dir := s), "")] (fun _ -> ()) ""; + let dir = !dir in + Tiger.Test.run (Tiger.Test_cases.all ~dir) diff --git a/compiler/src/lib/tiger/tiger_test.ml b/compiler/src/lib/tiger/tiger_test.ml index fdab310..e54f160 100644 --- a/compiler/src/lib/tiger/tiger_test.ml +++ b/compiler/src/lib/tiger/tiger_test.ml @@ -40,12 +40,13 @@ end = struct | Some x -> Some (f x) end +(* TODO: ~expect:Output of 'a | Exception of (exn -> bool) *) type t = { name : string ; code : string ; out_lexing : (Tiger_parser.token list) option ; out_parsing : Tiger_absyn.t option - ; is_error_expected_semant : (Tiger_error.t -> bool) + ; is_error_expected_semant : (Tiger_error.t -> bool) option } type color = @@ -79,9 +80,9 @@ let status_skip ?(info="") () = status (color Yellow "Skip") info let case - ?(out_lexing) - ?(out_parsing) - ?(is_error_expected_semant=(fun _ -> false)) + ?(out_lexing=None) + ?(out_parsing=None) + ?(is_error_expected_semant=None) ~code name = @@ -100,8 +101,22 @@ let indent = fun n -> String.make (n * unit_spaces) ' ' -let pass_lexing code : (Tiger_parser.token list, string) result = - let lexbuf = Lexing.from_string code in +let lexbuf_set_filename lb filename +: unit += + let Lexing.({lex_start_p; lex_curr_p; _}) = lb in + lb.Lexing.lex_start_p <- {lex_start_p with Lexing.pos_fname = filename}; + lb.Lexing.lex_curr_p <- {lex_curr_p with Lexing.pos_fname = filename} + +let lexbuf_create ~filename ~code = + let lb = Lexing.from_string code in + lexbuf_set_filename lb filename; + lb + +let pass_lexing ~fake_filename ~code +: (Tiger_parser.token list, string) result += + let lexbuf = lexbuf_create ~filename:fake_filename ~code in let rec tokens () = let token = Tiger_lexer.token lexbuf in (* Avoiding fragile pattern-matching *) @@ -111,8 +126,10 @@ let pass_lexing code : (Tiger_parser.token list, string) result = | exception e -> Error (Printexc.to_string e) | tokens -> Ok tokens -let pass_parsing code : (Tiger_absyn.t, string) result = - let lb = Lexing.from_string code in +let pass_parsing ~fake_filename ~code +: (Tiger_absyn.t, string) result += + let lb = lexbuf_create ~filename:fake_filename ~code in match Tiger_parser.program Tiger_lexer.token lb with | exception Parsing.Parse_error -> let module L = Lexing in @@ -122,7 +139,9 @@ let pass_parsing code : (Tiger_absyn.t, string) result = | ast -> Ok ast -let pass_semant (absyn_opt : Tiger_absyn.t option) : (unit, string) result = +let pass_semant (absyn_opt : Tiger_absyn.t option) +: (unit, string) result += match absyn_opt with | None -> Error "AST not provided" @@ -136,10 +155,15 @@ let p_indent n = p "%s" (indent n) let run tests = let failure_count = ref 0 in - let run_pass ~f ~input ~expect_output ~is_error_expected = + let run_pass ~f ~expect_output ~is_error_expected = + let is_error_expected = + match is_error_expected with + | None -> (fun _ -> false) + | Some f -> f + in let output_status = "n/a" in let output_value = None in - match f input with + match f () with | exception e -> let execution_status = (match e with @@ -193,22 +217,19 @@ let run tests = incr test_case_count; let (stat_lex_exe, stat_lex_out_cmp, _) = run_pass - ~f:pass_lexing - ~input:code + ~f:(fun () -> pass_lexing ~fake_filename:name ~code) ~expect_output:out_lexing - ~is_error_expected:(fun _ -> false) + ~is_error_expected:None in let (stat_pars_exe, stat_pars_out_cmp, absyn_opt) = run_pass - ~f:pass_parsing - ~input:code + ~f:(fun () -> pass_parsing ~fake_filename:name ~code) ~expect_output:out_parsing - ~is_error_expected:(fun _ -> false) + ~is_error_expected:None in let (stat_semant_exe, stat_semant_out_cmp, _) = run_pass - ~f:pass_semant - ~input:absyn_opt + ~f:(fun () -> pass_semant absyn_opt) ~expect_output:(Some ()) ~is_error_expected:is_error_expected_semant in diff --git a/compiler/src/lib/tiger/tiger_test.mli b/compiler/src/lib/tiger/tiger_test.mli index 5cbc445..30527a5 100644 --- a/compiler/src/lib/tiger/tiger_test.mli +++ b/compiler/src/lib/tiger/tiger_test.mli @@ -1,9 +1,9 @@ type t val case - : ?out_lexing : Tiger_parser.token list - -> ?out_parsing : Tiger_absyn.t - -> ?is_error_expected_semant : (Tiger_error.t -> bool) + : ?out_lexing : Tiger_parser.token list option + -> ?out_parsing : Tiger_absyn.t option + -> ?is_error_expected_semant : (Tiger_error.t -> bool) option -> code : string -> string -> t diff --git a/compiler/src/lib/tiger/tiger_test_cases.ml b/compiler/src/lib/tiger/tiger_test_cases.ml index 788c3b7..3ca7bf7 100644 --- a/compiler/src/lib/tiger/tiger_test_cases.ml +++ b/compiler/src/lib/tiger/tiger_test_cases.ml @@ -1,234 +1,59 @@ module Error = Tiger_error module Test = Tiger_test -let book = - [ Test.case - "Book test 1: an array type and an array variable" - ~code: - " \ - /* an array type and an array variable */ \ - let \ - type arrtype = array of int \ - var arr1:arrtype := \ - arrtype [10] of 0 \ - in \ - arr1 \ - end \ - " - ~out_lexing:( - let open Tiger_parser in - [ LET; - TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int"; - VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; - ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; - IN; - ID "arr1"; - END - ] - ) - ; Test.case - "Book test 2: arr1 is valid since expression 0 is int = myint" - ~code: - " \ - /* arr1 is valid since expression 0 is int = myint */ \ - let \ - type myint = int \ - type arrtype = array of myint \ - var arr1:arrtype := \ - arrtype [10] of 0 \ - in \ - arr1 \ - end \ - " - ~out_lexing:( - let open Tiger_parser in - [ LET; - TYPE; ID "myint"; EQ; ID "int"; - TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint"; - VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; - ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; - IN; - ID "arr1"; - END - ] - ) - ; Test.case - "Book test 3: a record type and a record variable" - ~code: - " \ - /* a record type and a record variable */ \ - let \ - type rectype = \ - { name : string \ - , age : int \ - } \ - var rec1 : rectype := \ - rectype \ - { name = \"Nobody\" \ - , age = 1000 \ - } \ - in \ - rec1.name := \"Somebody\"; \ - rec1 \ - end \ - " - ~out_lexing:( - let open Tiger_parser in - [ LET; - TYPE; ID "rectype"; EQ; - LBRACE; ID "name"; COLON; ID "string"; - COMMA; ID "age"; COLON; ID "int"; - RBRACE; - VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN; - ID "rectype"; - LBRACE; ID "name"; EQ; STRING "Nobody"; - COMMA; ID "age"; EQ; INT 1000; - RBRACE; - IN; - ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON; - ID "rec1"; - END - ] - ) - ; Test.case - "Book test 4: define a recursive function" - ~code: - " \ - /* define a recursive function */ \ - let \ - \ - /* calculate n! */ \ - function nfactor(n: int): int = \ - if n = 0 \ - then 1 \ - else n * nfactor(n-1) \ - \ - in \ - nfactor(10) \ - end \ - " - ~out_lexing:( - let open Tiger_parser in - [ LET; - FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ; - IF; ID "n"; EQ; INT 0; - THEN; INT 1; - ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN; - IN; - ID "nfactor"; LPAREN; INT 10; RPAREN; - END - ] - ) - ; Test.case - "Book test 9: error : types of then - else differ" - ~code: - " \ - /* error : types of then - else differ */ \ - if (5>4) then 13 else \" \" \ - " - ~out_lexing:( - let open Tiger_parser in - [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " " - ] - ) - ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *) - ; Test.case - "Book test: 8-queens" - ~code: - "\ - /* A program to solve the 8-queens problem */ \n\ - \n\ - let \n\ - var N := 8 \n\ - \n\ - type intArray = array of int \n\ - \n\ - var row := intArray [ N ] of 0 \n\ - var col := intArray [ N ] of 0 \n\ - var diag1 := intArray [N+N-1] of 0 \n\ - var diag2 := intArray [N+N-1] of 0 \n\ - \n\ - function printboard() = ( \n\ - for i := 0 to N-1 do ( \n\ - for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\ - print(\"\n\") \n\ - ); \n\ - print(\"\n\") \n\ - ) \n\ - \n\ - function try(c:int) = ( \n\ - /* for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\ - if c=N \n\ - then printboard() \n\ - else \n\ - for r := 0 to N-1 \n\ - do \n\ - if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\ - then ( \n\ - row[r] := 1; \n\ - diag1[r+c] := 1; \n\ - diag2[r+7-c] := 1; \n\ - col[c] := r; \n\ - try(c+1); \n\ - row[r] := 0; \n\ - diag1[r+c] := 0; \n\ - diag2[r+7-c] := 0 \n\ - ) \n\ - ) \n\ - in \n\ - try(0) \n\ - end \n\ - " - ] - let micro = let open Tiger_parser in - [ (let code = "nil" in Test.case code ~code ~out_lexing:[NIL]) - ; (let code = "5" in Test.case code ~code ~out_lexing:[INT 5]) - ; (let code = "-5" in Test.case code ~code ~out_lexing:[MINUS; INT 5]) + [ (let code = "nil" in Test.case code ~code ~out_lexing:(Some [NIL])) + ; (let code = "5" in Test.case code ~code ~out_lexing:(Some [INT 5])) + ; (let code = "-5" in Test.case code ~code ~out_lexing:(Some [MINUS; INT 5])) ; ( let code = "f()" in Test.case code ~code - ~out_lexing:[ID "f"; LPAREN; RPAREN] - ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *) + ~out_lexing:(Some [ID "f"; LPAREN; RPAREN]) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_unknown_id) ) ; ( let code = "abc.i" in Test.case code ~code - ~out_lexing:[ID "abc"; DOT; ID "i"] - ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *) + ~out_lexing:(Some [ID "abc"; DOT; ID "i"]) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_unknown_id) ) ; ( let code = "abc[0]" in Test.case code ~code - ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK] - ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *) + ~out_lexing:(Some [ID "abc"; LBRACK; INT 0; RBRACK]) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_unknown_id) ) ; ( let code = "abc[0] := foo()" in Test.case code ~code ~out_lexing: - [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN] - ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *) + (Some [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_unknown_id) ) ; ( let code = "abc [5] of nil" in Test.case code ~code - ~out_lexing:[ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL] - ~is_error_expected_semant:Error.is_unknown_type (* TODO: Be more specific *) + ~out_lexing:(Some [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_unknown_type) ) ; ( let code = "f(\"a\", 3, foo)" in Test.case code ~code ~out_lexing: - [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN] - ~is_error_expected_semant:Error.is_unknown_id + (Some [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]) + ~is_error_expected_semant:(Some Error.is_unknown_id) ) ; ( let code = "let \ @@ -260,9 +85,13 @@ let micro = Test.case code ~code - ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *) + (* TODO: Be more specific *) + ~is_error_expected_semant:(Some Error.is_wrong_type) ) ] -let all = - book @ micro +let book ~dir = + Tiger_test_cases_book.read ~from_dir:dir + +let all ~dir = + (book ~dir) @ micro diff --git a/compiler/src/lib/tiger/tiger_test_cases.mli b/compiler/src/lib/tiger/tiger_test_cases.mli index 8d0784b..dcbac2b 100644 --- a/compiler/src/lib/tiger/tiger_test_cases.mli +++ b/compiler/src/lib/tiger/tiger_test_cases.mli @@ -1,3 +1,3 @@ -val book : Tiger_test.t list +val book : dir:string -> Tiger_test.t list val micro : Tiger_test.t list -val all : Tiger_test.t list +val all : dir:string -> Tiger_test.t list diff --git a/compiler/src/lib/tiger/tiger_test_cases_book.ml b/compiler/src/lib/tiger/tiger_test_cases_book.ml new file mode 100644 index 0000000..1ef024d --- /dev/null +++ b/compiler/src/lib/tiger/tiger_test_cases_book.ml @@ -0,0 +1,99 @@ +module List = ListLabels + +module Test = Tiger_test + +let read_file filepath = + let {Unix.st_size=size; _} = Unix.stat filepath in + let buf = Buffer.create size in + let ic = open_in filepath in + let rec read () = + try + Buffer.add_channel buf ic size; + read () + with End_of_file -> + () + in + read (); + close_in ic; + Buffer.contents buf + +let out_lexing_of_filename = + let open Tiger_parser in + function + | "test01.tig" -> + Some + [ LET; + TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int"; + VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; + ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; + IN; + ID "arr1"; + END + ] + | "test02.tig" -> + Some + [ LET; + TYPE; ID "myint"; EQ; ID "int"; + TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint"; + VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN; + ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0; + IN; + ID "arr1"; + END + ] + | "test03.tig" -> + Some + [ LET; + TYPE; ID "rectype"; EQ; + LBRACE; ID "name"; COLON; ID "string"; + COMMA; ID "age"; COLON; ID "int"; + RBRACE; + VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN; + ID "rectype"; + LBRACE; ID "name"; EQ; STRING "Nobody"; + COMMA; ID "age"; EQ; INT 1000; + RBRACE; + IN; + ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON; + ID "rec1"; + END + ] + | "test04.tig" -> + Some + [ LET; + FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ; + IF; ID "n"; EQ; INT 0; + THEN; INT 1; + ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN; + IN; + ID "nfactor"; LPAREN; INT 10; RPAREN; + END + ] + | "test09.tig" -> + Some + [IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "] + | _ -> + (* TODO: Fill-in other expected cases *) + None + +let out_parsing_of_filename _ = + (* TODO: Fill-in expected cases *) + None + +let is_error_expected_semant_of_filename _ = + (* TODO: Fill-in expected cases *) + None + +let test_case_of_filename filename ~dir = + Test.case + filename + ~code:(read_file (Filename.concat dir filename)) + ~out_lexing:(out_lexing_of_filename filename) + ~out_parsing:(out_parsing_of_filename filename) + ~is_error_expected_semant:(is_error_expected_semant_of_filename filename) + +let read ~from_dir:dir = + Sys.readdir dir + |> Array.to_list + |> List.sort ~cmp:compare + |> List.map ~f:(test_case_of_filename ~dir) diff --git a/compiler/src/lib/tiger/tiger_test_cases_book.mli b/compiler/src/lib/tiger/tiger_test_cases_book.mli new file mode 100644 index 0000000..64e5fe1 --- /dev/null +++ b/compiler/src/lib/tiger/tiger_test_cases_book.mli @@ -0,0 +1,2 @@ +val read : from_dir:string -> Tiger_test.t list +(** Raises on errors *) diff --git a/compiler/testcases/merge.tig b/compiler/testcases/merge.tig new file mode 100644 index 0000000..39f98d5 --- /dev/null +++ b/compiler/testcases/merge.tig @@ -0,0 +1,56 @@ +let + + type any = {any : int} + var buffer := getchar() + +function readint(any: any) : int = + let var i := 0 + function isdigit(s : string) : int = + ord(buffer)>=ord("0") & ord(buffer)<=ord("9") + function skipto() = + while buffer=" " | buffer="\n" + do buffer := getchar() + in skipto(); + any.any := isdigit(buffer); + while isdigit(buffer) + do (i := i*10+ord(buffer)-ord("0"); buffer := getchar()); + i + end + + type list = {first: int, rest: list} + + function readlist() : list = + let var any := any{any=0} + var i := readint(any) + in if any.any + then list{first=i,rest=readlist()} + else nil + end + + function merge(a: list, b: list) : list = + if a=nil then b + else if b=nil then a + else if a.first < b.first + then list{first=a.first,rest=merge(a.rest,b)} + else list{first=b.first,rest=merge(a,b.rest)} + + function printint(i: int) = + let function f(i:int) = if i>0 + then (f(i/10); print(chr(i-i/10*10+ord("0")))) + in if i<0 then (print("-"); f(-i)) + else if i>0 then f(i) + else print("0") + end + + function printlist(l: list) = + if l=nil then print("\n") + else (printint(l.first); print(" "); printlist(l.rest)) + + var list1 := readlist() + var list2 := (buffer:=getchar(); readlist()) + + + /* BODY OF MAIN PROGRAM */ + in printlist(merge(list1,list2)) +end + diff --git a/compiler/testcases/queens.tig b/compiler/testcases/queens.tig new file mode 100644 index 0000000..1254b12 --- /dev/null +++ b/compiler/testcases/queens.tig @@ -0,0 +1,42 @@ +/* A program to solve the 8-queens problem */ + +let + var N := 8 + + type intArray = array of int + + var row := intArray [ N ] of 0 + var col := intArray [ N ] of 0 + var diag1 := intArray [N+N-1] of 0 + var diag2 := intArray [N+N-1] of 0 + + function printboard() = ( + for i := 0 to N-1 do ( + for j := 0 to N-1 do print(if col[i]=j then " O" else " ."); + print("\n") + ); + print("\n") + ) + + function try(c:int) = ( + /* for i:= 0 to c do print("."); print("\n"); flush();*/ + if c=N + then printboard() + else + for r := 0 to N-1 + do + if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 + then ( + row[r] := 1; + diag1[r+c] := 1; + diag2[r+7-c] := 1; + col[c] := r; + try(c+1); + row[r] := 0; + diag1[r+c] := 0; + diag2[r+7-c] := 0 + ) + ) +in + try(0) +end diff --git a/compiler/testcases/test01.tig b/compiler/testcases/test01.tig new file mode 100644 index 0000000..3c73fb4 --- /dev/null +++ b/compiler/testcases/test01.tig @@ -0,0 +1,7 @@ +/* an array type and an array variable */ +let + type arrtype = array of int + var arr1:arrtype := arrtype [10] of 0 +in + arr1 +end diff --git a/compiler/testcases/test02.tig b/compiler/testcases/test02.tig new file mode 100644 index 0000000..8ee0b96 --- /dev/null +++ b/compiler/testcases/test02.tig @@ -0,0 +1,9 @@ +/* arr1 is valid since expression 0 is int = myint */ +let + type myint = int + type arrtype = array of myint + + var arr1:arrtype := arrtype [10] of 0 +in + arr1 +end diff --git a/compiler/testcases/test03.tig b/compiler/testcases/test03.tig new file mode 100644 index 0000000..7f03ff0 --- /dev/null +++ b/compiler/testcases/test03.tig @@ -0,0 +1,8 @@ +/* a record type and a record variable */ +let + type rectype = {name:string, age:int} + var rec1:rectype := rectype {name="Nobody", age=1000} +in + rec1.name := "Somebody"; + rec1 +end diff --git a/compiler/testcases/test04.tig b/compiler/testcases/test04.tig new file mode 100644 index 0000000..59fd5b8 --- /dev/null +++ b/compiler/testcases/test04.tig @@ -0,0 +1,13 @@ +/* define a recursive function */ +let + +/* calculate n! */ +function nfactor(n: int): int = + if n = 0 + then 1 + else n * nfactor(n-1) + +in + nfactor(10) +end + diff --git a/compiler/testcases/test05.tig b/compiler/testcases/test05.tig new file mode 100644 index 0000000..5af7ca5 --- /dev/null +++ b/compiler/testcases/test05.tig @@ -0,0 +1,14 @@ +/* define valid recursive types */ +let +/* define a list */ +type intlist = {hd: int, tl: intlist} + +/* define a tree */ +type tree ={key: int, children: treelist} +type treelist = {hd: tree, tl: treelist} + +var lis:intlist := intlist { hd=0, tl= nil } + +in + lis +end diff --git a/compiler/testcases/test06.tig b/compiler/testcases/test06.tig new file mode 100644 index 0000000..c0daa0d --- /dev/null +++ b/compiler/testcases/test06.tig @@ -0,0 +1,13 @@ +/* define valid mutually recursive procedures */ +let + +function do_nothing1(a: int, b: string)= + do_nothing2(a+1) + +function do_nothing2(d: int) = + do_nothing1(d, "str") + +in + do_nothing1(0, "str2") +end + diff --git a/compiler/testcases/test07.tig b/compiler/testcases/test07.tig new file mode 100644 index 0000000..534c2a2 --- /dev/null +++ b/compiler/testcases/test07.tig @@ -0,0 +1,13 @@ +/* define valid mutually recursive functions */ +let + +function do_nothing1(a: int, b: string):int= + (do_nothing2(a+1);0) + +function do_nothing2(d: int):string = + (do_nothing1(d, "str");" ") + +in + do_nothing1(0, "str2") +end + diff --git a/compiler/testcases/test08.tig b/compiler/testcases/test08.tig new file mode 100644 index 0000000..d46f3ec --- /dev/null +++ b/compiler/testcases/test08.tig @@ -0,0 +1,2 @@ +/* correct if */ +if (10 > 20) then 30 else 40 diff --git a/compiler/testcases/test09.tig b/compiler/testcases/test09.tig new file mode 100644 index 0000000..64ff9f9 --- /dev/null +++ b/compiler/testcases/test09.tig @@ -0,0 +1,3 @@ +/* error : types of then - else differ */ + +if (5>4) then 13 else " " diff --git a/compiler/testcases/test10.tig b/compiler/testcases/test10.tig new file mode 100644 index 0000000..d4038d7 --- /dev/null +++ b/compiler/testcases/test10.tig @@ -0,0 +1,2 @@ +/* error : body of while not unit */ +while(10 > 5) do 5+6 diff --git a/compiler/testcases/test11.tig b/compiler/testcases/test11.tig new file mode 100644 index 0000000..6e53126 --- /dev/null +++ b/compiler/testcases/test11.tig @@ -0,0 +1,3 @@ +/* error hi expr is not int, and index variable erroneously assigned to. */ +for i:=10 to " " do + i := i - 1 diff --git a/compiler/testcases/test12.tig b/compiler/testcases/test12.tig new file mode 100644 index 0000000..950d1ad --- /dev/null +++ b/compiler/testcases/test12.tig @@ -0,0 +1,7 @@ +/* valid for and let */ + +let + var a:= 0 +in + for i:=0 to 100 do (a:=a+1;()) +end diff --git a/compiler/testcases/test13.tig b/compiler/testcases/test13.tig new file mode 100644 index 0000000..5491c6c --- /dev/null +++ b/compiler/testcases/test13.tig @@ -0,0 +1,3 @@ +/* error: comparison of incompatible types */ + +3 > "df" diff --git a/compiler/testcases/test14.tig b/compiler/testcases/test14.tig new file mode 100644 index 0000000..9c4a7e0 --- /dev/null +++ b/compiler/testcases/test14.tig @@ -0,0 +1,13 @@ +/* error : compare rec with array */ + +let + + type arrtype = array of int + type rectype = {name:string, id: int} + + var rec := rectype {name="aname", id=0} + var arr := arrtype [3] of 0 + +in + if rec <> arr then 3 else 4 +end diff --git a/compiler/testcases/test15.tig b/compiler/testcases/test15.tig new file mode 100644 index 0000000..1af763e --- /dev/null +++ b/compiler/testcases/test15.tig @@ -0,0 +1,3 @@ +/* error : if-then returns non unit */ + +if 20 then 3 diff --git a/compiler/testcases/test16.tig b/compiler/testcases/test16.tig new file mode 100644 index 0000000..8ff97b1 --- /dev/null +++ b/compiler/testcases/test16.tig @@ -0,0 +1,11 @@ +/* error: mutually recursive types thet do not pass through record or array */ +let + +type a=c +type b=a +type c=d +type d=a + +in + "" +end diff --git a/compiler/testcases/test17.tig b/compiler/testcases/test17.tig new file mode 100644 index 0000000..5ba01b8 --- /dev/null +++ b/compiler/testcases/test17.tig @@ -0,0 +1,10 @@ +/* error: definition of recursive types is interrupted */ +let +/* define a tree */ +type tree ={key: int, children: treelist} +var d:int :=0 +type treelist = {hd: tree, tl: treelist} + +in + d +end diff --git a/compiler/testcases/test18.tig b/compiler/testcases/test18.tig new file mode 100644 index 0000000..9792e48 --- /dev/null +++ b/compiler/testcases/test18.tig @@ -0,0 +1,15 @@ +/* error : definition of recursive functions is interrupted */ +let + +function do_nothing1(a: int, b: string):int= + (do_nothing2(a+1);0) + +var d:=0 + +function do_nothing2(d: int):string = + (do_nothing1(d, "str");" ") + +in + do_nothing1(0, "str2") +end + diff --git a/compiler/testcases/test19.tig b/compiler/testcases/test19.tig new file mode 100644 index 0000000..2912ca4 --- /dev/null +++ b/compiler/testcases/test19.tig @@ -0,0 +1,13 @@ +/* error : second function uses variables local to the first one, undeclared variable */ +let + +function do_nothing1(a: int, b: string):int= + (do_nothing2(a+1);0) + +function do_nothing2(d: int):string = + (do_nothing1(a, "str");" ") + +in + do_nothing1(0, "str2") +end + diff --git a/compiler/testcases/test20.tig b/compiler/testcases/test20.tig new file mode 100644 index 0000000..e3d21ae --- /dev/null +++ b/compiler/testcases/test20.tig @@ -0,0 +1,3 @@ +/* error: undeclared variable i */ + +while 10 > 5 do (i+1;()) diff --git a/compiler/testcases/test21.tig b/compiler/testcases/test21.tig new file mode 100644 index 0000000..4501854 --- /dev/null +++ b/compiler/testcases/test21.tig @@ -0,0 +1,13 @@ +/* error : procedure returns value and procedure is used in arexpr */ +let + +/* calculate n! */ +function nfactor(n: int) = + if n = 0 + then 1 + else n * nfactor(n-1) + +in + nfactor(10) +end + diff --git a/compiler/testcases/test22.tig b/compiler/testcases/test22.tig new file mode 100644 index 0000000..b6f2ef3 --- /dev/null +++ b/compiler/testcases/test22.tig @@ -0,0 +1,8 @@ +/* error : field not in record type */ + +let + type rectype = {name:string , id:int} + var rec1 := rectype {name="Name", id=0} +in + rec1.nam := "asd" +end diff --git a/compiler/testcases/test23.tig b/compiler/testcases/test23.tig new file mode 100644 index 0000000..e501c2a --- /dev/null +++ b/compiler/testcases/test23.tig @@ -0,0 +1,9 @@ +/* error : type mismatch */ + +let + type rectype = {name:string , id:int} + var rec1 := rectype {name="aname", id=0} +in + rec1.name := 3; + rec1.id := "" +end diff --git a/compiler/testcases/test24.tig b/compiler/testcases/test24.tig new file mode 100644 index 0000000..2f51aef --- /dev/null +++ b/compiler/testcases/test24.tig @@ -0,0 +1,7 @@ +/* error : variable not array */ +let + var d:=0 +in + d[3] +end + diff --git a/compiler/testcases/test25.tig b/compiler/testcases/test25.tig new file mode 100644 index 0000000..8e9db43 --- /dev/null +++ b/compiler/testcases/test25.tig @@ -0,0 +1,7 @@ +/* error : variable not record */ +let + var d:=0 +in + d.f +end + diff --git a/compiler/testcases/test26.tig b/compiler/testcases/test26.tig new file mode 100644 index 0000000..bdd89fe --- /dev/null +++ b/compiler/testcases/test26.tig @@ -0,0 +1,3 @@ +/* error : integer required */ + +3 + "var" diff --git a/compiler/testcases/test27.tig b/compiler/testcases/test27.tig new file mode 100644 index 0000000..957adfe --- /dev/null +++ b/compiler/testcases/test27.tig @@ -0,0 +1,8 @@ +/* locals hide globals */ +let + var a:=0 + + function g(a:int):int = a +in + g(2) +end diff --git a/compiler/testcases/test28.tig b/compiler/testcases/test28.tig new file mode 100644 index 0000000..61db8cb --- /dev/null +++ b/compiler/testcases/test28.tig @@ -0,0 +1,10 @@ +/* error : different record types */ + +let + type rectype1 = {name:string , id:int} + type rectype2 = {name:string , id:int} + + var rec1: rectype1 := rectype2 {name="Name", id=0} +in + rec1 +end diff --git a/compiler/testcases/test29.tig b/compiler/testcases/test29.tig new file mode 100644 index 0000000..9692eb4 --- /dev/null +++ b/compiler/testcases/test29.tig @@ -0,0 +1,10 @@ +/* error : different array types */ + +let + type arrtype1 = array of int + type arrtype2 = array of int + + var arr1: arrtype1 := arrtype2 [10] of 0 +in + arr1 +end diff --git a/compiler/testcases/test30.tig b/compiler/testcases/test30.tig new file mode 100644 index 0000000..fa5c96b --- /dev/null +++ b/compiler/testcases/test30.tig @@ -0,0 +1,10 @@ +/* synonyms are fine */ + +let + type a = array of int + type b = a + + var arr1:a := b [10] of 0 +in + arr1[2] +end diff --git a/compiler/testcases/test31.tig b/compiler/testcases/test31.tig new file mode 100644 index 0000000..47d9449 --- /dev/null +++ b/compiler/testcases/test31.tig @@ -0,0 +1,6 @@ +/* error : type constraint and init value differ */ +let + var a:int := " " +in + a +end diff --git a/compiler/testcases/test32.tig b/compiler/testcases/test32.tig new file mode 100644 index 0000000..95ffedd --- /dev/null +++ b/compiler/testcases/test32.tig @@ -0,0 +1,9 @@ +/* error : initializing exp and array type differ */ + +let + type arrayty = array of int + + var a := arrayty [10] of " " +in + 0 +end diff --git a/compiler/testcases/test33.tig b/compiler/testcases/test33.tig new file mode 100644 index 0000000..099ab39 --- /dev/null +++ b/compiler/testcases/test33.tig @@ -0,0 +1,6 @@ +/* error : unknown type */ +let + var a:= rectype {} +in + 0 +end diff --git a/compiler/testcases/test34.tig b/compiler/testcases/test34.tig new file mode 100644 index 0000000..3929a3c --- /dev/null +++ b/compiler/testcases/test34.tig @@ -0,0 +1,6 @@ +/* error : formals and actuals have different types */ +let + function g (a:int , b:string):int = a +in + g("one", "two") +end diff --git a/compiler/testcases/test35.tig b/compiler/testcases/test35.tig new file mode 100644 index 0000000..8c6d01d --- /dev/null +++ b/compiler/testcases/test35.tig @@ -0,0 +1,6 @@ +/* error : formals are more then actuals */ +let + function g (a:int , b:string):int = a +in + g("one") +end diff --git a/compiler/testcases/test36.tig b/compiler/testcases/test36.tig new file mode 100644 index 0000000..30cd55a --- /dev/null +++ b/compiler/testcases/test36.tig @@ -0,0 +1,6 @@ +/* error : formals are fewer then actuals */ +let + function g (a:int , b:string):int = a +in + g(3,"one",5) +end diff --git a/compiler/testcases/test37.tig b/compiler/testcases/test37.tig new file mode 100644 index 0000000..e13c284 --- /dev/null +++ b/compiler/testcases/test37.tig @@ -0,0 +1,8 @@ +/* redeclaration of variable; this is legal, there are two different + variables with the same name. The second one hides the first. */ +let + var a := 0 + var a := " " +in + 0 +end diff --git a/compiler/testcases/test38.tig b/compiler/testcases/test38.tig new file mode 100644 index 0000000..66843c9 --- /dev/null +++ b/compiler/testcases/test38.tig @@ -0,0 +1,9 @@ +/* This is illegal, since there are two types with the same name + in the same (consecutive) batch of mutually recursive types. + See also test47 */ +let + type a = int + type a = string +in + 0 +end diff --git a/compiler/testcases/test39.tig b/compiler/testcases/test39.tig new file mode 100644 index 0000000..3cccaa9 --- /dev/null +++ b/compiler/testcases/test39.tig @@ -0,0 +1,9 @@ +/* This is illegal, since there are two functions with the same name + in the same (consecutive) batch of mutually recursive functions. + See also test48 */ +let + function g(a:int):int = a + function g(a:int):int = a +in + 0 +end diff --git a/compiler/testcases/test40.tig b/compiler/testcases/test40.tig new file mode 100644 index 0000000..f54bc02 --- /dev/null +++ b/compiler/testcases/test40.tig @@ -0,0 +1,7 @@ +/* error : procedure returns value */ +let + function g(a:int) = a +in + g(2) +end + diff --git a/compiler/testcases/test41.tig b/compiler/testcases/test41.tig new file mode 100644 index 0000000..49ea5c3 --- /dev/null +++ b/compiler/testcases/test41.tig @@ -0,0 +1,10 @@ +/* local types hide global */ +let + type a = int +in + let + type a = string + in + 0 + end +end diff --git a/compiler/testcases/test42.tig b/compiler/testcases/test42.tig new file mode 100644 index 0000000..32ad3e4 --- /dev/null +++ b/compiler/testcases/test42.tig @@ -0,0 +1,30 @@ +/* correct declarations */ +let + +type arrtype1 = array of int +type rectype1 = {name:string, address:string, id: int , age: int} +type arrtype2 = array of rectype1 +type rectype2 = {name : string, dates: arrtype1} + +type arrtype3 = array of string + +var arr1 := arrtype1 [10] of 0 +var arr2 := arrtype2 [5] of rectype1 {name="aname", address="somewhere", id=0, age=0} +var arr3:arrtype3 := arrtype3 [100] of "" + +var rec1 := rectype1 {name="Kapoios", address="Kapou", id=02432, age=44} +var rec2 := rectype2 {name="Allos", dates= arrtype1 [3] of 1900} + +in + +arr1[0] := 1; +arr1[9] := 3; +arr2[3].name := "kati"; +arr2[1].age := 23; +arr3[34] := "sfd"; + +rec1.name := "sdf"; +rec2.dates[0] := 2323; +rec2.dates[2] := 2323 + +end diff --git a/compiler/testcases/test43.tig b/compiler/testcases/test43.tig new file mode 100644 index 0000000..c1d96af --- /dev/null +++ b/compiler/testcases/test43.tig @@ -0,0 +1,7 @@ +/* initialize with unit and causing type mismatch in addition */ + +let + var a := () +in + a + 3 +end diff --git a/compiler/testcases/test44.tig b/compiler/testcases/test44.tig new file mode 100644 index 0000000..afae869 --- /dev/null +++ b/compiler/testcases/test44.tig @@ -0,0 +1,11 @@ +/* valid nil initialization and assignment */ +let + + type rectype = {name:string, id:int} + var b:rectype := nil + +in + + b := nil + +end diff --git a/compiler/testcases/test45.tig b/compiler/testcases/test45.tig new file mode 100644 index 0000000..21f9555 --- /dev/null +++ b/compiler/testcases/test45.tig @@ -0,0 +1,8 @@ +/* error: initializing nil expressions not constrained by record type */ +let + type rectype = {name:string, id:int} + + var a:= nil +in + a +end diff --git a/compiler/testcases/test46.tig b/compiler/testcases/test46.tig new file mode 100644 index 0000000..4aed888 --- /dev/null +++ b/compiler/testcases/test46.tig @@ -0,0 +1,8 @@ +/* valid rec comparisons */ +let + type rectype = {name:string, id:int} + var b:rectype := nil +in + b = nil; + b <> nil +end diff --git a/compiler/testcases/test47.tig b/compiler/testcases/test47.tig new file mode 100644 index 0000000..163eba3 --- /dev/null +++ b/compiler/testcases/test47.tig @@ -0,0 +1,11 @@ +/* This is legal. The second type "a" simply hides the first one. + Because of the intervening variable declaration, the two "a" types + are not in the same batch of mutually recursive types. + See also test38 */ +let + type a = int + var b := 4 + type a = string +in + 0 +end diff --git a/compiler/testcases/test48.tig b/compiler/testcases/test48.tig new file mode 100644 index 0000000..7ba4e14 --- /dev/null +++ b/compiler/testcases/test48.tig @@ -0,0 +1,11 @@ +/* This is legal. The second function "g" simply hides the first one. + Because of the intervening variable declaration, the two "g" functions + are not in the same batch of mutually recursive functions. + See also test39 */ +let + function g(a:int):int = a + type t = int + function g(a:int):int = a +in + 0 +end diff --git a/compiler/testcases/test49.tig b/compiler/testcases/test49.tig new file mode 100644 index 0000000..3aa9e3f --- /dev/null +++ b/compiler/testcases/test49.tig @@ -0,0 +1,8 @@ +/* error: syntax error, nil should not be preceded by type-id. */ +let + type rectype = {name:string, id:int} + + var a:= rectype nil +in + a +end