Simon Génier pushed to branch lexer-tests at Stefan / Typer Commits: 33b205c5 by Simon Génier at 2021-04-26T16:34:24-04:00 Add tests for the lexer. In addition to the tests themselves, added a few functions that were necessary. In particular there is now Pretoken.equal in Prelexer and Location.equal in Source that are equality predicates on pretokens and locations. I also added in Sexp.sexp_string support for printing the location along with its associated sexp. This is useful in tests, when we check that the locations are correct, otherwise we would print two identical sexps! - - - - - 5 changed files: - src/prelexer.ml - src/sexp.ml - src/source.ml - tests/dune - + tests/lexer_test.ml Changes: ===================================== src/prelexer.ml ===================================== @@ -27,9 +27,23 @@ let prelexer_error loc = Log.log_error ~section:"PRELEXER" ~loc type pretoken = | Pretoken of location * string | Prestring of location * string - (* | Preerror of location * string *) | Preblock of location * pretoken list * location +module Pretoken = struct + type t = pretoken + + (* Equality up to location, i.e. the location is not considered. *) + let rec equal (l : t) (r : t) = + match l, r with + | Pretoken (_, l_name), Pretoken (_, r_name) + -> String.equal l_name r_name + | Prestring (_, l_text), Prestring (_, r_text) + -> String.equal l_text r_text + | Preblock (_, l_inner, _), Preblock (_, r_inner, _) + -> Listx.equal equal l_inner r_inner + | _ -> false +end + (*************** The Pre-Lexer phase *********************) (* In order to allow things like "module Toto { open Titi; ... }" where ===================================== src/sexp.ml ===================================== @@ -67,8 +67,24 @@ let emptyString = hString "" (*************** The Sexp Printer *********************) -let rec sexp_string sexp = - match sexp with +let rec sexp_location (s : sexp) : location = + match s with + | Block (l, _, _) -> l + | Symbol (l, _) -> l + | String (l, _) -> l + | Integer (l, _) -> l + | Float (l, _) -> l + | Node (s, _) -> sexp_location s + +(* Converts a sexp to a string, optionally printing locations as a list preceded + by a Racket-style reader comment (#;). *) +let rec sexp_string ?(print_locations = false) sexp = + (if print_locations + then + let {file; line; column; _} = sexp_location sexp in + Printf.sprintf "#;(\"%s\" %d %d) " file line column + else "") + ^ match sexp with | Block(_,pts,_) -> "{" ^ (pretokens_string pts) ^ " }" | Symbol(_, "") -> "()" (* Epsilon *) | Symbol(_, name) -> name @@ -76,21 +92,12 @@ let rec sexp_string sexp = | Integer(_, n) -> Z.to_string n | Float(_, x) -> string_of_float x | Node(f, args) -> - let str = "(" ^ (sexp_string f) in - (List.fold_left (fun str sxp -> - str ^ " " ^ (sexp_string sxp)) str args) ^ ")" + let str = "(" ^ (sexp_string ~print_locations f) in + (List.fold_left (fun str sxp -> + str ^ " " ^ (sexp_string ~print_locations sxp)) str args) ^ ")" let sexp_print sexp = print_string (sexp_string sexp) -let rec sexp_location s = - match s with - | Block (l, _, _) -> l - | Symbol (l, _) -> l - | String (l, _) -> l - | Integer (l, _) -> l - | Float (l, _) -> l - | Node (s, _) -> sexp_location s - let sexp_name s = match s with | Block _ -> "Block" ===================================== src/source.ml ===================================== @@ -20,6 +20,19 @@ type location = Util.location +module Location = struct + type t = location + + let equal (l : t) (r : t) = + let open Util in + let {file = l_file; line = l_line; column = l_column; docstr = l_doc} = l in + let {file = r_file; line = r_line; column = r_column; docstr = r_doc} = r in + String.equal l_file r_file + && Int.equal l_line r_line + && Int.equal l_column r_column + && String.equal l_doc r_doc +end + (* A source object is text paired with a cursor. The text can be lazily loaded as it is accessed byte by byte, but it must be retained for future reference by error messages. *) ===================================== tests/dune ===================================== @@ -6,6 +6,7 @@ eval_test inverse_test lexp_test + lexer_test macro_test sexp_test unify_test) ===================================== tests/lexer_test.ml ===================================== @@ -0,0 +1,102 @@ +(* Copyright (C) 2021 Free Software Foundation, Inc. + * + * Author: Simon Génier <simon.genier@umontreal.ca> + * Keywords: languages, lisp, dependent types. + * + * This file is part of Typer. + * + * Typer is free software; you can redistribute it and/or modify it under the + * terms of the GNU General Public License as published by the Free Software + * Foundation, either version 3 of the License, or (at your option) any later + * version. + * + * Typer is distributed in the hope that it will be useful, but WITHOUT ANY + * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR + * A PARTICULAR PURPOSE. See the GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License along with + * this program. If not, see <http://www.gnu.org/licenses/>. *) + +open Typerlib + +open Utest_lib + +open Prelexer +open Sexp +open Source + +let test_lex name pretokens expected = + (* Unlike the version in the Sexp module, this version of equality considers + locations. *) + let rec sexp_equal actual expected = + match actual, expected with + | Sexp.Block (actual_start, actual_pretokens, actual_end), + Sexp.Block (expected_start, expected_pretokens, expected_end) + -> Location.equal actual_start expected_start + && Listx.equal Pretoken.equal actual_pretokens expected_pretokens + && Location.equal actual_end expected_end + | Sexp.Symbol (actual_location, actual_name), + Sexp.Symbol (expected_location, expected_name) + -> Location.equal actual_location expected_location + && String.equal actual_name expected_name + | Sexp.Node (actual_head, actual_tail), + Sexp.Node (expected_head, expected_tail) + -> sexp_equal actual_head expected_head + && Listx.equal sexp_equal actual_tail expected_tail + | _, _ -> false + in + let lex () = + let actual = Lexer.lex Grammar.default_stt pretokens in + if Listx.equal sexp_equal actual expected + then success + else + ((* Only print locations if the Sexp are otherwise identical so its easier + to spot the problem. *) + let print_locations = + Listx.equal Sexp.sexp_equal actual expected + in + let print_token token = + Printf.printf "%s\n" (sexp_string ~print_locations token) + in + Printf.printf "%sExpected:%s\n" Fmt.red Fmt.reset; + List.iter print_token expected; + Printf.printf "%sActual:%s\n" Fmt.red Fmt.reset; + List.iter print_token actual; + failure) + in + add_test "LEXER" name lex + +let l : location = + {file = "test.typer"; line = 1; column = 1; docstr = ""} + +let () = + test_lex + "Inner operator inside a presymbol" + [Pretoken (l, "a.b")] + [Node (Symbol ({l with column = 2}, "__.__"), + [Symbol ({l with column = 1}, "a"); + Symbol ({l with column = 3}, "b")])] + +let () = + test_lex + "Inner operators at the beginning of a presymbol" + [Pretoken (l, ".b")] + [Node (Symbol ({l with column = 1}, "__.__"), + [epsilon {l with column = 1}; + Symbol ({l with column = 2}, "b")])] + +let () = + test_lex + "Inner operators at the end of a presymbol" + [Pretoken (l, "a.")] + [Node (Symbol ({l with column = 2}, "__.__"), + [Symbol ({l with column = 1}, "a"); + epsilon {l with column = 3}])] + +let () = + test_lex + "An inner operator by itself is a simple symbol" + [Pretoken (l, ".")] + [Symbol ({l with column = 1}, ".")] + +let () = run_all () View it on GitLab: https://gitlab.com/monnier/typer/-/commit/33b205c5219d9bf4febb21bcabf3c7cbf3... -- View it on GitLab: https://gitlab.com/monnier/typer/-/commit/33b205c5219d9bf4febb21bcabf3c7cbf3... You're receiving this email because of your account on gitlab.com.