compiler/src/lib/tiger/tiger_test_cases.ml

   1 module Error = Tiger_error
   2 module Test = Tiger_test
   3
   4 let book =
   5   [ Test.case
   6       "Book test 1: an array type and an array variable"
   7       ~code:
   8         " \
   9         /* an array type and an array variable */ \
  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       ~out_lexing:(
  19         let open Tiger_parser in
  20         [ LET;
  21             TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
  22             VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  23               ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  24           IN;
  25             ID "arr1";
  26           END
  27         ]
  28       )
  29   ; Test.case
  30       "Book test 2: arr1 is valid since expression 0 is int = myint"
  31       ~code:
  32         " \
  33         /* arr1 is valid since expression 0 is int = myint */ \
  34         let \
  35           type myint = int \
  36           type arrtype = array of myint \
  37           var arr1:arrtype := \
  38             arrtype [10] of 0 \
  39         in \
  40           arr1 \
  41         end \
  42         "
  43     ~out_lexing:(
  44       let open Tiger_parser in
  45       [ LET;
  46           TYPE; ID "myint"; EQ; ID "int";
  47           TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
  48           VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  49             ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  50         IN;
  51           ID "arr1";
  52         END
  53       ]
  54     )
  55   ; Test.case
  56       "Book test 3: a record type and a record variable"
  57       ~code:
  58         " \
  59         /* a record type and a record variable */ \
  60         let \
  61           type rectype = \
  62             { name : string \
  63             , age  : int \
  64             } \
  65           var rec1 : rectype := \
  66             rectype \
  67             { name = \"Nobody\" \
  68             , age  = 1000 \
  69             } \
  70         in \
  71           rec1.name := \"Somebody\"; \
  72           rec1 \
  73         end \
  74         "
  75       ~out_lexing:(
  76         let open Tiger_parser in
  77         [ LET;
  78             TYPE; ID "rectype"; EQ;
  79               LBRACE; ID "name"; COLON; ID "string";
  80               COMMA;  ID "age";  COLON; ID "int";
  81               RBRACE;
  82             VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
  83               ID "rectype";
  84               LBRACE; ID "name"; EQ; STRING "Nobody";
  85               COMMA;  ID "age";  EQ; INT 1000;
  86               RBRACE;
  87           IN;
  88             ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
  89             ID "rec1";
  90           END
  91         ]
  92       )
  93   ; Test.case
  94       "Book test 4: define a recursive function"
  95       ~code:
  96         " \
  97         /* define a recursive function */ \
  98         let \
  99         \
 100           /* calculate n! */ \
 101           function nfactor(n: int): int = \
 102             if n = 0  \
 103             then 1 \
 104             else n * nfactor(n-1) \
 105         \
 106         in \
 107           nfactor(10) \
 108         end \
 109         "
 110       ~out_lexing:(
 111         let open Tiger_parser in
 112         [ LET;
 113             FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
 114               IF; ID "n"; EQ; INT 0;
 115               THEN; INT 1;
 116               ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
 117           IN;
 118             ID "nfactor"; LPAREN; INT 10; RPAREN;
 119           END
 120         ]
 121       )
 122   ; Test.case
 123       "Book test 9: error : types of then - else differ"
 124       ~code:
 125         " \
 126         /* error : types of then - else differ */ \
 127         if (5>4) then 13 else  \" \" \
 128         "
 129       ~out_lexing:(
 130         let open Tiger_parser in
 131         [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
 132         ]
 133       )
 134       ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *)
 135   ; Test.case
 136     "Book test: 8-queens"
 137     ~code:
 138           "\
 139           /* A program to solve the 8-queens problem */ \n\
 140        \n\
 141           let \n\
 142             var N := 8 \n\
 143        \n\
 144             type intArray = array of int \n\
 145        \n\
 146             var row := intArray [ N ] of 0 \n\
 147             var col := intArray [ N ] of 0 \n\
 148             var diag1 := intArray [N+N-1] of 0 \n\
 149             var diag2 := intArray [N+N-1] of 0 \n\
 150        \n\
 151             function printboard() = ( \n\
 152               for i := 0 to N-1 do ( \n\
 153                 for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
 154                 print(\"\n\") \n\
 155               ); \n\
 156               print(\"\n\") \n\
 157             ) \n\
 158        \n\
 159             function try(c:int) = ( \n\
 160               /*  for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
 161               if c=N \n\
 162               then printboard() \n\
 163               else \n\
 164                 for r := 0 to N-1 \n\
 165                 do \n\
 166                   if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
 167                   then ( \n\
 168                     row[r]       := 1; \n\
 169                     diag1[r+c]   := 1; \n\
 170                     diag2[r+7-c] := 1; \n\
 171                     col[c]       := r; \n\
 172                     try(c+1); \n\
 173                     row[r]       := 0; \n\
 174                     diag1[r+c]   := 0; \n\
 175                     diag2[r+7-c] := 0 \n\
 176                   ) \n\
 177             ) \n\
 178           in \n\
 179             try(0) \n\
 180           end \n\
 181           "
 182   ]
 183
 184 let micro =
 185   let open Tiger_parser in
 186   [ (let code = "nil"    in Test.case code ~code ~out_lexing:[NIL])
 187   ; (let code = "5"      in Test.case code ~code ~out_lexing:[INT 5])
 188   ; (let code = "-5"     in Test.case code ~code ~out_lexing:[MINUS; INT 5])
 189   ; ( let code = "f()" in
 190       Test.case
 191         code
 192         ~code
 193         ~out_lexing:[ID "f"; LPAREN; RPAREN]
 194         ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
 195     )
 196   ; ( let code = "abc.i" in
 197       Test.case
 198         code
 199         ~code
 200         ~out_lexing:[ID "abc"; DOT; ID "i"]
 201         ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
 202     )
 203   ; ( let code = "abc[0]" in
 204       Test.case
 205         code
 206         ~code
 207         ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK]
 208         ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
 209     )
 210   ; ( let code = "abc[0] := foo()" in
 211       Test.case
 212         code
 213         ~code
 214         ~out_lexing:
 215           [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN]
 216         ~is_error_expected_semant:Error.is_unknown_id (* TODO: Be more specific *)
 217     )
 218   ; ( let code = "abc [5] of nil" in
 219       Test.case
 220         code
 221         ~code
 222         ~out_lexing:[ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL]
 223         ~is_error_expected_semant:Error.is_unknown_type (* TODO: Be more specific *)
 224     )
 225   ; ( let code = "f(\"a\", 3, foo)" in
 226       Test.case
 227         code
 228         ~code
 229         ~out_lexing:
 230           [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN]
 231         ~is_error_expected_semant:Error.is_unknown_id
 232     )
 233   ; ( let code =
 234         "let \
 235             type a = int \
 236             type b = a \
 237             type c = b \
 238             var i : a := 2 \
 239             var j : c := 3 \
 240         in \
 241             i := j \
 242         end \
 243         "
 244       in
 245       Test.case
 246         "Type aliases"
 247         ~code
 248     )
 249   ; ( let code =
 250         "let \
 251             type a = {x:int, y:int} \
 252             type b = {x:int, y:int}  /* new type generated */ \
 253             var foo : a := a {x = 1, y = 2} \
 254             var bar : b := b {x = 1, y = 2} \
 255         in \
 256             foo = bar  /* incompatible types */ \
 257         end \
 258         "
 259       in
 260       Test.case
 261         code
 262         ~code
 263                                 ~is_error_expected_semant:Error.is_wrong_type (* TODO: Be more specific *)
 264     )
 265   ]
 266
 267 let all =
 268   book @ micro