diff options
| -rw-r--r-- | lib/qparser/lexer.ml | 12 | ||||
| -rw-r--r-- | lib/qparser/parser.mly | 9 | ||||
| -rw-r--r-- | lib/qparser/tokens.mly | 2 | ||||
| -rw-r--r-- | test/make_checkTest.ml | 2 | ||||
| -rw-r--r-- | test/syntax_error.ml | 29 |
5 files changed, 43 insertions, 11 deletions
diff --git a/lib/qparser/lexer.ml b/lib/qparser/lexer.ml index 30d151b..4e9aa27 100644 --- a/lib/qparser/lexer.ml +++ b/lib/qparser/lexer.ml @@ -188,16 +188,20 @@ let rec parse_token : Lexbuf.t -> token = | '#', Star space, location -> (* Extract the location name *) let ident = Lexbuf.content buffer in - let () = + let ident_name = match Str.string_match location_name ident 0 with - | false -> () - | true -> Sedlexing.set_filename lexbuf (Str.matched_group 1 ident) + | false -> ident + | true -> Str.matched_group 1 ident in (* Restart the line number (new location here) *) Lexbuf.start buffer; - LOCATION_START ident + LOCATION_START + (fun () -> + Sedlexing.set_filename lexbuf ident_name; + (* Restart the line number (new location here) *) + ident_name) | '_', Star space, eol, Star space -> (* The _ character can be used to break lines *) parse_token buffer diff --git a/lib/qparser/parser.mly b/lib/qparser/parser.mly index 73d77b7..6fc9b8f 100644 --- a/lib/qparser/parser.mly +++ b/lib/qparser/parser.mly @@ -25,7 +25,7 @@ main: | before_location* - LOCATION_START + start_location EOL+ instructions = line_statement* LOCATION_END @@ -38,6 +38,13 @@ before_location: | EOL {} | COMMENT EOL { } +(* Defer the registration here, and ensure we get a valid rule. *) +start_location: + | l = LOCATION_START + { + ignore (l ()) + } + (* All these statement should terminate with EOL *) line_statement: | COMMENT EOL+ { Analyzer.Instruction.comment $loc } diff --git a/lib/qparser/tokens.mly b/lib/qparser/tokens.mly index ddbc4cf..90e9e14 100644 --- a/lib/qparser/tokens.mly +++ b/lib/qparser/tokens.mly @@ -1,4 +1,4 @@ -%token <string>LOCATION_START +%token <unit -> string>LOCATION_START %token LOCATION_END %token PLUS diff --git a/test/make_checkTest.ml b/test/make_checkTest.ml index 308d309..2066c22 100644 --- a/test/make_checkTest.ml +++ b/test/make_checkTest.ml @@ -1,5 +1,3 @@ -let _position = (Lexing.dummy_pos, Lexing.dummy_pos) - (** Build a parser for a specific check module *) module M (Check : Qsp_syntax.S.Analyzer) = struct module S = Qsp_syntax.S diff --git a/test/syntax_error.ml b/test/syntax_error.ml index e8d29a2..04b91ad 100644 --- a/test/syntax_error.ml +++ b/test/syntax_error.ml @@ -17,14 +17,16 @@ let get_report : | Ok _ -> failwith "No error" | Error { level; loc; message } -> { level; loc; message } -let _test_instruction : string -> S.pos report -> unit = - fun literal expected -> +let _test_instruction : + ?k:(S.pos report -> unit) -> string -> S.pos report -> unit = + fun ?k literal expected -> let _location = Printf.sprintf {|# Location %s ------- |} literal in let actual = get_report @@ Syntax.parse _location and msg = literal in - Alcotest.(check' report ~msg ~expected ~actual) + let () = Alcotest.(check' report ~msg ~expected ~actual) in + match k with None -> () | Some f -> f actual let else_column () = _test_instruction @@ -186,6 +188,26 @@ let missing_comparable () = _test_instruction "1 <= or 0" result; _test_instruction "1 = or 0" result +(** This code looks like a new location, but is actualy invalid. + The application should report the old location. + *) +let location_change () = + let result = + { + level = Error; + loc = _position; + message = "Missing boolean after operator"; + } + in + _test_instruction "1 and >= # invalid" result ~k:(fun actual -> + let actual = (fst actual.loc).Lexing.pos_fname in + + Alcotest.( + check' ~msg:"The location name is not valid" string ~actual + ~expected:"Location")) + +(* The location name *) + let test = ( "Syntax Errors", [ @@ -202,4 +224,5 @@ let test = Alcotest.test_case "Unclosed block" `Quick unclosed_block; Alcotest.test_case "Unclosed block" `Quick comment_as_operator; Alcotest.test_case "Missing comparable" `Quick missing_comparable; + Alcotest.test_case "Location change" `Quick location_change; ] ) |