diff --git a/src/model/reference.ml b/src/model/reference.ml index e96fc12ed8..c9e4eedd7b 100644 --- a/src/model/reference.ml +++ b/src/model/reference.ml @@ -234,27 +234,31 @@ let parse whole_reference_location s : let open Paths.Reference in let open Names in let rec path components next_token tokens : Hierarchy.t = - match (next_token.kind, tokens) with - | `End_in_slash, [] when next_token.identifier = "" -> - (* {!/identifier} *) - (`TAbsolutePath, components) - | `End_in_slash, [] when next_token.identifier = "." -> - (* {!./identifier} *) - (`TRelativePath, components) - | `End_in_slash, [ { kind = `End_in_slash; identifier = ""; _ } ] - when next_token.identifier = "" -> + match (next_token, tokens) with + | { kind = `End_in_slash; identifier; _ }, [] -> ( + match identifier with + | "" -> + (* {!/identifier} *) + (`TAbsolutePath, components) + | "." -> + (* {!./identifier} *) + (`TRelativePath, components) + | c -> + (* {!identifier'/identifier} *) + (`TRelativePath, c :: components)) + | ( { kind = `End_in_slash; identifier = ""; _ }, + [ { kind = `End_in_slash; identifier = ""; _ } ] ) -> (* {!//identifier} *) (`TCurrentPackage, components) - | `End_in_slash, [] -> - (* {!identifier'/identifier} *) - (`TRelativePath, next_token.identifier :: components) - | `End_in_slash, next_token' :: tokens' -> + | { kind = `End_in_slash; identifier; location }, next_token' :: tokens' -> + if identifier = "" then + should_not_be_empty ~what:"Identifier in path reference" location + |> Error.raise_exception; (* {!path/identifier} *) - path (next_token.identifier :: components) next_token' tokens' - | (`None | `Prefixed _), _ -> - (* This is not really expected *) - expected ~expect_paths:true [] next_token.location - |> Error.raise_exception + path (identifier :: components) next_token' tokens' + | { kind = `None | `Prefixed _; _ }, _ -> + (* Cannot be outputed by the lexer. *) + assert false in let ends_in_slash next_token = diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml index 5c20a5b0f3..b3dcd83878 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -2855,6 +2855,31 @@ let%expect_test _ = [%expect {| {"value":[{"`Paragraph":[{"`Code_span":"foo/type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'page-', a path, or an unqualified reference."]} |}] + let err_relative_empty_component = + test "{!foo//bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo//bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in path reference should not be empty."]} |}] + + let err_current_package_empty_component = + test "{!///bar}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"///bar"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in path reference should not be empty."]} |}] + + let err_last_empty_component = + test "{!foo/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + + let err_first_empty_component = + test "{!/}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nIdentifier in reference should not be empty."]} |}] + + let err_current_package_empty_component = + test "{!//}"; + [%expect + {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + (* Old kind compatibility *) let oldkind_abs_page =