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)
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)
| 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 =
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
=
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 *)
| 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
| 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"
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
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
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
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 \
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
-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
--- /dev/null
+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)
--- /dev/null
+val read : from_dir:string -> Tiger_test.t list
+(** Raises on errors *)
--- /dev/null
+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
+
--- /dev/null
+/* 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
--- /dev/null
+/* an array type and an array variable */
+let
+ type arrtype = array of int
+ var arr1:arrtype := arrtype [10] of 0
+in
+ arr1
+end
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
+
--- /dev/null
+/* 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
--- /dev/null
+/* 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
+
--- /dev/null
+/* 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
+
--- /dev/null
+/* correct if */
+if (10 > 20) then 30 else 40
--- /dev/null
+/* error : types of then - else differ */
+
+if (5>4) then 13 else " "
--- /dev/null
+/* error : body of while not unit */
+while(10 > 5) do 5+6
--- /dev/null
+/* error hi expr is not int, and index variable erroneously assigned to. */
+for i:=10 to " " do
+ i := i - 1
--- /dev/null
+/* valid for and let */
+
+let
+ var a:= 0
+in
+ for i:=0 to 100 do (a:=a+1;())
+end
--- /dev/null
+/* error: comparison of incompatible types */
+
+3 > "df"
--- /dev/null
+/* 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
--- /dev/null
+/* error : if-then returns non unit */
+
+if 20 then 3
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
+
--- /dev/null
+/* 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
+
--- /dev/null
+/* error: undeclared variable i */
+
+while 10 > 5 do (i+1;())
--- /dev/null
+/* 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
+
--- /dev/null
+/* 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
--- /dev/null
+/* error : type mismatch */
+
+let
+ type rectype = {name:string , id:int}
+ var rec1 := rectype {name="aname", id=0}
+in
+ rec1.name := 3;
+ rec1.id := ""
+end
--- /dev/null
+/* error : variable not array */
+let
+ var d:=0
+in
+ d[3]
+end
+
--- /dev/null
+/* error : variable not record */
+let
+ var d:=0
+in
+ d.f
+end
+
--- /dev/null
+/* error : integer required */
+
+3 + "var"
--- /dev/null
+/* locals hide globals */
+let
+ var a:=0
+
+ function g(a:int):int = a
+in
+ g(2)
+end
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* synonyms are fine */
+
+let
+ type a = array of int
+ type b = a
+
+ var arr1:a := b [10] of 0
+in
+ arr1[2]
+end
--- /dev/null
+/* error : type constraint and init value differ */
+let
+ var a:int := " "
+in
+ a
+end
--- /dev/null
+/* error : initializing exp and array type differ */
+
+let
+ type arrayty = array of int
+
+ var a := arrayty [10] of " "
+in
+ 0
+end
--- /dev/null
+/* error : unknown type */
+let
+ var a:= rectype {}
+in
+ 0
+end
--- /dev/null
+/* error : formals and actuals have different types */
+let
+ function g (a:int , b:string):int = a
+in
+ g("one", "two")
+end
--- /dev/null
+/* error : formals are more then actuals */
+let
+ function g (a:int , b:string):int = a
+in
+ g("one")
+end
--- /dev/null
+/* error : formals are fewer then actuals */
+let
+ function g (a:int , b:string):int = a
+in
+ g(3,"one",5)
+end
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* error : procedure returns value */
+let
+ function g(a:int) = a
+in
+ g(2)
+end
+
--- /dev/null
+/* local types hide global */
+let
+ type a = int
+in
+ let
+ type a = string
+ in
+ 0
+ end
+end
--- /dev/null
+/* 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
--- /dev/null
+/* initialize with unit and causing type mismatch in addition */
+
+let
+ var a := ()
+in
+ a + 3
+end
--- /dev/null
+/* valid nil initialization and assignment */
+let
+
+ type rectype = {name:string, id:int}
+ var b:rectype := nil
+
+in
+
+ b := nil
+
+end
--- /dev/null
+/* error: initializing nil expressions not constrained by record type */
+let
+ type rectype = {name:string, id:int}
+
+ var a:= nil
+in
+ a
+end
--- /dev/null
+/* valid rec comparisons */
+let
+ type rectype = {name:string, id:int}
+ var b:rectype := nil
+in
+ b = nil;
+ b <> nil
+end
--- /dev/null
+/* 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
--- /dev/null
+/* 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
--- /dev/null
+/* 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