Merge pull request ocaml#14654 from MisterDA/fix-14653

Fix non-exhaustive `directive` rule in lexer

Author: gasche

Changes

@@ -129,6 +129,9 @@ Working version
   constructor declarations.
   (Florian Angeletti, review by Gabriel Scherer)
 
+- #14654: Fix non-exhaustive directive rule in lexer.
+  (Antonin Décimo, review by Martin Jambon and Gabriel Scherer)
+
 ### Build system:
 
 ### Bug fixes:

parsing/lexer.mll

@@ -650,9 +650,13 @@ rule token = parse
       }
   | "#"
       { let at_beginning_of_line pos = (pos.pos_cnum = pos.pos_bol) in
-        if not (at_beginning_of_line lexbuf.lex_start_p)
-        then HASH
-        else try directive lexbuf with Failure _ -> HASH
+      if at_beginning_of_line lexbuf.lex_start_p
+         && lex_directive lexbuf
+      then
+        (* [lex_directive] silently updates location information on success;
+           continue to the next token *)
+       token lexbuf
+      else HASH
       }
   | "&"  { AMPERSAND }
   | "&&" { AMPERAMPER }
@@ -727,7 +731,7 @@ rule token = parse
   | (_ as illegal_char)
       { error lexbuf (Illegal_character illegal_char) }
 
-and directive = parse
+and lex_directive = parse
   | ([' ' '\t']* (['0'-'9']+ as num) [' ' '\t']*
         ("\"" ([^ '\010' '\013' '\"' ] * as name) "\"") as directive)
         [^ '\010' '\013'] *
@@ -742,8 +746,16 @@ and directive = parse
               positive, but we have never guarded against this and it
               might have useful hackish uses. *)
             update_loc lexbuf (Some name) (line_num - 1) true 0;
-            token lexbuf
+            true
       }
+  | ""
+      { (* hack: fix the location to include the `#` character we consumed
+           before calling [lex_directive]. *)
+        let pos = lexbuf.lex_start_p in
+        lexbuf.lex_start_p <- { pos with pos_cnum = pos.pos_cnum - 1 };
+        false
+      }
+
 and comment = parse
     "(*"
       { comment_start_loc := (Location.curr lexbuf) :: !comment_start_loc;

testsuite/tests/parsing/hash_ambiguity.compilers.reference

@@ -109,5 +109,36 @@
         ptype_manifest =
           None
     ]
+  structure_item (hash_ambiguity.ml[19,487+0]..[21,510+4])
+    Pstr_type Rec
+    [
+      type_declaration "x" (hash_ambiguity.ml[19,487+8]..[19,487+9]) (hash_ambiguity.ml[19,487+0]..[21,510+4])
+        ptype_params =
+          [
+            core_type (hash_ambiguity.ml[19,487+5]..[19,487+7])
+              Ptyp_var a
+          ]
+        ptype_constraints =
+          []
+        ptype_kind =
+          Ptype_variant
+            [
+              (hash_ambiguity.ml[19,487+12]..[21,510+4])
+                "A" (hash_ambiguity.ml[19,487+12]..[19,487+13])
+                [
+                  core_type (hash_ambiguity.ml[19,487+17]..[21,510+4])
+                    Ptyp_class "list" (hash_ambiguity.ml[21,510+0]..[21,510+4])
+                    [
+                      core_type (hash_ambiguity.ml[19,487+17]..[19,487+20])
+                        Ptyp_constr "int" (hash_ambiguity.ml[19,487+17]..[19,487+20])
+                        []
+                    ]
+                ]
+                None
+            ]
+        ptype_private = Public
+        ptype_manifest =
+          None
+    ]
 ]
 

testsuite/tests/parsing/hash_ambiguity.ml

@@ -16,6 +16,10 @@ type 'a u = A of int #list
 
 type 'a v = A of int * int #list
 
+type 'a x = A of int
+#
+list
+
 (* TEST
  flags = "-stop-after parsing -dparsetree";
  setup-ocamlc.byte-build-env;