compiler/src/lib/tiger/tiger_test_cases.ml

   1 module Test = Tiger_test
   2
   3 let book =
   4   [ Test.case
   5       "Book test 1: an array type and an array variable"
   6       ~code:
   7         " \
   8         /* an array type and an array variable */ \
   9         let \
  10           type arrtype = array of int \
  11           var arr1:arrtype := \
  12             arrtype [10] of 0 \
  13         in \
  14           arr1 \
  15         end \
  16         "
  17       ~out_lexing:(
  18         let open Tiger_parser in
  19         [ LET;
  20             TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "int";
  21             VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  22               ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  23           IN;
  24             ID "arr1";
  25           END
  26         ]
  27       )
  28   ; Test.case
  29       "Book test 2: arr1 is valid since expression 0 is int = myint"
  30       ~code:
  31         " \
  32         /* arr1 is valid since expression 0 is int = myint */ \
  33         let \
  34           type myint = int \
  35           type arrtype = array of myint \
  36           var arr1:arrtype := \
  37             arrtype [10] of 0 \
  38         in \
  39           arr1 \
  40         end \
  41         "
  42     ~out_lexing:(
  43       let open Tiger_parser in
  44       [ LET;
  45           TYPE; ID "myint"; EQ; ID "int";
  46           TYPE; ID "arrtype"; EQ; ARRAY; OF; ID "myint";
  47           VAR; ID "arr1"; COLON; ID "arrtype"; ASSIGN;
  48             ID "arrtype"; LBRACK; INT 10; RBRACK; OF; INT 0;
  49         IN;
  50           ID "arr1";
  51         END
  52       ]
  53     )
  54   ; Test.case
  55       "Book test 3: a record type and a record variable"
  56       ~code:
  57         " \
  58         /* a record type and a record variable */ \
  59         let \
  60           type rectype = \
  61             { name : string \
  62             , age  : int \
  63             } \
  64           var rec1 : rectype := \
  65             rectype \
  66             { name = \"Nobody\" \
  67             , age  = 1000 \
  68             } \
  69         in \
  70           rec1.name := \"Somebody\"; \
  71           rec1 \
  72         end \
  73         "
  74       ~out_lexing:(
  75         let open Tiger_parser in
  76         [ LET;
  77             TYPE; ID "rectype"; EQ;
  78               LBRACE; ID "name"; COLON; ID "string";
  79               COMMA;  ID "age";  COLON; ID "int";
  80               RBRACE;
  81             VAR; ID "rec1"; COLON; ID "rectype"; ASSIGN;
  82               ID "rectype";
  83               LBRACE; ID "name"; EQ; STRING "Nobody";
  84               COMMA;  ID "age";  EQ; INT 1000;
  85               RBRACE;
  86           IN;
  87             ID "rec1"; DOT; ID "name"; ASSIGN; STRING "Somebody"; SEMICOLON;
  88             ID "rec1";
  89           END
  90         ]
  91       )
  92   ; Test.case
  93       "Book test 4: define a recursive function"
  94       ~code:
  95         " \
  96         /* define a recursive function */ \
  97         let \
  98         \
  99           /* calculate n! */ \
 100           function nfactor(n: int): int = \
 101             if n = 0  \
 102             then 1 \
 103             else n * nfactor(n-1) \
 104         \
 105         in \
 106           nfactor(10) \
 107         end \
 108         "
 109       ~out_lexing:(
 110         let open Tiger_parser in
 111         [ LET;
 112             FUNCTION; ID "nfactor"; LPAREN; ID "n"; COLON; ID "int"; RPAREN; COLON; ID "int"; EQ;
 113               IF; ID "n"; EQ; INT 0;
 114               THEN; INT 1;
 115               ELSE; ID "n"; TIMES; ID "nfactor"; LPAREN; ID "n"; MINUS; INT 1; RPAREN;
 116           IN;
 117             ID "nfactor"; LPAREN; INT 10; RPAREN;
 118           END
 119         ]
 120       )
 121   ; Test.case
 122       "Book test 9: error : types of then - else differ"
 123       ~code:
 124         " \
 125         /* error : types of then - else differ */ \
 126         if (5>4) then 13 else  \" \" \
 127         "
 128       ~out_lexing:(
 129         let open Tiger_parser in
 130         [ IF; LPAREN; INT 5; GT; INT 4; RPAREN; THEN; INT 13; ELSE; STRING " "
 131         ]
 132       )
 133   ; Test.case
 134     "Book test: 8-queens"
 135     ~code:
 136           "\
 137           /* A program to solve the 8-queens problem */ \n\
 138        \n\
 139           let \n\
 140             var N := 8 \n\
 141        \n\
 142             type intArray = array of int \n\
 143        \n\
 144             var row := intArray [ N ] of 0 \n\
 145             var col := intArray [ N ] of 0 \n\
 146             var diag1 := intArray [N+N-1] of 0 \n\
 147             var diag2 := intArray [N+N-1] of 0 \n\
 148        \n\
 149             function printboard() = ( \n\
 150               for i := 0 to N-1 do ( \n\
 151                 for j := 0 to N-1 do print(if col[i]=j then \" O\" else \" .\"); \n\
 152                 print(\"\n\") \n\
 153               ); \n\
 154               print(\"\n\") \n\
 155             ) \n\
 156        \n\
 157             function try(c:int) = ( \n\
 158               /*  for i:= 0 to c do print(\".\"); print(\"\n\"); flush();*/ \n\
 159               if c=N \n\
 160               then printboard() \n\
 161               else \n\
 162                 for r := 0 to N-1 \n\
 163                 do \n\
 164                   if row[r]=0 & diag1[r+c]=0 & diag2[r+7-c]=0 \n\
 165                   then ( \n\
 166                     row[r]       := 1; \n\
 167                     diag1[r+c]   := 1; \n\
 168                     diag2[r+7-c] := 1; \n\
 169                     col[c]       := r; \n\
 170                     try(c+1); \n\
 171                     row[r]       := 0; \n\
 172                     diag1[r+c]   := 0; \n\
 173                     diag2[r+7-c] := 0 \n\
 174                   ) \n\
 175             ) \n\
 176           in \n\
 177             try(0) \n\
 178           end \n\
 179           "
 180   ]
 181
 182 let micro =
 183   let open Tiger_parser in
 184   [ (let code = "nil"    in Test.case code ~code ~out_lexing:[NIL])
 185   ; (let code = "5"      in Test.case code ~code ~out_lexing:[INT 5])
 186   ; (let code = "-5"     in Test.case code ~code ~out_lexing:[MINUS; INT 5])
 187   ; (let code = "f()"    in Test.case code ~code ~out_lexing:[ID "f"; LPAREN; RPAREN])
 188   ; (let code = "abc.i"  in Test.case code ~code ~out_lexing:[ID "abc"; DOT; ID "i"])
 189   ; (let code = "abc[0]" in Test.case code ~code ~out_lexing:[ID "abc"; LBRACK; INT 0; RBRACK])
 190
 191   ; (let code = "abc[0] := foo()" in Test.case code ~code
 192       ~out_lexing:
 193         [ID "abc"; LBRACK; INT 0; RBRACK; ASSIGN; ID "foo"; LPAREN; RPAREN])
 194
 195   ; (let code = "abc [5] of nil" in Test.case code ~code
 196       ~out_lexing:
 197         [ID "abc"; LBRACK; INT 5; RBRACK; OF; NIL])
 198
 199   ; (let code = "f(\"a\", 3, foo)" in Test.case code ~code
 200       ~out_lexing:
 201         [ID "f"; LPAREN; STRING "a"; COMMA; INT 3; COMMA; ID "foo"; RPAREN])
 202   ]
 203
 204 let all =
 205   book @ micro