From 6140dc40aa8cb9907c81a082b095e4b836b38a9c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 14 Nov 2024 17:22:18 +0100 Subject: [PATCH 1/4] Remove `sections_allowed` as it was not used (apart from in a test) --- src/loader/doc_attr.ml | 3 +- src/markdown/odoc_md.ml | 3 +- src/model/semantics.ml | 78 ++-- src/model/semantics.mli | 2 - test/model/semantics/test.ml | 869 +++++++++++++++++------------------ 5 files changed, 464 insertions(+), 491 deletions(-) diff --git a/src/loader/doc_attr.ml b/src/loader/doc_attr.ml index bf5856597a..d248339547 100644 --- a/src/loader/doc_attr.ml +++ b/src/loader/doc_attr.ml @@ -114,7 +114,7 @@ let pad_loc loc = { loc.Location.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 } let ast_to_comment ~internal_tags parent ast_docs alerts = - Odoc_model.Semantics.ast_to_comment ~internal_tags ~sections_allowed:`All + Odoc_model.Semantics.ast_to_comment ~internal_tags ~tags_allowed:true ~parent_of_sections:parent ast_docs alerts |> Error.raise_warnings @@ -150,7 +150,6 @@ let attached_no_tag parent attrs = let read_string ~tags_allowed internal_tags parent location str = Odoc_model.Semantics.parse_comment ~internal_tags - ~sections_allowed:`All ~tags_allowed ~containing_definition:parent ~location diff --git a/src/markdown/odoc_md.ml b/src/markdown/odoc_md.ml index 1cbe820aba..d8c77f12d4 100644 --- a/src/markdown/odoc_md.ml +++ b/src/markdown/odoc_md.ml @@ -13,8 +13,7 @@ let parse id input_s = Doc_of_md.parse_comment ~location ~text:str () in let (content, ()), semantics_warnings = - Semantics.ast_to_comment ~internal_tags:Expect_none ~sections_allowed:`All - ~tags_allowed:false + Semantics.ast_to_comment ~internal_tags:Expect_none ~tags_allowed:false ~parent_of_sections:(id :> Paths.Identifier.LabelParent.t) content [] |> Error.unpack_warnings diff --git a/src/model/semantics.ml b/src/model/semantics.ml index 3ebedd3034..beec1f3093 100644 --- a/src/model/semantics.ml +++ b/src/model/semantics.ml @@ -105,12 +105,6 @@ let default_raw_markup_target_not_supported : Location.span -> Error.t = Error.make ~suggestion:"try '{%html:...%}'." "'{%%...%%}' (raw markup) needs a target language." -let headings_not_allowed : Location.span -> Error.t = - Error.make "Headings not allowed in this comment." - -let titles_not_allowed : Location.span -> Error.t = - Error.make "Title-level headings {0 ...} are only allowed in pages." - let bad_heading_level : int -> Location.span -> Error.t = Error.make "'%d': bad heading level (0-5 allowed)." @@ -162,7 +156,6 @@ type alerts = [ `Tag of [ `Alert of string * string option ] ] Location_.with_location list type status = { - sections_allowed : sections_allowed; tags_allowed : bool; parent_of_sections : Paths.Identifier.LabelParent.t; } @@ -453,42 +446,27 @@ let section_heading : in (top_heading_level, element) in - - match (status.sections_allowed, level) with - | `None, _any_level -> - Error.raise_warning (headings_not_allowed location); - let text = (text :> Comment.inline_element with_location list) in - let element = - Location.at location - (`Paragraph [ Location.at location (`Styled (`Bold, text)) ]) - in - (top_heading_level, element) - | `No_titles, 0 -> - Error.raise_warning (titles_not_allowed location); - mk_heading `Title - | _, level -> - let level' = - match level with - | 0 -> `Title - | 1 -> `Section - | 2 -> `Subsection - | 3 -> `Subsubsection - | 4 -> `Paragraph - | 5 -> `Subparagraph - | _ -> - Error.raise_warning (bad_heading_level level location); - (* Implicitly promote to level-5. *) - `Subparagraph - in - (match top_heading_level with - | Some top_level - when status.sections_allowed = `All && level <= top_level && level <= 5 - -> - Error.raise_warning - (heading_level_should_be_lower_than_top_level level top_level - location) - | _ -> ()); - mk_heading level' + let level' = + match level with + | 0 -> `Title + | 1 -> `Section + | 2 -> `Subsection + | 3 -> `Subsubsection + | 4 -> `Paragraph + | 5 -> `Subparagraph + | _ -> + Error.raise_warning (bad_heading_level level location); + (* Implicitly promote to level-5. *) + `Subparagraph + in + let () = + match top_heading_level with + | Some top_level when level <= top_level && level <= 5 -> + Error.raise_warning + (heading_level_should_be_lower_than_top_level level top_level location) + | _ -> () + in + mk_heading level' let validate_first_page_heading status ast_element = match status.parent_of_sections.iv with @@ -511,7 +489,7 @@ let top_level_block_elements status ast_elements = | [] -> List.rev comment_elements_acc | ast_element :: ast_elements -> ( (* The first [ast_element] in pages must be a title or section heading. *) - if status.sections_allowed = `All && top_heading_level = None then + if top_heading_level = None then validate_first_page_heading status ast_element; match ast_element with @@ -600,23 +578,23 @@ let append_alerts_to_comment alerts in comment @ (alerts : alerts :> Comment.docs) -let ast_to_comment ~internal_tags ~sections_allowed ~tags_allowed - ~parent_of_sections (ast : Ast.t) alerts = +let ast_to_comment ~internal_tags ~tags_allowed ~parent_of_sections + (ast : Ast.t) alerts = Error.catch_warnings (fun () -> - let status = { sections_allowed; tags_allowed; parent_of_sections } in + let status = { tags_allowed; parent_of_sections } in let ast, tags = strip_internal_tags ast in let elts = top_level_block_elements status ast |> append_alerts_to_comment alerts in (elts, handle_internal_tags tags internal_tags)) -let parse_comment ~internal_tags ~sections_allowed ~tags_allowed - ~containing_definition ~location ~text = +let parse_comment ~internal_tags ~tags_allowed ~containing_definition ~location + ~text = Error.catch_warnings (fun () -> let ast = Odoc_parser.parse_comment ~location ~text |> Error.raise_parser_warnings in - ast_to_comment ~internal_tags ~sections_allowed ~tags_allowed + ast_to_comment ~internal_tags ~tags_allowed ~parent_of_sections:containing_definition ast [] |> Error.raise_warnings) diff --git a/src/model/semantics.mli b/src/model/semantics.mli index f9784c6d99..48105dbe20 100644 --- a/src/model/semantics.mli +++ b/src/model/semantics.mli @@ -13,7 +13,6 @@ type alerts = val ast_to_comment : internal_tags:'tags handle_internal_tags -> - sections_allowed:sections_allowed -> tags_allowed:bool -> parent_of_sections:Paths.Identifier.LabelParent.t -> Odoc_parser.Ast.t -> @@ -22,7 +21,6 @@ val ast_to_comment : val parse_comment : internal_tags:'tags handle_internal_tags -> - sections_allowed:sections_allowed -> tags_allowed:bool -> containing_definition:Paths.Identifier.LabelParent.t -> location:Lexing.position -> diff --git a/test/model/semantics/test.ml b/test/model/semantics/test.ml index 532a6333b6..ed784a24c1 100644 --- a/test/model/semantics/test.ml +++ b/test/model/semantics/test.ml @@ -15,8 +15,8 @@ let parser_output_desc = F ("warnings", snd, List warning_desc); ] ) -let test ?(sections_allowed = `No_titles) ?(tags_allowed = true) - ?(location = { Location_.line = 1; column = 0 }) str = +let test ?(tags_allowed = true) ?(location = { Location_.line = 1; column = 0 }) + str = let dummy_filename = "f.ml" in let dummy_page = Paths.Identifier.Mk.page (None, Names.PageName.make_std dummy_filename) @@ -31,8 +31,7 @@ let test ?(sections_allowed = `No_titles) ?(tags_allowed = true) in let parser_output = Semantics.parse_comment ~internal_tags:Odoc_model.Semantics.Expect_none - ~sections_allowed ~tags_allowed ~containing_definition:dummy_page - ~location ~text:str + ~tags_allowed ~containing_definition:dummy_page ~location ~text:str in let print_json_desc desc t = let yojson = Type_desc_to_yojson.to_yojson desc t in @@ -49,73 +48,73 @@ let%expect_test _ = test "{!foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let leading_whitespace = test "{! foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let trailing_whitespace = test "{!foo }"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let adjacent_word_leading = test "bar{!foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"bar"},{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Word":"bar"},{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let explicit_leading_space = test "bar {!foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"bar"},"`Space",{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Word":"bar"},"`Space",{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let adjacent_word_trailing = test "{!foo}bar"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]},{"`Word":"bar"}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]},{"`Word":"bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let explicit_trailing_space = test "{!foo} bar"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]},"`Space",{"`Word":"bar"}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]},"`Space",{"`Word":"bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let kind = test "{!val:foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let empty = test "{!}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let whitespace_only = test "{! }"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":" "}]}],"warnings":["File \"f.ml\", line 1, characters 2-3:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":" "}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-3:\nIdentifier in reference should not be empty."]} |}] let internal_whitespace = test "{!( * )}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*)","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*)","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let internal_quoted_whitespace = test "{!\"( * )\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["( * )","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["( * )","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] (* TODO Limiting the character combinations allowed will make it easier to catch expressions accidentally written inside references. This can also @@ -125,103 +124,103 @@ let%expect_test _ = test "{!foo"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 0-5:\nOpen bracket '{!' is never closed."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 0-5:\nOpen bracket '{!' is never closed.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let empty_kind = test "{!:foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":":foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nUnknown reference qualifier ''."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":":foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nUnknown reference qualifier ''."]} |}] let whitespace_kind = test "{! :foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":" :foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-3:\nUnknown reference qualifier ''."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":" :foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-3:\nUnknown reference qualifier ''."]} |}] let with_kind_but_empty = test "{!val:}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val:"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val:"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] let with_kind_but_whitespace = test "{!val: }"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val: "}]}],"warnings":["File \"f.ml\", line 1, characters 6-7:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val: "}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-7:\nIdentifier in reference should not be empty."]} |}] let leading_whitespace_in_kind = test "{! val:foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let internal_whitespace_in_kind = test "{!va l:foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"va l:foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-6:\nUnknown reference qualifier 'va l'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"va l:foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-6:\nUnknown reference qualifier 'va l'."]} |}] let internal_whitespace_in_referent = test "{!val:( * )}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*)","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*)","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let internal_quoted_whitespace_in_referent = test "{!val:\"( * )\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["( * )","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["( * )","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let two_colons = test "{!val:foo:bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val:foo:bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'val:foo'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val:foo:bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'val:foo'."]} |}] let space_before_colon = test "{!val :foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let space_after_colon = test "{!val: foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let unterminated_after_kind = test "{!val:foo"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 0-9:\nOpen bracket '{!' is never closed."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 0-9:\nOpen bracket '{!' is never closed.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let operator = test "{!(>>=)}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(>>=)","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(>>=)","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let operator_with_dash = test "{!(@->)}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(@->)","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(@->)","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let operator_with_dot = test "{!(*.)}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*.)","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(*.)","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let operator_with_colon = test "{!(>::)}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(>::)","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["(>::)","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] end in () @@ -231,127 +230,127 @@ let%expect_test _ = test "{%html:foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let whitespace = test "{%html: foo bar %}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html"," foo bar "]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html"," foo bar "]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let whitespace_only = test "{%html: %}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html"," "]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html"," "]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let empty = test "{%html:%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html",""]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html",""]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let html_payload = test "{%html:foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let colon = test "{%html:foo:bar%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo:bar"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","foo:bar"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let no_target = test "{%foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-7:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] let empty_target = test "{%:foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-8:\n'{%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-8:\n'{%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let whitespace_target = test "{% :foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-9:\n'{% :': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-9:\n'{% :': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let multiline_target = test "{%\n:foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml\", line 1, character 0 to line 2, character 6:\n'{%\n:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, character 0 to line 2, character 6:\n'{%\n:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let percent_in_target = test "{%%:%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 0-6:\n'{%%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-6:\n'{%%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let percent_in_payload = test "{%html:%%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","%"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","%"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let multiple_percent_in_target = test "{%%%foo%%:%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 0-12:\n'{%%%foo%%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-12:\n'{%%%foo%%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let multiple_percent_in_payload = test "{%html:%%foo%%%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","%%foo%%"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","%%foo%%"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let opener_in_target = test "{%{%:foo%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-10:\n'{%{%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-10:\n'{%{%:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let opener_in_payload = test "{%html:{%%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","{%"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","{%"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let right_brace_in_target = test "{%}:%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 0-6:\n'{%}:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-6:\n'{%}:': bad raw markup target.\nSuggestion: try '{%html:...%}'."]} |}] let right_brace_in_payload = test "{%html:}%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html","}"]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html","}"]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let unterminated = test "{%"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nEnd of text is not allowed in '{%...%}' (raw markup).","File \"f.ml\", line 1, characters 0-2:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nEnd of text is not allowed in '{%...%}' (raw markup).","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-2:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] let unterminated_after_target = test "{%html:"; [%expect {| - {"value":[{"`Paragraph":[{"`Raw_markup":["html",""]}]}],"warnings":["File \"f.ml\", line 1, characters 7-7:\nEnd of text is not allowed in '{%...%}' (raw markup)."]} |}] + {"value":[{"`Paragraph":[{"`Raw_markup":["html",""]}]}],"warnings":["File \"f.ml\", line 1, characters 7-7:\nEnd of text is not allowed in '{%...%}' (raw markup).","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let degenerate = test "{%}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nEnd of text is not allowed in '{%...%}' (raw markup).","File \"f.ml\", line 1, characters 0-3:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nEnd of text is not allowed in '{%...%}' (raw markup).","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-3:\n'{%...%}' (raw markup) needs a target language.\nSuggestion: try '{%html:...%}'."]} |}] end in () @@ -361,7 +360,7 @@ let%expect_test _ = test "{0 Foo}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":[]} |}] let titles_no_high_levels = test "{6 Foo}"; @@ -373,37 +372,37 @@ let%expect_test _ = test "{0 Foo}\n{0 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages.","File \"f.ml\", line 2, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{0': heading level should be lower than top heading level '0'."]} |}] let no_heading = test "foo"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let heading_after_paragraph = test "foo\n{0 Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let two_top_level_section_headings = test "{1 Foo}\n{1 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{1': heading level should be lower than top heading level '1'."]} |}] let two_headings_second_higher = test "{1 Foo}\n{0 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{0': heading level should be lower than top heading level '1'."]} |}] let three_headings_last_two_higher = test "{3 Foo}\n{1 Bar}\n{2 Baz}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Subsubsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"baz"]},[{"`Word":"Baz"}]]}],"warnings":[]} |}] + {"value":[{"`Heading":[{"heading_level":"`Subsubsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"baz"]},[{"`Word":"Baz"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{1': heading level should be lower than top heading level '3'.","File \"f.ml\", line 3, characters 0-7:\n'{2': heading level should be lower than top heading level '3'."]} |}] let none = test "{1 Foo}"; @@ -415,25 +414,25 @@ let%expect_test _ = test "{0 Foo}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":[]} |}] let two_titles_none_allowed = test "{0 Foo}\n{0 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages.","File \"f.ml\", line 2, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{0': heading level should be lower than top heading level '0'."]} |}] let two_headings_none_allowed = test "{1 Foo}\n{1 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Section","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{1': heading level should be lower than top heading level '1'."]} |}] let multiple_with_bad_section = test "{0 Foo}\n{0 Foo}\n{6 Foo}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Subparagraph","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages.","File \"f.ml\", line 2, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages.","File \"f.ml\", line 3, characters 0-7:\n'6': bad heading level (0-5 allowed)."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Subparagraph","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{0': heading level should be lower than top heading level '0'.","File \"f.ml\", line 3, characters 0-7:\n'6': bad heading level (0-5 allowed)."]} |}] let promoted_duplicates = test "{6 Foo}\n{6 Bar}"; @@ -569,13 +568,13 @@ let%expect_test _ = test "{2 {2 Foo}}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},""]},[]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Paragraph":[{"`Word":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 3-5:\n'{2 ...}' (section heading) is not allowed in '{2 ...}' (section heading).","File \"f.ml\", line 1, characters 0-2:\n'{2 ...}' (section heading) should not be empty.","File \"f.ml\", line 1, characters 3-5:\n'{2 ...}' (section heading) should begin on its own line.","File \"f.ml\", line 1, characters 10-11:\nUnpaired '}' (end of markup).\nSuggestion: try '\\}'."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},""]},[]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Paragraph":[{"`Word":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 3-5:\n'{2 ...}' (section heading) is not allowed in '{2 ...}' (section heading).","File \"f.ml\", line 1, characters 0-2:\n'{2 ...}' (section heading) should not be empty.","File \"f.ml\", line 1, characters 3-5:\n'{2 ...}' (section heading) should begin on its own line.","File \"f.ml\", line 1, characters 10-11:\nUnpaired '}' (end of markup).\nSuggestion: try '\\}'.","File \"f.ml\", line 1, characters 3-10:\n'{2': heading level should be lower than top heading level '2'."]} |}] let in_list = test "- {2 Foo}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"Foo"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 2-4:\n'{2 ...}' (section heading) is not allowed in '-' (bulleted list item).\nSuggestion: move '{2' outside of any other markup."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"Foo"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 2-4:\n'{2 ...}' (section heading) is not allowed in '-' (bulleted list item).\nSuggestion: move '{2' outside of any other markup.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_junk = test "{2 Foo} bar"; @@ -587,7 +586,7 @@ let%expect_test _ = test "foo {2 Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 1, characters 4-6:\n'{2 ...}' (section heading) should begin on its own line."]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 1, characters 4-6:\n'{2 ...}' (section heading) should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_block = test "{2 Foo}\nbar"; @@ -599,7 +598,7 @@ let%expect_test _ = test "foo\n{2 Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let label = test "{2:foo Bar}"; @@ -635,19 +634,19 @@ let%expect_test _ = test "{ul {2 Foo}}"; [%expect {| - {"value":[{"`List":["`Unordered",[]]},{"`Paragraph":[{"`Word":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 4-6:\n'{2 ...}' (section heading) is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move '{2 ...}' (section heading) outside the list.","File \"f.ml\", line 1, characters 7-10:\n'Foo' is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move 'Foo' into a list item, '{li ...}' or '{- ...}'.","File \"f.ml\", line 1, characters 0-3:\n'{ul ...}' (bulleted list) should not be empty.","File \"f.ml\", line 1, characters 11-12:\nUnpaired '}' (end of markup).\nSuggestion: try '\\}'."]} |}] + {"value":[{"`List":["`Unordered",[]]},{"`Paragraph":[{"`Word":"}"}]}],"warnings":["File \"f.ml\", line 1, characters 4-6:\n'{2 ...}' (section heading) is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move '{2 ...}' (section heading) outside the list.","File \"f.ml\", line 1, characters 7-10:\n'Foo' is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move 'Foo' into a list item, '{li ...}' or '{- ...}'.","File \"f.ml\", line 1, characters 0-3:\n'{ul ...}' (bulleted list) should not be empty.","File \"f.ml\", line 1, characters 11-12:\nUnpaired '}' (end of markup).\nSuggestion: try '\\}'.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let preceded_by_shorthand_list = test "- foo\n{2 Bar}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let nested_in_two_lists = test "{ul {li - foo\n{2 Bar}}}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Paragraph":[{"`Word":"Bar"}]}]]]}],"warnings":["File \"f.ml\", line 2, characters 0-2:\n'{2 ...}' (section heading) is not allowed in '{li ...}' (list item).\nSuggestion: move '{2' outside of any other markup."]} |}] + {"value":[{"`List":["`Unordered",[[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Paragraph":[{"`Word":"Bar"}]}]]]}],"warnings":["File \"f.ml\", line 2, characters 0-2:\n'{2 ...}' (section heading) is not allowed in '{li ...}' (list item).\nSuggestion: move '{2' outside of any other markup.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let bad_level_long_number = test "{22 Foo}"; @@ -677,7 +676,7 @@ let%expect_test _ = test "{0 Foo}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":["File \"f.ml\", line 1, characters 0-7:\nTitle-level headings {0 ...} are only allowed in pages."]} |}] + {"value":[{"`Heading":[{"heading_level":"`Title","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]}],"warnings":[]} |}] let bad_level_too_deep = test "{6 Foo}"; @@ -701,7 +700,7 @@ let%expect_test _ = test "{2 Foo}\n{2 Bar}"; [%expect {| - {"value":[{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"foo"]},[{"`Word":"Foo"}]]},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml\", line 2, characters 0-7:\n'{2': heading level should be lower than top heading level '2'."]} |}] let greater = test "{2 Foo}\n{3 Bar}"; @@ -717,145 +716,145 @@ let%expect_test _ = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let empty = test "@author"; [%expect {| - {"value":[{"`Tag":{"`Author":""}}],"warnings":["File \"f.ml\", line 1, characters 0-7:\n'@author' should not be empty."]} |}] + {"value":[{"`Tag":{"`Author":""}}],"warnings":["File \"f.ml\", line 1, characters 0-7:\n'@author' should not be empty.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let whitespace_only = test "@author"; [%expect {| - {"value":[{"`Tag":{"`Author":""}}],"warnings":["File \"f.ml\", line 1, characters 0-7:\n'@author' should not be empty."]} |}] + {"value":[{"`Tag":{"`Author":""}}],"warnings":["File \"f.ml\", line 1, characters 0-7:\n'@author' should not be empty.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let extra_whitespace = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let newline = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let cr_lf = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let blank_line = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_junk = test "@author Foo\nbar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Paragraph":[{"`Word":"bar"}]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Paragraph":[{"`Word":"bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_code_span = test "@author Foo\n[bar]"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Paragraph":[{"`Code_span":"bar"}]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Paragraph":[{"`Code_span":"bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_code_block = test "@author Foo\n{[bar]}"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Code_block":["None","bar"]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Code_block":["None","bar"]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_verbatim = test "@author Foo\n{v bar v}"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Verbatim":"bar"}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Verbatim":"bar"}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_modules = test "@author foo\n{!modules:Foo}"; [%expect {| - {"value":[{"`Tag":{"`Author":"foo"}},{"`Modules":[[{"`Root":["Foo","`TUnknown"]},"None"]]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"foo"}},{"`Modules":[[{"`Root":["Foo","`TUnknown"]},"None"]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_list = test "@author Foo\n{ul {li bar}}"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"bar"}]}]]]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"bar"}]}]]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_shorthand_list = test "@author Foo\n- bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"bar"}]}]]]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"bar"}]}]]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_section_heading = test "@author Foo\n{2 Bar}"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Heading":[{"heading_level":"`Subsection","heading_label_explicit":"false"},{"`Label":[{"`Page":["None","f.ml"]},"bar"]},[{"`Word":"Bar"}]]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_author = test "@author Foo\n@author Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let followed_by_author_cr_lf = test "@author Foo\n@author Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_author = test "@author Foo @author Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo @author Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo @author Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_author_at_start = test "@author @author Foo"; [%expect {| - {"value":[{"`Tag":{"`Author":"@author Foo"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"@author Foo"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let preceded_by_paragraph = test "foo\n@author Bar"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Tag":{"`Author":"Bar"}}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"}]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let no_markup = test "@author Foo [Bar]"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo [Bar]"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo [Bar]"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_paragraph = test "foo @author Bar"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 4-15:\n'@author' should begin on its own line."]} |}] + {"value":[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 4-15:\n'@author' should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_code = test "[@author Foo]"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"@author Foo"}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"@author Foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_style = test "{b @author Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Styled":["`Bold",[]]}]},{"`Tag":{"`Author":"Foo}"}}],"warnings":["File \"f.ml\", line 1, characters 3-15:\n'@author' is not allowed in '{b ...}' (boldface text).","File \"f.ml\", line 1, characters 0-2:\n'{b ...}' (boldface text) should not be empty.","File \"f.ml\", line 1, characters 3-15:\n'@author' should begin on its own line."]} |}] + {"value":[{"`Paragraph":[{"`Styled":["`Bold",[]]}]},{"`Tag":{"`Author":"Foo}"}}],"warnings":["File \"f.ml\", line 1, characters 3-15:\n'@author' is not allowed in '{b ...}' (boldface text).","File \"f.ml\", line 1, characters 0-2:\n'{b ...}' (boldface text) should not be empty.","File \"f.ml\", line 1, characters 3-15:\n'@author' should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_heading = test "{2 @author Foo}"; @@ -867,67 +866,67 @@ let%expect_test _ = test "- foo\n@author Bar"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Tag":{"`Author":"Bar"}}],"warnings":[]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_shorthand_list = test "- foo @author Bar"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\n'@author' is not allowed in '-' (bulleted list item).\nSuggestion: move '@author' outside of any other markup."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\n'@author' is not allowed in '-' (bulleted list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_shorthand_list_at_start = test "- @author Foo"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Foo"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\n'@author' is not allowed in '-' (bulleted list item).\nSuggestion: move '@author' outside of any other markup."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Foo"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\n'@author' is not allowed in '-' (bulleted list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_list_item = test "{ul {li foo @author Bar}}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar}}"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 12-25:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 1, characters 25-25:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 25-25:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"},"`Space"]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar}}"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 12-25:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 1, characters 25-25:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 25-25:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_list_item_at_start = test "{ul {li @author Foo}}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Foo}}"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 8-21:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 1, characters 21-21:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 21-21:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Foo}}"}]}]]]}],"warnings":["File \"f.ml\", line 1, characters 8-21:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 1, characters 21-21:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 21-21:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_list_item_on_new_line = test "{ul {li foo\n@author Bar}}"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar}}"}]}]]]}],"warnings":["File \"f.ml\", line 2, characters 0-13:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 2, characters 13-13:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 2, characters 13-13:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]},{"`Paragraph":[{"`Word":"@author"},"`Space",{"`Word":" Bar}}"}]}]]]}],"warnings":["File \"f.ml\", line 2, characters 0-13:\n'@author' is not allowed in '{li ...}' (list item).\nSuggestion: move '@author' outside of any other markup.","File \"f.ml\", line 2, characters 13-13:\nEnd of text is not allowed in '{li ...}' (list item).\nSuggestion: add '}'.","File \"f.ml\", line 2, characters 13-13:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_list = test "{ul @author Foo}"; [%expect {| - {"value":[{"`List":["`Unordered",[]]}],"warnings":["File \"f.ml\", line 1, characters 4-16:\n'@author' is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move '@author' outside the list.","File \"f.ml\", line 1, characters 16-16:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 0-3:\n'{ul ...}' (bulleted list) should not be empty."]} |}] + {"value":[{"`List":["`Unordered",[]]}],"warnings":["File \"f.ml\", line 1, characters 4-16:\n'@author' is not allowed in '{ul ...}' (bulleted list).\nSuggestion: move '@author' outside the list.","File \"f.ml\", line 1, characters 16-16:\nEnd of text is not allowed in '{ul ...}' (bulleted list).\nSuggestion: add '}'.","File \"f.ml\", line 1, characters 0-3:\n'{ul ...}' (bulleted list) should not be empty.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_code_block = test "{[@author Foo]}"; [%expect {| - {"value":[{"`Code_block":["None","@author Foo"]}],"warnings":[]} |}] + {"value":[{"`Code_block":["None","@author Foo"]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let in_verbatim = test "{v @author Foo v}"; [%expect {| - {"value":[{"`Verbatim":"@author Foo"}],"warnings":[]} |}] + {"value":[{"`Verbatim":"@author Foo"}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let after_code_block = test "{[foo]} @author Bar"; [%expect {| - {"value":[{"`Code_block":["None","foo"]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 8-19:\n'@author' should begin on its own line."]} |}] + {"value":[{"`Code_block":["None","foo"]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 8-19:\n'@author' should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let after_verbatim = test "{v foo v} @author Bar"; [%expect {| - {"value":[{"`Verbatim":"foo"},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 10-21:\n'@author' should begin on its own line."]} |}] + {"value":[{"`Verbatim":"foo"},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 10-21:\n'@author' should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let after_heading = test "{2 Foo} @author Bar"; @@ -939,31 +938,31 @@ let%expect_test _ = test "{ul {li foo}} @author Bar"; [%expect {| - {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 14-25:\n'@author' should begin on its own line."]} |}] + {"value":[{"`List":["`Unordered",[[{"`Paragraph":[{"`Word":"foo"}]}]]]},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml\", line 1, characters 14-25:\n'@author' should begin on its own line.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let preceded_by_whitespace = test "@author Foo Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let second_preceded_by_whitespace = test "@author Foo\n @author Bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":[]} |}] + {"value":[{"`Tag":{"`Author":"Foo"}},{"`Tag":{"`Author":"Bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let prefix = test "@authorfoo"; [%expect {| - {"value":[{"`Paragraph":[{"`Word":"@authorfoo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-10:\nUnknown tag '@authorfoo'."]} |}] + {"value":[{"`Paragraph":[{"`Word":"@authorfoo"}]}],"warnings":["File \"f.ml\", line 1, characters 0-10:\nUnknown tag '@authorfoo'.","File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let not_allowed = test ~tags_allowed:false "@author Foo bar"; [%expect {| - {"value":[{"`Tag":{"`Author":"Foo bar"}}],"warnings":["File \"f.ml\", line 1, characters 0-15:\nTags are not allowed in pages."]} |}] + {"value":[{"`Tag":{"`Author":"Foo bar"}}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 0-15:\nTags are not allowed in pages."]} |}] end in () @@ -973,1663 +972,1663 @@ let%expect_test _ = test "{!\"foo\".\"bar\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let no_kind = test "{!foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TUnknown"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_ = test "{!class-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClass"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClass"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_type = test "{!class-type-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClassType"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClassType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_type_alt = test "{!classtype-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClassType"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\n'classtype' is deprecated, use 'class-type' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TClassType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\n'classtype' is deprecated, use 'class-type' instead."]} |}] let constructor = test "{!constructor-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TConstructor"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TConstructor"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_alt = test "{!const-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TConstructor"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\n'const' is deprecated, use 'constructor' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TConstructor"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\n'const' is deprecated, use 'constructor' instead."]} |}] let dash_in_page_name = test "{!page-\"foo-bar\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo-bar","`TPage"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo-bar","`TPage"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let dot_and_dash_in_page_name = test "{!page-\"foo-bar.v0.0.1\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo-bar.v0.0.1","`TPage"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo-bar.v0.0.1","`TPage"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let exception_ = test "{!exception-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TException"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TException"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let exception_alt = test "{!exn-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TException"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\n'exn' is deprecated, use 'exception' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TException"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\n'exn' is deprecated, use 'exception' instead."]} |}] let extension = test "{!extension-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TExtension"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TExtension"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field = test "{!field-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TField"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TField"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_alt = test "{!recfield-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TField"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-14:\n'recfield' is deprecated, use 'field' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TField"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-14:\n'recfield' is deprecated, use 'field' instead."]} |}] let heading = test "{!section-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TLabel"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TLabel"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let heading_alt = test "{!label-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TLabel"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\n'label' is deprecated, use 'section' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TLabel"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\n'label' is deprecated, use 'section' instead."]} |}] let instance_variable = test "{!instance-variable-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TInstanceVariable"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TInstanceVariable"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let kind_with_quotes = test "{!module-type-\"Bar\".module-\"Moo\".class-\"There\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Module":[{"`Root":["Bar","`TModuleType"]},"Moo"]},"There"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Module":[{"`Root":["Bar","`TModuleType"]},"Moo"]},"There"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_ = test "{!method-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TMethod"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TMethod"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_ = test "{!module-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModule"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModule"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_type = test "{!module-type-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModuleType"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModuleType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_type_alt = test "{!modtype-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModuleType"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\n'modtype' is deprecated, use 'module-type' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["Foo","`TModuleType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\n'modtype' is deprecated, use 'module-type' instead."]} |}] let page = test "{!page-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TPage"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TPage"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let type_ = test "{!type-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TType"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let val_ = test "{!val-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let val_alt = test "{!value-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\n'value' is deprecated, use 'val' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\n'value' is deprecated, use 'val' instead."]} |}] let longident = test "{!module-Foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let hyphenated_kind_longident = test "{!module-type-Foo.module-type-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`ModuleType":[{"`Root":["Foo","`TModuleType"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`ModuleType":[{"`Root":["Foo","`TModuleType"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let empty = test "{!}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let empty_qualifier = test "{!-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"-foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-6:\nUnknown reference qualifier ''."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"-foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-6:\nUnknown reference qualifier ''."]} |}] let empty_identifier = test "{!val-}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] let invalid_qualifier = test "{!foo-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'foo'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'foo'."]} |}] let empty_first_component = test "{!.foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":".foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":".foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let empty_second_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."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo."}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] let second_component_empty_qualifier = test "{!Foo.-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-10:\nUnknown reference qualifier ''."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-10:\nUnknown reference qualifier ''."]} |}] let second_component_empty_identifier = test "{!Foo.val-}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-"}]}],"warnings":["File \"f.ml\", line 1, characters 10-10:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 10-10:\nIdentifier in reference should not be empty."]} |}] let first_component_empty_identifier = test "{!module-.foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-.foo"}]}],"warnings":["File \"f.ml\", line 1, characters 9-9:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-.foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 9-9:\nIdentifier in reference should not be empty."]} |}] let something_in_invalid = test "{!foo-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'foo'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nUnknown reference qualifier 'foo'."]} |}] let something_in_something = test "{!foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_module = test "{!module-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_module_type = test "{!module-type-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_type = test "{!type-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_class = test "{!class-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_class_type = test "{!class-type-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TClassType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TClassType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_page = test "{!page-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TPage"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Root":["foo","`TPage"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_constructor = test "{!constructor-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_exception = test "{!exception-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_extension = test "{!extension-Foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_field = test "{!field-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_section = test "{!section-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_instance_variable = test "{!instance-variable-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_method = test "{!method-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_val = test "{!val-foo.bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', 'page-', a path, or an unqualified reference."]} |}] let something_in_something_nested = test "{!foo.bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_module_nested = test "{!Foo.module-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_module_type_nested = test "{!Foo.module-type-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_type_nested = test "{!Foo.type-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_class_nested = test "{!Foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_class_type_nested = test "{!foo.class-type-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ClassType":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ClassType":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let something_in_page_nested = test "{!foo.page-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_constructor_nested = test "{!Foo.constructor-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_exception_nested = test "{!Foo.exception-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_extension_nested = test "{!Foo.extension-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_field_nested = test "{!foo.field-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_section_nested = test "{!foo.section-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_instance_variable_nested = test "{!foo.instance-variable-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_method_nested = test "{!foo.method-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let something_in_val_nested = test "{!Foo.val-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let module_in_empty = test "{!.module-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":".module-Foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":".module-Foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let module_in_something = test "{!Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_module = test "{!module-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_module_type = test "{!module-type-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_class = test "{!class-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_class_type = test "{!class-type-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_constructor = test "{!constructor-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_exception = test "{!exception-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_extension = test "{!extension-Foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_field = test "{!field-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_section = test "{!section-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_instance_variable = test "{!instance-variable-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_method = test "{!method-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_page = test "{!page-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_type = test "{!type-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"type-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"type-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_val = test "{!val-foo.module-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.module-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.module-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_something_nested = test "{!Foo.Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Dot":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Dot":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_module_nested = test "{!Foo.module-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_module_type_nested = test "{!Foo.module-type-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Module":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_in_class_nested = test "{!Foo.class-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_class_type_nested = test "{!Foo.class-type-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_constructor_nested = test "{!Foo.constructor-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_exception_nested = test "{!Foo.exception-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_extension_nested = test "{!Foo.extension-Bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_field_nested = test "{!foo.field-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_section_nested = test "{!foo.section-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_instance_variable_nested = test "{!foo.instance-variable-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_method_nested = test "{!foo.method-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_page_nested = test "{!foo.page-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_type_nested = test "{!Foo.type-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_in_val_nested = test "{!Foo.val-bar.module-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.module-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.module-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_type_in_something = test "{!Foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_type_in_module = test "{!module-Foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_type_in_module_type = test "{!module-type-Foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`ModuleType":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let module_type_in_class = test "{!class-foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let module_type_in_page = test "{!page-foo.module-type-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-type-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.module-type-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let type_in_something = test "{!Foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let type_in_module = test "{!module-Foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let type_in_module_type = test "{!module-type-Foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let type_in_class = test "{!class-foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let type_in_page = test "{!page-foo.type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.type-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let constructor_in_empty = test "{!.constructor-Foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":".constructor-Foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":".constructor-Foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let constructor_in_something = test "{!foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_type = test "{!type-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["foo","`TType"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["foo","`TType"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_class = test "{!class-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_class_type = test "{!class-type-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_constructor = test "{!constructor-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_exception = test "{!exception-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_extension = test "{!extension-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_field = test "{!field-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_section = test "{!section-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_instance_variable = test "{!instance-variable-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_method = test "{!method-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_module = test "{!module-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_module_type = test "{!module-type-Foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Root":["Foo","`TModuleType"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_page = test "{!page-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_val = test "{!val-foo.constructor-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.constructor-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.constructor-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_something_nested = test "{!foo.bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_type_nested = test "{!foo.type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Type":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Type":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_class_nested = test "{!Foo.class-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_class_type_nested = test "{!Foo.class-type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_constructor_nested = test "{!Foo.constructor-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_exception_nested = test "{!Foo.exception-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_extension_nested = test "{!Foo.extension-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_field_nested = test "{!foo.field-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_section_nested = test "{!foo.section-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_instance_variable_nested = test "{!foo.instance-variable-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_method_nested = test "{!foo.method-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_module_nested = test "{!Foo.module-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_module_type_nested = test "{!Foo.module-type-Bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let constructor_in_page_nested = test "{!foo.page-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let constructor_in_val_nested = test "{!Foo.val-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_empty = test "{!.field-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":".field-foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":".field-foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let field_in_something = test "{!foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_module = test "{!module-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_module_type = test "{!module-type-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["Foo","`TModuleType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_type = test "{!type-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Root":["foo","`TType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_class = test "{!class-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_class_type = test "{!class-type-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-type-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_constructor = test "{!constructor-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_exception = test "{!exception-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_extension = test "{!extension-Foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_field = test "{!field-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_section = test "{!section-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_instance_variable = test "{!instance-variable-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-23:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_method = test "{!method-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_page = test "{!page-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_val = test "{!val-foo.field-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.field-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.field-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_something_nested = test "{!foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_module_nested = test "{!Foo.module-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Module":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_module_type_nested = test "{!Foo.module-type-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ModuleType":[{"`Root":["Foo","`TUnknown"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_type_nested = test "{!Foo.type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Type":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let field_in_class_nested = test "{!Foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_class_type_nested = test "{!Foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-20:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_constructor_nested = test "{!Foo.constructor-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.constructor-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_exception_nested = test "{!Foo.exception-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_extension_nested = test "{!Foo.extension-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_field_nested = test "{!Foo.field-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.field-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.field-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_section_nested = test "{!foo.section-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-17:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_instance_variable_nested = test "{!foo.instance-variable-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_method_nested = test "{!foo.method-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_page_nested = test "{!foo.page-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let field_in_val_nested = test "{!Foo.val-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-13:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let exception_in_something = test "{!Foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Exception":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Exception":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let exception_in_module = test "{!module-Foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Exception":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Exception":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let exception_in_class = test "{!class-foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.exception-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let exception_in_page = test "{!page-foo.exception-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.exception-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.exception-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let extension_in_something = test "{!Foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Extension":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Extension":[{"`Root":["Foo","`TUnknown"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let extension_in_module = test "{!module-Foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Extension":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Extension":[{"`Root":["Foo","`TModule"]},"Bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let extension_in_class = test "{!class-foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.extension-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let extension_in_page = test "{!page-foo.extension-Bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.extension-Bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.extension-Bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let val_in_something = test "{!Foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Value":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Value":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let val_in_module = test "{!module-Foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Value":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Value":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let val_in_class = test "{!class-foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.val-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let val_in_page = test "{!page-foo.val-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.val-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.val-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_in_something = test "{!Foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_in_module = test "{!module-Foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_in_class = test "{!class-foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_in_page = test "{!page-foo.class-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_type_in_something = test "{!Foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`ClassType":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`ClassType":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_type_in_module = test "{!module-Foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`ClassType":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`ClassType":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let class_type_in_class = test "{!class-foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let class_type_in_page = test "{!page-foo.class-type-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-type-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.class-type-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let method_in_empty = test "{!.method-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":".method-foo"}]}],"warnings":["File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":".method-foo"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-2:\nIdentifier in reference should not be empty."]} |}] let method_in_something = test "{!foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_class = test "{!class-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_class_type = test "{!class-type-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TClassType"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Root":["foo","`TClassType"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_constructor = test "{!constructor-Foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"constructor-Foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_exception = test "{!exception-Foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"exception-Foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_extension = test "{!extension-Foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"extension-Foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_field = test "{!field-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"field-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"field-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_section = test "{!section-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"section-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-13:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"section-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-13:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_instance_variable = test "{!instance-variable-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-23:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"instance-variable-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-23:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_method = test "{!method-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"method-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"method-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_module = test "{!module-Foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_module_type = test "{!module-type-Foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-type-Foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-type-Foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_page = test "{!page-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_type = test "{!type-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"type-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"type-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_val = test "{!val-foo.method-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"val-foo.method-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"val-foo.method-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_something_nested = test "{!foo.bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_class_nested = test "{!Foo.class-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Class":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_class_type_nested = test "{!Foo.class-type-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`ClassType":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`ClassType":[{"`Root":["Foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let method_in_constructor_nested = test "{!foo.constructor-Bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.constructor-Bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.constructor-Bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_exception_nested = test "{!Foo.exception-Bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.exception-Bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_extension_nested = test "{!Foo.extension-Bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-19:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.extension-Bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-19:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_field_nested = test "{!foo.field-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.field-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-15:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_section_nested = test "{!foo.section-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.section-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-17:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_instance_variable_nested = test "{!foo.instance-variable-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-27:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.instance-variable-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-27:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_method_nested = test "{!foo.method-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.method-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_module_nested = test "{!Foo.module-Bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-Bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-16:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-Bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-16:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_module_type_nested = test "{!Foo.module-type-Bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-type-Bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-21:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.module-type-Bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-21:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_page_nested = test "{!foo.page-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_type_nested = test "{!Foo.type-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.type-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let method_in_val_nested = test "{!Foo.val-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-13:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"Foo.val-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-13:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let instance_variable_in_something = test "{!Foo.instance-variable-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`InstanceVariable":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`InstanceVariable":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let instance_variable_in_module = test "{!module-Foo.instance-variable-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.instance-variable-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.instance-variable-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-12:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let instance_variable_in_class = test "{!class-foo.instance-variable-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`InstanceVariable":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`InstanceVariable":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let instance_variable_in_page = test "{!page-foo.instance-variable-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.instance-variable-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.instance-variable-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'class-', 'class-type-', or an unqualified reference."]} |}] let section_in_something = test "{!Foo.section-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["Foo","`TUnknown"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let section_in_module = test "{!module-Foo.section-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["Foo","`TModule"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let section_in_class = test "{!class-foo.section-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["foo","`TClass"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let section_in_page = test "{!page-foo.section-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["foo","`TPage"]},"bar"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Root":["foo","`TPage"]},"bar"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let page_in_something = test "{!foo.page-bar}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in on the right side of a dot.\nSuggestion: Reference pages as '/bar'."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in on the right side of a dot.\nSuggestion: Reference pages as '/bar'."]} |}] let inner_parent_something_in_something = test "{!foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_parent_something_in_module = test "{!module-Foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Dot":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_parent_something_in_class = test "{!class-foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_something_in_page = test "{!page-foo.bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_module_in_module = test "{!module-Foo.module-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_parent_module_in_class = test "{!class-foo.module-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_module_type_in_module = test "{!module-Foo.module-type-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_parent_module_type_in_class = test "{!class-foo.module-type-Bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_type_in_module = test "{!module-Foo.type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Field":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_parent_type_in_class = test "{!class-foo.type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_parent_class_in_module = test "{!module-Foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 13-22:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 13-22:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_in_class = test "{!class-foo.class-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 12-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 12-21:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_type_in_module = test "{!module-Foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 13-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"module-Foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 13-27:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_parent_class_type_in_class = test "{!class-foo.class-type-bar.field-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 12-26:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.field-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 12-26:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_label_parent_something_in_something = test "{!foo.bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_something_in_page = test "{!page-foo.bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TPage"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TPage"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_module_in_module = test "{!module-Foo.module-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_module_in_class = test "{!class-foo.module-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_module_type_in_module = test "{!module-Foo.module-type-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_module_type_in_class = test "{!class-foo.module-type-Bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_type_in_module = test "{!module-Foo.type-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_type_in_class = test "{!class-foo.type-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_class_in_module = test "{!module-Foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_class_in_class = test "{!class-foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_label_parent_class_type_in_module = test "{!module-Foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_label_parent_class_type_in_class = test "{!class-foo.class-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_page_in_something = test "{!foo.page-bar.baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar.baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nExpected 'module-', 'module-type-', 'type-', 'class-', 'class-type-', a path, or an unqualified reference."]} |}] let inner_class_signature_something_in_something = test "{!foo.bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_class_signature_something_in_page = test "{!page-foo.bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_class_signature_class_in_module = test "{!module-Foo.class-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`Class":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_class_signature_class_in_class = test "{!class-foo.class-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_class_signature_class_type_in_module = test "{!module-Foo.class-type-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`ClassType":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Method":[{"`ClassType":[{"`Root":["Foo","`TModule"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_class_signature_class_type_in_class = test "{!class-foo.class-type-bar.method-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.method-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.class-type-bar.method-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_signature_something_in_something = test "{!foo.bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_signature_something_in_page = test "{!page-foo.bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.type-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_signature_module_in_module = test "{!module-Foo.module-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`Module":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_signature_module_in_class = test "{!class-foo.module-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-Bar.type-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_signature_module_type_in_module = test "{!module-Foo.module-type-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Type":[{"`ModuleType":[{"`Root":["Foo","`TModule"]},"Bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_signature_module_type_in_class = test "{!class-foo.module-type-Bar.type-baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.type-baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.module-type-Bar.type-baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let inner_datatype_something_in_something = test "{!foo.bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_datatype_something_in_page = test "{!page-foo.bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"page-foo.bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-10:\nExpected 'module-', 'module-type-', 'type-', or an unqualified reference."]} |}] let inner_datatype_type_in_module = test "{!module-Foo.type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"Baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Constructor":[{"`Type":[{"`Root":["Foo","`TModule"]},"bar"]},"Baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let inner_datatype_type_in_class = test "{!class-foo.type-bar.constructor-Baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"class-foo.type-bar.constructor-Baz"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-11:\nExpected 'module-', 'module-type-', a path, or an unqualified reference."]} |}] let kind_conflict = test "{!val:type-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TType"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-15:\nOld-style reference kind ('val:') does not match new ('type-')."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TType"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-15:\nOld-style reference kind ('val:') does not match new ('type-')."]} |}] let kind_agreement = test "{!val:val-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let kind_agreement_alt = test "{!value:val-foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml\", line 1, characters 2-7:\n'value' is deprecated, use 'val' instead."]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Root":["foo","`TValue"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-7:\n'value' is deprecated, use 'val' instead."]} |}] let canonical_something = test "@canonical Foo"; @@ -2677,19 +2676,19 @@ let%expect_test _ = test "{!foo. bar .baz}"; [%expect {| - {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":[]} |}] + {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Dot":[{"`Root":["foo","`TUnknown"]},"bar"]},"baz"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let replacement_text_empty_identifier = test "{{!val-} foo}"; [%expect {| - {"value":[{"`Paragraph":[{"`Styled":["`Emphasis",[{"`Word":"foo"}]]}]}],"warnings":["File \"f.ml\", line 1, characters 7-7:\nIdentifier in reference should not be empty."]} |}] + {"value":[{"`Paragraph":[{"`Styled":["`Emphasis",[{"`Word":"foo"}]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 7-7:\nIdentifier in reference should not be empty."]} |}] let reference_with_unmatched_quotation = test "{!\"\"foo\"}"; [%expect {| - {"value":[{"`Paragraph":[{"`Code_span":"\"\"foo\""}]}],"warnings":["File \"f.ml\", line 1, characters 2-9:\nUnmatched quotation!"]} |}] + {"value":[{"`Paragraph":[{"`Code_span":"\"\"foo\""}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 2-9:\nUnmatched quotation!"]} |}] end in () @@ -2700,216 +2699,216 @@ let%expect_test _ = let abs = test "{!/foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let abs_label_parent_page = test "{!/foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let abs_label_parent_module = test "{!/foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] (* References to current package root *) let root_to_page = test "{!//foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let root_to_module = test "{!//foo/Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let root_label_parent_page = test "{!//foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let root_label_parent_module = test "{!//foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] (* Relative paths *) let relative = test "{!foo/bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative = test "{!foo/bar/baz}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar","baz"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","bar","baz"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_module = test "{!foo/Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_label_parent_page = test "{!foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_label_parent_module = test "{!foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let dot_relative = test "{!./bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let dot_relative_module = test "{!./Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Any_path":["`TRelativePath",["Bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let dot_relative_label_parent_page = test "{!./bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let dot_relative_label_parent_module = test "{!./Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Dot":[{"`Any_path":["`TRelativePath",["Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] (* Prefix *) let abs_label_parent_page_prefix = test "{!/foo/bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let abs_label_parent_module_prefix = test "{!/foo/Bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let root_label_parent_page_prefix = test "{!//foo/bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let root_label_parent_module_prefix = test "{!//foo/Bar.section-label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_tag_after_slash = test "{!foo/page-bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Page_path":["`TRelativePath",["foo","bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_tag_after_slash = test "{!foo/module-Bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Module_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Module_path":["`TRelativePath",["foo","Bar"]]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let relative_tag_after_slash_label_parent = test "{!page_path/page-pagename.section-sectionname}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TRelativePath",["page_path","pagename"]]},"sectionname"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Page_path":["`TRelativePath",["page_path","pagename"]]},"sectionname"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] (* Errors *) let err_abs_only = test "{!/}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml\", line 1, characters 3-3:\nIdentifier in reference should not be empty."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 3-3:\nIdentifier in reference should not be empty."]} |}] let err_relative_only = test "{!foo/}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] let err_root_only = test "{!//}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] let err_relative_empty = test "{!foo/}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-6:\nIdentifier in reference should not be empty."]} |}] let err_dot_relative_empty = test "{!./}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"./"}]}],"warnings":["File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"./"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] let err_page_prefix_after_dot = test "{!foo.page-bar}"; [%expect - {| {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in on the right side of a dot.\nSuggestion: Reference pages as '/bar'."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo.page-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 6-14:\nPage label is not allowed in on the right side of a dot.\nSuggestion: Reference pages as '/bar'."]} |}] let err_unsupported_kind = test "{!foo/type-bar}"; [%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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/type-bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo//bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"///bar"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"foo/"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"/"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","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."]} |}] + {| {"value":[{"`Paragraph":[{"`Code_span":"//"}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading.","File \"f.ml\", line 1, characters 4-4:\nIdentifier in reference should not be empty."]} |}] (* Old kind compatibility *) let oldkind_abs_page = test "{!section:/foo.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["foo"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let oldkind_abs_module = test "{!section:/Foo.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["Foo"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TAbsolutePath",["Foo"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let oldkind_relative_page = test "{!section:foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let oldkind_relative_module = test "{!section:foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TRelativePath",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let oldkind_root_page = test "{!section://foo/bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] let oldkind_root_module = test "{!section://foo/Bar.label}"; [%expect - {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":[]} |}] + {| {"value":[{"`Paragraph":[{"`Reference":[{"`Label":[{"`Any_path":["`TCurrentPackage",["foo","Bar"]]},"label"]},[]]}]}],"warnings":["File \"f.ml.mld\":\nPages (.mld files) should start with a heading."]} |}] end in () From 5a5bef388185a5419023491b932a47567a80bc5e Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 14 Nov 2024 17:29:18 +0100 Subject: [PATCH 2/4] Remove status where it is not needed --- src/model/semantics.ml | 64 ++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 37 deletions(-) diff --git a/src/model/semantics.ml b/src/model/semantics.ml index beec1f3093..5a03a34e61 100644 --- a/src/model/semantics.ml +++ b/src/model/semantics.ml @@ -191,17 +191,16 @@ type surrounding = * Odoc_parser.Ast.inline_element Location_.with_location list ] let rec non_link_inline_element : - status -> surrounding:surrounding -> Odoc_parser.Ast.inline_element with_location -> Comment.non_link_inline_element with_location = - fun status ~surrounding element -> + fun ~surrounding element -> match element with | { value = #ast_leaf_inline_element; _ } as element -> (leaf_inline_element element :> Comment.non_link_inline_element with_location) | { value = `Styled (style, content); _ } -> - `Styled (style, non_link_inline_elements status ~surrounding content) + `Styled (style, non_link_inline_elements ~surrounding content) |> Location.same element | ( { value = `Reference (_, _, content); _ } | { value = `Link (_, content); _ } ) as element -> @@ -211,29 +210,26 @@ let rec non_link_inline_element : element.location |> Error.raise_warning; - `Styled (`Emphasis, non_link_inline_elements status ~surrounding content) + `Styled (`Emphasis, non_link_inline_elements ~surrounding content) |> Location.same element -and non_link_inline_elements status ~surrounding elements = - List.map (non_link_inline_element status ~surrounding) elements +and non_link_inline_elements ~surrounding elements = + List.map (non_link_inline_element ~surrounding) elements let rec inline_element : - status -> Odoc_parser.Ast.inline_element with_location -> Comment.inline_element with_location = - fun status element -> + fun element -> match element with | { value = #ast_leaf_inline_element; _ } as element -> (leaf_inline_element element :> Comment.inline_element with_location) | { value = `Styled (style, content); location } -> - `Styled (style, inline_elements status content) |> Location.at location + `Styled (style, inline_elements content) |> Location.at location | { value = `Reference (kind, target, content) as value; location } -> ( let { Location.value = target; location = target_location } = target in match Error.raise_warnings (Reference.parse target_location target) with | Result.Ok target -> - let content = - non_link_inline_elements status ~surrounding:value content - in + let content = non_link_inline_elements ~surrounding:value content in Location.at location (`Reference (target, content)) | Result.Error error -> Error.raise_warning error; @@ -242,21 +238,20 @@ let rec inline_element : | `Simple -> `Code_span target | `With_text -> `Styled (`Emphasis, content) in - inline_element status (Location.at location placeholder)) + inline_element (Location.at location placeholder)) | { value = `Link (target, content) as value; location } -> - `Link (target, non_link_inline_elements status ~surrounding:value content) + `Link (target, non_link_inline_elements ~surrounding:value content) |> Location.at location -and inline_elements status elements = List.map (inline_element status) elements +and inline_elements elements = List.map inline_element elements let rec nestable_block_element : - status -> Odoc_parser.Ast.nestable_block_element with_location -> Comment.nestable_block_element with_location = - fun status element -> + fun element -> match element with | { value = `Paragraph content; location } -> - Location.at location (`Paragraph (inline_elements status content)) + Location.at location (`Paragraph (inline_elements content)) | { value = `Code_block { meta; delimiter = _; content; output }; location } -> let lang_tag = @@ -267,7 +262,7 @@ let rec nestable_block_element : let outputs = match output with | None -> None - | Some l -> Some (List.map (nestable_block_element status) l) + | Some l -> Some (List.map nestable_block_element l) in Location.at location (`Code_block (lang_tag, content, outputs)) | { value = `Math_block s; location } -> Location.at location (`Math_block s) @@ -289,13 +284,13 @@ let rec nestable_block_element : in Location.at location (`Modules modules) | { value = `List (kind, _syntax, items); location } -> - `List (kind, List.map (nestable_block_elements status) items) + `List (kind, List.map nestable_block_elements items) |> Location.at location | { value = `Table ((grid, align), (`Heavy | `Light)); location } -> let data = List.map (List.map (fun (cell, cell_type) -> - (nestable_block_elements status cell, cell_type))) + (nestable_block_elements cell, cell_type))) grid in `Table { Comment.data; align } |> Location.at location @@ -315,8 +310,7 @@ let rec nestable_block_element : | `With_text -> `Styled (`Emphasis, [ `Word content |> Location.at location ]) in - `Paragraph - (inline_elements status [ placeholder |> Location.at location ]) + `Paragraph (inline_elements [ placeholder |> Location.at location ]) |> Location.at location in match Error.raise_warnings (Reference.parse_asset href_location href) with @@ -324,8 +318,7 @@ let rec nestable_block_element : `Media (`Reference target, m, content) |> Location.at location | Result.Error error -> fallback error) -and nestable_block_elements status elements = - List.map (nestable_block_element status) elements +and nestable_block_elements elements = List.map nestable_block_element elements let tag : location:Location.span -> @@ -342,26 +335,23 @@ let tag : let ok t = Result.Ok (Location.at location (`Tag t)) in match tag with | (`Author _ | `Since _ | `Version _) as tag -> ok tag - | `Deprecated content -> - ok (`Deprecated (nestable_block_elements status content)) + | `Deprecated content -> ok (`Deprecated (nestable_block_elements content)) | `Param (name, content) -> - ok (`Param (name, nestable_block_elements status content)) + ok (`Param (name, nestable_block_elements content)) | `Raise (name, content) -> ( match Error.raise_warnings (Reference.parse location name) with (* TODO: location for just name *) | Result.Ok target -> - ok - (`Raise - (`Reference (target, []), nestable_block_elements status content)) + ok (`Raise (`Reference (target, []), nestable_block_elements content)) | Result.Error error -> Error.raise_warning error; let placeholder = `Code_span name in - ok (`Raise (placeholder, nestable_block_elements status content))) - | `Return content -> ok (`Return (nestable_block_elements status content)) + ok (`Raise (placeholder, nestable_block_elements content))) + | `Return content -> ok (`Return (nestable_block_elements content)) | `See (kind, target, content) -> - ok (`See (kind, target, nestable_block_elements status content)) + ok (`See (kind, target, nestable_block_elements content)) | `Before (version, content) -> - ok (`Before (version, nestable_block_elements status content)) + ok (`Before (version, nestable_block_elements content)) (* When the user does not give a section heading a label (anchor), we generate one from the text in the heading. This is the common case. This involves @@ -426,7 +416,7 @@ let section_heading : fun status ~top_heading_level location heading -> let (`Heading (level, label, content)) = heading in - let text = inline_elements status content in + let text = inline_elements content in let heading_label_explicit, label = match label with @@ -494,7 +484,7 @@ let top_level_block_elements status ast_elements = match ast_element with | { value = #Odoc_parser.Ast.nestable_block_element; _ } as element -> - let element = nestable_block_element status element in + let element = nestable_block_element element in let element = (element :> Comment.block_element with_location) in traverse ~top_heading_level (element :: comment_elements_acc) From 0c7080007b87343fda874ee1efd2f6986723425e Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 14 Nov 2024 18:11:26 +0100 Subject: [PATCH 3/4] Frontmatter: add support for `@short_title` --- src/model/frontmatter.ml | 52 +++++++-- src/model/frontmatter.mli | 14 ++- src/model/semantics.ml | 110 ++++++++++-------- src/model/semantics.mli | 5 + src/model_desc/comment_desc.ml | 8 ++ src/model_desc/comment_desc.mli | 9 +- src/model_desc/lang_desc.ml | 6 + src/odoc/compile.ml | 2 +- src/parser/ast.ml | 4 +- src/parser/lexer.mll | 3 + src/parser/syntax.ml | 4 +- src/parser/test/test.ml | 4 + src/parser/token.ml | 3 + .../frontmatter.t/one_frontmatter.mld | 1 + test/frontmatter/frontmatter.t/run.t | 13 ++- test/frontmatter/short_title.t/run.t | 65 +++++++++++ test/frontmatter/toc_order.t/run.t | 3 +- 17 files changed, 239 insertions(+), 67 deletions(-) create mode 100644 test/frontmatter/short_title.t/run.t diff --git a/src/model/frontmatter.ml b/src/model/frontmatter.ml index 79542be3e9..00c4e9497c 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -1,21 +1,41 @@ type child = Page of string | Dir of string -type line = Children_order of child Location_.with_location list +type short_title = Comment.link_content + +type line = + | Children_order of child Location_.with_location list + | Short_title of short_title type children_order = child Location_.with_location list Location_.with_location -type t = { children_order : children_order option } +type t = { + children_order : children_order option; + short_title : short_title option; +} + +let empty = { children_order = None; short_title = None } -let empty = { children_order = None } +let update ~tag_name ~loc v new_v = + match v with + | None -> Some new_v + | Some _ -> + Error.raise_warning (Error.make "Duplicated @%s entry" tag_name loc); + v let apply fm line = - match (line.Location_.value, fm) with - | Children_order children_order, { children_order = None } -> - { children_order = Some (Location_.same line children_order) } - | Children_order _, { children_order = Some _ } -> - Error.raise_warning - (Error.make "Duplicated @children_order entry" line.location); - fm + match line.Location_.value with + | Short_title t -> + let short_title = + update ~tag_name:"short_title" ~loc:line.location fm.short_title t + in + { fm with short_title } + | Children_order children_order -> + let children_order = Location_.same line children_order in + let children_order = + update ~tag_name:"children_order" ~loc:line.location fm.children_order + children_order + in + { fm with children_order } let parse_child c = if Astring.String.is_suffix ~affix:"/" c then @@ -29,7 +49,7 @@ let parse_children_order loc co = | [] -> Result.Ok (Location_.at loc (Children_order (List.rev acc))) | ({ Location_.value = `Word word; _ } as w) :: tl -> parse_words ({ w with value = parse_child word } :: acc) tl - | { Location_.value = `Space _; _ } :: tl -> parse_words acc tl + | { Location_.value = `Space; _ } :: tl -> parse_words acc tl | { location; _ } :: _ -> Error (Error.make "Only words are accepted when specifying children order" @@ -41,5 +61,15 @@ let parse_children_order loc co = Error (Error.make "Only words are accepted when specifying children order" loc) +let parse_short_title loc t = + match t with + | [ { Location_.value = `Paragraph words; _ } ] -> + let short_title = Comment.link_content_of_inline_elements words in + Result.Ok (Location_.at loc (Short_title short_title)) + | _ -> + Error + (Error.make + "Short titles cannot contain other block than a single paragraph" loc) + let of_lines lines = Error.catch_warnings @@ fun () -> List.fold_left apply empty lines diff --git a/src/model/frontmatter.mli b/src/model/frontmatter.mli index 61f2e5d704..8cf0f715c0 100644 --- a/src/model/frontmatter.mli +++ b/src/model/frontmatter.mli @@ -1,16 +1,26 @@ type child = Page of string | Dir of string +type short_title = Comment.link_content + type line type children_order = child Location_.with_location list Location_.with_location -type t = { children_order : children_order option } +type t = { + children_order : children_order option; + short_title : short_title option; +} val empty : t val parse_children_order : Location_.span -> - Odoc_parser.Ast.nestable_block_element Location_.with_location list -> + Comment.nestable_block_element Location_.with_location list -> + (line Location_.with_location, Error.t) Result.result + +val parse_short_title : + Location_.span -> + Comment.nestable_block_element Location_.with_location list -> (line Location_.with_location, Error.t) Result.result val of_lines : line Location_.with_location list -> t Error.with_warnings diff --git a/src/model/semantics.ml b/src/model/semantics.ml index 5a03a34e61..dec78e65ee 100644 --- a/src/model/semantics.ml +++ b/src/model/semantics.ml @@ -25,6 +25,7 @@ let describe_internal_tag = function | `Closed -> "@closed" | `Hidden -> "@hidden" | `Children_order _ -> "@children_order" + | `Short_title _ -> "@short_title" let warn_unexpected_tag { Location.value; location } = Error.raise_warning @@ -54,48 +55,6 @@ let rec find_tags acc ~filter = function warn_unexpected_tag hd; find_tags acc ~filter tl) -let handle_internal_tags (type a) tags : a handle_internal_tags -> a = function - | Expect_status -> ( - match - find_tag - ~filter:(function - | (`Inline | `Open | `Closed) as t -> Some t | _ -> None) - tags - with - | Some (status, _) -> status - | None -> `Default) - | Expect_canonical -> ( - match - find_tag ~filter:(function `Canonical p -> Some p | _ -> None) tags - with - | Some (`Root _, location) -> - warn_root_canonical location; - None - | Some ((`Dot _ as p), _) -> Some p - | None -> None) - | Expect_page_tags -> - let unparsed_lines = - find_tags [] - ~filter:(function `Children_order _ as p -> Some p | _ -> None) - tags - in - let lines = - List.filter_map - (function - | `Children_order co, loc -> ( - match Frontmatter.parse_children_order loc co with - | Ok co -> Some co - | Error e -> - Error.raise_warning e; - None)) - unparsed_lines - in - Frontmatter.of_lines lines |> Error.raise_warnings - | Expect_none -> - (* Will raise warnings. *) - ignore (find_tag ~filter:(fun _ -> None) tags); - () - (* Errors *) let invalid_raw_markup_target : string -> Location.span -> Error.t = Error.make ~suggestion:"try '{%html:...%}'." @@ -138,6 +97,7 @@ let describe_element = function | `Link (_, _) -> "'{{:...} ...}' (external link)" | `Heading (level, _, _) -> Printf.sprintf "'{%i ...}' (section heading)" level + | `Specific s -> s (* End of errors *) @@ -188,7 +148,8 @@ type surrounding = | `Reference of [ `Simple | `With_text ] * string Location_.with_location - * Odoc_parser.Ast.inline_element Location_.with_location list ] + * Odoc_parser.Ast.inline_element Location_.with_location list + | `Specific of string ] let rec non_link_inline_element : surrounding:surrounding -> @@ -524,12 +485,13 @@ let strip_internal_tags ast : internal_tags_removed with_location list * _ = in match tag with | (`Inline | `Open | `Closed | `Hidden) as tag -> next tag - | `Children_order co -> + | (`Children_order _ | `Short_title _) as tag -> + let tag_name = describe_internal_tag tag in if not start then Error.raise_warning - (Error.make "@children_order tag has to be before any content" + (Error.make "%s tag has to be before any content" tag_name wloc.location); - next (`Children_order co) + next tag | `Canonical { Location.value = s; location = r_location } -> ( match Error.raise_warnings (Reference.read_path_longident r_location s) @@ -568,6 +530,54 @@ let append_alerts_to_comment alerts in comment @ (alerts : alerts :> Comment.docs) +let handle_internal_tags (type a) tags : a handle_internal_tags -> a = function + | Expect_status -> ( + match + find_tag + ~filter:(function + | (`Inline | `Open | `Closed) as t -> Some t | _ -> None) + tags + with + | Some (status, _) -> status + | None -> `Default) + | Expect_canonical -> ( + match + find_tag ~filter:(function `Canonical p -> Some p | _ -> None) tags + with + | Some (`Root _, location) -> + warn_root_canonical location; + None + | Some ((`Dot _ as p), _) -> Some p + | None -> None) + | Expect_page_tags -> + let unparsed_lines = + find_tags [] + ~filter:(function + | (`Children_order _ | `Short_title _) as p -> Some p | _ -> None) + tags + in + let lines = + let do_ parse loc els = + let els = nestable_block_elements els in + match parse loc els with + | Ok res -> Some res + | Error e -> + Error.raise_warning e; + None + in + List.filter_map + (function + | `Children_order co, loc -> + do_ Frontmatter.parse_children_order loc co + | `Short_title t, loc -> do_ Frontmatter.parse_short_title loc t) + unparsed_lines + in + Frontmatter.of_lines lines |> Error.raise_warnings + | Expect_none -> + (* Will raise warnings. *) + ignore (find_tag ~filter:(fun _ -> None) tags); + () + let ast_to_comment ~internal_tags ~tags_allowed ~parent_of_sections (ast : Ast.t) alerts = Error.catch_warnings (fun () -> @@ -598,3 +608,11 @@ let parse_reference text = } in Reference.parse location text + +let non_link_inline_element : + context:string -> + Odoc_parser.Ast.inline_element with_location list -> + Comment.non_link_inline_element with_location list = + fun ~context elements -> + let surrounding = `Specific context in + non_link_inline_elements ~surrounding elements diff --git a/src/model/semantics.mli b/src/model/semantics.mli index 48105dbe20..fea10ac04f 100644 --- a/src/model/semantics.mli +++ b/src/model/semantics.mli @@ -19,6 +19,11 @@ val ast_to_comment : alerts -> (Comment.docs * 'tags) Error.with_warnings +val non_link_inline_element : + context:string -> + Odoc_parser.Ast.inline_element Location_.with_location list -> + Comment.non_link_inline_element Location_.with_location list + val parse_comment : internal_tags:'tags handle_internal_tags -> tags_allowed:bool -> diff --git a/src/model_desc/comment_desc.ml b/src/model_desc/comment_desc.ml index eaade4d676..4964b8c79f 100644 --- a/src/model_desc/comment_desc.ml +++ b/src/model_desc/comment_desc.ml @@ -187,3 +187,11 @@ let docs = Indirect ((fun n -> ((n :> docs) :> general_docs)), docs) let docs_or_stop : docs_or_stop t = Variant (function `Docs x -> C ("`Docs", x, docs) | `Stop -> C0 "`Stop") + +let inline_element : inline_element Location_.with_location list Type_desc.t = + List + (Indirect + ( (fun x -> + let x :> general_inline_element Location_.with_location = x in + ignore_loc x), + inline_element )) diff --git a/src/model_desc/comment_desc.mli b/src/model_desc/comment_desc.mli index 91e438e35c..707b5bf49c 100644 --- a/src/model_desc/comment_desc.mli +++ b/src/model_desc/comment_desc.mli @@ -1,3 +1,8 @@ -val docs : Odoc_model.Comment.docs Type_desc.t +open Odoc_model +open Odoc_model.Comment -val docs_or_stop : Odoc_model.Comment.docs_or_stop Type_desc.t +val docs : docs Type_desc.t + +val inline_element : inline_element Location_.with_location list Type_desc.t + +val docs_or_stop : docs_or_stop Type_desc.t diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index 02f8ef1d86..eb32d6a9c0 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -712,6 +712,12 @@ and frontmatter = ( "children", (fun t -> Option.map ignore_loc t.children_order), Option (List child) ); + F + ( "short_title", + (fun t -> + (t.short_title + :> Comment.inline_element Location_.with_location list option)), + Option Comment_desc.inline_element ); ] and child = diff --git a/src/odoc/compile.ml b/src/odoc/compile.ml index cf30247825..ee61392078 100644 --- a/src/odoc/compile.ml +++ b/src/odoc/compile.ml @@ -207,7 +207,7 @@ let is_index_page = function | { iv = `LeafPage (_, p); _ } -> String.equal (Names.PageName.to_string p) "index" -let has_children_order { Frontmatter.children_order } = +let has_children_order { Frontmatter.children_order; _ } = Option.is_some children_order let mld ~parent_id ~parents_children ~output ~children ~warnings_options input = diff --git a/src/parser/ast.ml b/src/parser/ast.ml index c8533dca91..29f7eba660 100644 --- a/src/parser/ast.ml +++ b/src/parser/ast.ml @@ -77,7 +77,9 @@ type internal_tag = | `Open | `Closed | `Hidden - | `Children_order of nestable_block_element with_location list ] + | `Children_order of nestable_block_element with_location list + | `Short_title of nestable_block_element with_location list ] + (** Internal tags are used to exercise fine control over the output of odoc. They are never rendered in the output *) diff --git a/src/parser/lexer.mll b/src/parser/lexer.mll index 5a71b48836..1a795edd6d 100644 --- a/src/parser/lexer.mll +++ b/src/parser/lexer.mll @@ -543,6 +543,9 @@ and token input = parse | ("@children_order") { emit input (`Tag `Children_order) } + | ("@short_title") + { emit input (`Tag `Short_title) } + | "@see" horizontal_space* '<' ([^ '>']* as url) '>' { emit input (`Tag (`See (`Url, url))) } diff --git a/src/parser/syntax.ml b/src/parser/syntax.ml index 5d4445543a..086610c530 100644 --- a/src/parser/syntax.ml +++ b/src/parser/syntax.ml @@ -618,6 +618,7 @@ let tag_to_words = function | `Since s -> [ `Word "@since"; `Space " "; `Word s ] | `Version s -> [ `Word "@version"; `Space " "; `Word s ] | `Children_order -> [ `Word "@children_order" ] + | `Short_title -> [ `Word "@short_title" ] (* {3 Block element lists} *) @@ -818,7 +819,7 @@ let rec block_element_list : let tag = Loc.at location (`Tag tag) in consume_block_elements `After_text (tag :: acc) - | (`Deprecated | `Return | `Children_order) as tag -> + | (`Deprecated | `Return | `Children_order | `Short_title) as tag -> let content, _stream_head, where_in_line = block_element_list (In_implicitly_ended `Tag) ~parent_markup:token input @@ -828,6 +829,7 @@ let rec block_element_list : | `Deprecated -> `Deprecated content | `Return -> `Return content | `Children_order -> `Children_order content + | `Short_title -> `Short_title content in let location = location :: List.map Loc.location content |> Loc.span diff --git a/src/parser/test/test.ml b/src/parser/test/test.ml index 5f24c13240..866bfc1a1d 100644 --- a/src/parser/test/test.ml +++ b/src/parser/test/test.ml @@ -147,6 +147,10 @@ module Ast_to_sexp = struct List (Atom "@children_order" :: List.map (at.at (nestable_block_element at)) es) + | `Short_title es -> + List + (Atom "@short_title" + :: List.map (at.at (nestable_block_element at)) es) | `See (kind, s, es) -> let kind = match kind with diff --git a/src/parser/token.ml b/src/parser/token.ml index 6d298b8e4b..8b9330f3f3 100644 --- a/src/parser/token.ml +++ b/src/parser/token.ml @@ -19,6 +19,7 @@ type tag = | `Version of string | `Canonical of string | `Children_order + | `Short_title | `Inline | `Open | `Closed @@ -132,6 +133,7 @@ let print : [< t ] -> string = function | `Tag (`Raise _) -> "'@raise'" | `Tag `Return -> "'@return'" | `Tag `Children_order -> "'@children_order'" + | `Tag `Short_title -> "'@short_title'" | `Tag (`See _) -> "'@see'" | `Tag (`Since _) -> "'@since'" | `Tag (`Before _) -> "'@before'" @@ -237,6 +239,7 @@ let describe : [< t | `Comment ] -> string = function | `Tag `Closed -> "'@closed'" | `Tag `Hidden -> "'@hidden" | `Tag `Children_order -> "'@children_order" + | `Tag `Short_title -> "'@short_title" | `Comment -> "top-level text" let describe_element = function diff --git a/test/frontmatter/frontmatter.t/one_frontmatter.mld b/test/frontmatter/frontmatter.t/one_frontmatter.mld index fa90306d98..5c69bf0d88 100644 --- a/test/frontmatter/frontmatter.t/one_frontmatter.mld +++ b/test/frontmatter/frontmatter.t/one_frontmatter.mld @@ -1,3 +1,4 @@ @children_order page1 page2 +@short_title yes! {0 One frontmatter} diff --git a/test/frontmatter/frontmatter.t/run.t b/test/frontmatter/frontmatter.t/run.t index 4bdb9baac7..00c752e4d1 100644 --- a/test/frontmatter/frontmatter.t/run.t +++ b/test/frontmatter/frontmatter.t/run.t @@ -3,7 +3,8 @@ When there is no frontmatter, everything is normal $ odoc compile zero_frontmatter.mld $ odoc_print page-zero_frontmatter.odoc | jq '.frontmatter' { - "children": "None" + "children": "None", + "short_title": "None" } When there is one frontmatter, it is extracted from the content: @@ -22,6 +23,13 @@ When there is one frontmatter, it is extracted from the content: "Page": "page2" } ] + }, + "short_title": { + "Some": [ + { + "`Word": "yes!" + } + ] } } $ odoc_print page-one_frontmatter.odoc | jq '.content' @@ -74,7 +82,8 @@ When there is more than one children order, we raise a warning and keep only the "Page": "bli2" } ] - } + }, + "short_title": "None" } $ odoc_print page-two_frontmatters.odoc | jq '.content' [ diff --git a/test/frontmatter/short_title.t/run.t b/test/frontmatter/short_title.t/run.t new file mode 100644 index 0000000000..67f3a0e3b6 --- /dev/null +++ b/test/frontmatter/short_title.t/run.t @@ -0,0 +1,65 @@ +Normal use + + $ cat << EOF > index.mld + > @short_title First try + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + {"Some":[{"`Word":"First"},"`Space",{"`Word":"try"}]} + +With inline content + + $ cat << EOF > index.mld + > @short_title with [code] and {e emphasized} content + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + {"Some":[{"`Word":"with"},"`Space",{"`Code_span":"code"},"`Space",{"`Word":"and"},"`Space",{"`Styled":["`Emphasis",[{"`Word":"emphasized"}]]},"`Space",{"`Word":"content"}]} + +With reference or link + + $ cat << EOF > index.mld + > @short_title with {:link} and {!ref} + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + {"Some":[{"`Word":"with"},"`Space","`Space",{"`Word":"and"},"`Space"]} + +With other block + + $ cat << EOF > index.mld + > @short_title {[code block]} + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + File "index.mld", line 1, characters 0-27: + Warning: Short titles cannot contain other block than a single paragraph + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + "None" + + $ cat << EOF > index.mld + > @short_title paragraph + > {ul {li yo}} + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + File "index.mld", line 1, character 0 to line 2, character 12: + Warning: Short titles cannot contain other block than a single paragraph + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + "None" + +Multiple occurrence + + $ cat << EOF > index.mld + > @short_title yay + > @short_title yo + > {0 Test1} + > EOF + $ odoc compile --parent-id pkg --output-dir _odoc index.mld + File "index.mld", line 2, characters 0-15: + Warning: Duplicated @short_title entry + $ odoc_print _odoc/pkg/page-index.odoc | jq .frontmatter.short_title -c + {"Some":[{"`Word":"yay"}]} diff --git a/test/frontmatter/toc_order.t/run.t b/test/frontmatter/toc_order.t/run.t index 87078ffbf7..8c0ee1d01b 100644 --- a/test/frontmatter/toc_order.t/run.t +++ b/test/frontmatter/toc_order.t/run.t @@ -45,7 +45,8 @@ "Page": "typo" } ] - } + }, + "short_title": "None" } From cc80b26a8c5c3ce2a3269fc94ed5b565ad262a80 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Mon, 18 Nov 2024 14:31:08 +0000 Subject: [PATCH 4/4] Update CHANGES.md --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index d6835ed351..6ca6220f00 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -29,6 +29,8 @@ - Added a `--asset-path` arg to `html-generate` (@panglesd, #1185) - Add a `@children_order` tag to specify the order in the sidebar (@panglesd, #1187, #1243) +- Add a `@short_title` tag to specify the short title of a page for use in + the sidebar / breadcrumbs (@panglesd, #1246) - Add a 'remap' option to HTML generation for partial docsets (@jonludlam, #1189) - Added an `html-generate-asset` command (@panglesd, #1185) - Added syntax for images, videos, audio (@panglesd, #1184)