+ let tokens_of_code code =
+ let lexbuf = Lexing.from_string code in
+ let rec tokens () =
+ let token = Tiger.Lexer.token lexbuf in
+ (* Avoiding fragile pattern-matching *)
+ if token = Tiger.Parser.EOF then [] else token :: tokens ()
+ in
+ tokens ()
+ in
+ let parsetree_of_code code =
+ let lb = Lexing.from_string code in
+ (match Tiger.Parser.program Tiger.Lexer.token lb with
+ | exception Parsing.Parse_error ->
+ let module L = Lexing in
+ let L.({lex_curr_p = {pos_lnum=l; pos_bol=b; pos_cnum=c; _}; _}) = lb in
+ let msg = sprintf "Syntax error around line: %d, column: %d" l (c - b) in
+ Error msg
+ | parsetree ->
+ Ok parsetree
+ )
+ in
+ let bar_sep = String.make 80 '-' in
+ let bar_end = String.make 80 '=' in
+ let indent n = String.make (2 * n) ' ' in
+ let color_on_green = "\027[0;32m" in
+ let color_on_red = "\027[1;31m" in
+ let color_off = "\027[0m" in
+ List.iteri tests ~f:(fun i (name, code, tokens_expected) ->
+ let i = i + 1 in (* Because iteri starts with 0 *)
+ printf "%s\n%sTest %d : %S\n" bar_sep (indent 0) i name;
+
+ printf "%sLexing : " (indent 1);
+ let tokens_emitted = tokens_of_code code in
+ (try
+ assert (tokens_emitted = tokens_expected);
+ printf "%sOK%s\n" color_on_green color_off;
+ with Assert_failure _ ->
+ let tokens_to_string tokens =
+ String.concat "; " (List.map ~f:Tiger.Parser_token.to_string tokens)
+ in
+ printf
+ "%sERROR%s\n%sExpected: %s\n%sEmitted : %s\n\n"
+ color_on_red
+ color_off
+ (indent 2)
+ (tokens_to_string tokens_expected)
+ (indent 2)
+ (tokens_to_string tokens_emitted)
+ );
+
+ printf "%sParsing: " (indent 1);
+ (match parsetree_of_code code with
+ | Error errmsg -> printf "%sERROR:%s %s\n" color_on_red color_off errmsg
+ | Ok parsetree -> printf "%sOK:%s %s\n" color_on_green color_off parsetree
+ );
+
+ );
+ print_endline bar_end;