compiler/src/exe/tiger_tests.ml

   1 open Printf
   2
   3 module List = ListLabels
   4
   5 let test_case_from_book_01 =
   6   let name = "an array type and an array variable" in
   7   let code =
   8     " \
   9     /* "^name^" */ \
  10     let \
  11       type arrtype = array of int \
  12       var arr1:arrtype := \
  13         arrtype [10] of 0 \
  14     in \
  15       arr1 \
  16     end \
  17     "
  18   in
  19   let tokens =
  20     let open Tiger.Parser in
  21     [ LET;
  22         TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
  23         VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  24           ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  25       IN;
  26         ID "arr1";
  27       END
  28     ]
  29   in
  30   (name, code, tokens)
  31
  32 let test_case_from_book_02 =
  33   let name = "arr1 is valid since expression 0 is int = myint" in
  34   let code =
  35     " \
  36     /* "^name^" */ \
  37     let \
  38       type myint = int \
  39       type arrtype = array of myint \
  40       var arr1:arrtype := \
  41         arrtype [10] of 0 \
  42     in \
  43       arr1 \
  44     end \
  45     "
  46   in
  47   let tokens =
  48     let open Tiger.Parser in
  49     [ LET;
  50         TYPE; ID "myint"; EQ; ID "int";
  51         TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
  52         VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  53           ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  54       IN;
  55         ID "arr1";
  56       END
  57     ]
  58   in
  59   (name, code, tokens)
  60
  61 let test_case_from_book_03 =
  62   let name = "a record type and a record variable" in
  63   let code =
  64     " \
  65     /* "^name^" */ \
  66     let \
  67       type rectype = \
  68         { name : string \
  69         , age  : int \
  70         } \
  71       var rec1 : rectype := \
  72         rectype \
  73         { name = \"Nobody\" \
  74         , age  = 1000 \
  75         } \
  76     in \
  77       rec1.name := \"Somebody\"; \
  78       rec1 \
  79     end \
  80     "
  81   in
  82   let tokens =
  83     let open Tiger.Parser in
  84     [ LET;
  85         TYPE; ID "rectype"; EQ;
  86           LBRACE; ID "name"; COLON; ID "string";
  87           COMMA;  ID "age";  COLON; ID "int";
  88           RBRACE;
  89         VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
  90           ID "rectype";
  91           LBRACE; ID "name"; EQ; STRING "Nobody";
  92           COMMA;  ID "age";  EQ; INT 1000;
  93           RBRACE;
  94       IN;
  95         ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
  96         ID "rec1";
  97       END
  98     ]
  99   in
 100   (name, code, tokens)
 101
 102 let test_case_from_book_04 =
 103   let name = "define a recursive function" in
 104   let code =
 105     " \
 106     /* "^name^" */ \
 107     let \
 108     \
 109       /* calculate n! */ \
 110       function nfactor(n: int): int = \
 111         if n = 0  \
 112         then 1 \
 113         else n * nfactor(n-1) \
 114     \
 115     in \
 116       nfactor(10) \
 117     end \
 118     "
 119   in
 120   let tokens =
 121     let open Tiger.Parser in
 122     [ LET;
 123         FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
 124           IF; ID "n"; EQ; INT 0;
 125           THEN; INT 1;
 126           ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
 127       IN;
 128         ID "nfactor"; LPAREN; INT 10; RPAREN;
 129       END
 130     ]
 131   in
 132   (name, code, tokens)
 133
 134 let test_case_from_book_09 =
 135   let name = "error : types of then - else differ" in
 136   let code =
 137     " \
 138     /* "^name^" */ \
 139     if (5>4) then 13 else  \" \" \
 140     "
 141   in
 142   let tokens =
 143     let open Tiger.Parser in
 144     [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
 145     ]
 146   in
 147   (* TODO: Type error test case *)
 148   (name, code, tokens)
 149
 150 (*
 151 let test_case_from_book_queens =
 152   let code =
 153     "\
 154     /* A program to solve the 8-queens problem */ \n\
 155  \n\
 156     let \n\
 157       var N := 8 \n\
 158  \n\
 159       type intArray = array of int \n\
 160  \n\
 161       var row := intArray [ N ] of 0 \n\
 162       var col := intArray [ N ] of 0 \n\
 163       var diag1 := intArray [N+N-1] of 0 \n\
 164       var diag2 := intArray [N+N-1] of 0 \n\
 165  \n\
 166       function printboard() = ( \n\
 167         for i := 0 to N-1 do ( \n\
 168           for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
 169           print(\"\n\") \n\
 170         ); \n\
 171         print(\"\n\") \n\
 172       ) \n\
 173  \n\
 174       function try(c:int) = ( \n\
 175         /*  for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
 176         if c=N \n\
 177         then printboard() \n\
 178         else \n\
 179           for r := 0 to N-1 \n\
 180           do \n\
 181             if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
 182             then ( \n\
 183               row[r]       := 1; \n\
 184               diag1[r+c]   := 1; \n\
 185               diag2[r+7-c] := 1; \n\
 186               col[c]       := r; \n\
 187               try(c+1); \n\
 188               row[r]       := 0; \n\
 189               diag1[r+c]   := 0; \n\
 190               diag2[r+7-c] := 0 \n\
 191             ) \n\
 192       ) \n\
 193     in \n\
 194       try(0) \n\
 195     end \n\
 196     "
 197   in
 198   (code, code, [])
 199 *)
 200
 201 let test_cases_from_book =
 202   [ test_case_from_book_01
 203   ; test_case_from_book_02
 204   ; test_case_from_book_03
 205   ; test_case_from_book_04
 206   ; test_case_from_book_09
 207   (*; test_case_from_book_queens*)
 208   ]
 209
 210 let tests_micro_cases =
 211   let open Tiger.Parser in
 212   [ (
 213       let code =
 214         "nil"
 215       in
 216       let tokens =
 217         [NIL]
 218       in
 219       (code, code, tokens)
 220     )
 221   ; (
 222       let code =
 223         "5"
 224       in
 225       let tokens =
 226         [INT 5]
 227       in
 228       (code, code, tokens)
 229     )
 230   ; (
 231       let code =
 232         "-5"
 233       in
 234       let tokens =
 235         [MINUS; INT 5]
 236       in
 237       (code, code, tokens)
 238     )
 239   ; (
 240       let code =
 241         "f()"
 242       in
 243       let tokens =
 244         [ID "f"; LPAREN; RPAREN]
 245       in
 246       (code, code, tokens)
 247     )
 248   ; (
 249       let code =
 250         "f(\"a\", 3, foo)"
 251       in
 252       let tokens =
 253         [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]
 254       in
 255       (code, code, tokens)
 256     )
 257   ; (
 258       let code =
 259         "abc.i"
 260       in
 261       let tokens =
 262         [ID "abc"; DOT; ID "i"]
 263       in
 264       (code, code, tokens)
 265     )
 266   ; (
 267       let code =
 268         "abc [5] of nil"
 269       in
 270       let tokens =
 271         [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]
 272       in
 273       (code, code, tokens)
 274     )
 275   ; (
 276       let code =
 277         "abc[0]"
 278       in
 279       let tokens =
 280         [ID "abc"; LBRACK; INT 0; RBRACK]
 281       in
 282       (code, code, tokens)
 283     )
 284   ; (
 285       let code =
 286         "abc[0] := foo()"
 287       in
 288       let tokens =
 289         [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]
 290       in
 291       (code, code, tokens)
 292     )
 293   ]
 294
 295 let tests =
 296   test_cases_from_book @ tests_micro_cases
 297
 298 let () =
 299   let tokens_of_code code =
 300     let lexbuf = Lexing.from_string code in
 301     let rec tokens () =
 302       let token = Tiger.Lexer.token lexbuf in
 303       (* Avoiding fragile pattern-matching *)
 304       if token = Tiger.Parser.EOF then [] else token :: tokens ()
 305     in
 306     tokens ()
 307   in
 308   let parsetree_of_code code =
 309     let lb = Lexing.from_string code in
 310     (match Tiger.Parser.program Tiger.Lexer.token lb with
 311     | exception Parsing.Parse_error ->
 312         let module L = Lexing in
 313         let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
 314         let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
 315         Error msg
 316     | absyn ->
 317         Ok (Tiger.Absyn.to_string absyn)
 318     )
 319   in
 320   let bar_sep = String.make 80 '-' in
 321   let bar_end = String.make 80 '=' in
 322   let indent n = String.make (2 * n) ' ' in
 323   let color_on_green = "\027[0;32m" in
 324   let color_on_red   = "\027[1;31m" in
 325   let color_off      = "\027[0m" in
 326   List.iteri tests ~f:(fun i (name, code, tokens_expected) ->
 327     let i = i + 1 in  (* Because iteri starts with 0 *)
 328     printf "%s\n%sTest %d : %S\n" bar_sep (indent 0) i name;
 329
 330     printf "%sLexing : " (indent 1);
 331     let tokens_emitted = tokens_of_code code in
 332     (try
 333       assert (tokens_emitted = tokens_expected);
 334       printf "%sOK%s\n" color_on_green color_off;
 335     with Assert_failure _ ->
 336       let tokens_to_string tokens =
 337         String.concat "; " (List.map ~f:Tiger.Parser_token.to_string tokens)
 338       in
 339       printf
 340         "%sERROR%s\n%sExpected: %s\n%sEmitted : %s\n\n"
 341         color_on_red
 342         color_off
 343         (indent 2)
 344         (tokens_to_string tokens_expected)
 345         (indent 2)
 346         (tokens_to_string tokens_emitted)
 347     );
 348
 349     printf "%sParsing: " (indent 1);
 350     (match parsetree_of_code code with
 351     | Error errmsg -> printf "%sERROR:%s %s\n"   color_on_red   color_off errmsg
 352     | Ok parsetree -> printf "%sOK:%s\n\n%s\n\n" color_on_green color_off parsetree
 353     );
 354
 355   );
 356   print_endline bar_end;