From 995acaa0c928d0c2c510fec1c58ca20fc27045af Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Sat, 3 Jul 2021 17:49:23 +0100 Subject: [PATCH] Switch to external odoc-parser library --- .github/workflows/build.yml | 2 +- odoc-parser.opam | 39 - odoc.opam | 2 +- package.json | 1 + src/document/comment.ml | 3 +- src/model/comment.ml | 2 +- src/model/error.ml | 5 +- src/model_desc/comment_desc.ml | 8 +- src/odoc/dune | 13 +- src/parser/ast.ml | 74 - src/parser/dune | 8 - src/parser/lexer.mli | 10 - src/parser/lexer.mll | 579 ---- src/parser/loc.ml | 51 - src/parser/loc.mli | 44 - src/parser/odoc_parser.ml | 79 - src/parser/odoc_parser.mli | 29 - src/parser/parse_error.ml | 64 - src/parser/syntax.ml | 1090 ------- src/parser/syntax.mli | 5 - src/parser/test/dune | 8 - src/parser/test/test.ml | 4992 -------------------------------- src/parser/token.ml | 165 -- src/parser/warning.ml | 27 - src/parser/warning.mli | 10 - test/xref2/lib/dune | 9 +- test/xref2/refs/dune | 8 +- test/xref2/resolve/dune | 8 +- test/xref2/strengthen/dune | 8 +- test/xref2/subst/dune | 8 +- 30 files changed, 57 insertions(+), 7294 deletions(-) delete mode 100644 odoc-parser.opam delete mode 100644 src/parser/ast.ml delete mode 100644 src/parser/dune delete mode 100644 src/parser/lexer.mli delete mode 100644 src/parser/lexer.mll delete mode 100644 src/parser/loc.ml delete mode 100644 src/parser/loc.mli delete mode 100644 src/parser/odoc_parser.ml delete mode 100644 src/parser/odoc_parser.mli delete mode 100644 src/parser/parse_error.ml delete mode 100644 src/parser/syntax.ml delete mode 100644 src/parser/syntax.mli delete mode 100644 src/parser/test/dune delete mode 100644 src/parser/test/test.ml delete mode 100644 src/parser/token.ml delete mode 100644 src/parser/warning.ml delete mode 100644 src/parser/warning.mli diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 18a2df9396..41ad99329f 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -38,7 +38,7 @@ jobs: odoc.opam - name: Install dependencies - run: opam install -y --deps-only -t ./odoc.opam ./odoc-parser.opam + run: opam install -y --deps-only -t ./odoc.opam - name: dune runtest run: opam exec -- dune runtest diff --git a/odoc-parser.opam b/odoc-parser.opam deleted file mode 100644 index 5331f3d5fd..0000000000 --- a/odoc-parser.opam +++ /dev/null @@ -1,39 +0,0 @@ -opam-version: "2.0" - -version: "dev" -homepage: "http://github.com/ocaml/odoc" -doc: "https://ocaml.github.io/odoc/" -bug-reports: "https://github.com/ocaml/odoc/issues" -license: "ISC" - -authors: [ - "Anton Bachin " -] -maintainer: "Jon Ludlam " -dev-repo: "git+https://github.com/ocaml/odoc.git" - -synopsis: "Parser for OCamldoc" -description: """ -Odoc_parser is a library for parsing the contents of OCaml documentation -comments, formatted using 'ocamldoc' syntax. -""" - -depends: [ - "dune" {>= "2.8"} - "ocaml" {>= "4.02.0"} - "astring" - "result" -] - -build: [ - ["dune" "subst"] {pinned} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "@install" - ] -] diff --git a/odoc.opam b/odoc.opam index 96b4367f3d..2a2a8f104b 100644 --- a/odoc.opam +++ b/odoc.opam @@ -23,7 +23,7 @@ delimited with `(** ... *)`, and outputs HTML. """ depends: [ - "odoc-parser" + "odoc-parser" {>= "0.9.0"} "astring" "cmdliner" "cppo" {build} diff --git a/package.json b/package.json index 5a3b16f389..a6574c3d55 100644 --- a/package.json +++ b/package.json @@ -46,6 +46,7 @@ "@opam/sexplib0": "*", "@opam/tyxml": "4.3.0", "@opam/ocamlfind-secondary":"1.8.1", + "@opam/odoc-parser":"0.9.0", "ocaml": "~4.2.0" }, "resolutions": { diff --git a/src/document/comment.ml b/src/document/comment.ml index 0c2afe3bb8..1061250082 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -195,7 +195,8 @@ let rec nestable_block_element : Comment.nestable_block_element -> Block.one = fun content -> match content with | `Paragraph p -> paragraph p - | `Code_block (_, code) -> block @@ Source (source_of_code code) + | `Code_block (_, code) -> + block @@ Source (source_of_code (Odoc_model.Location_.value code)) | `Verbatim s -> block @@ Verbatim s | `Modules ms -> module_references ms | `List (kind, items) -> diff --git a/src/model/comment.ml b/src/model/comment.ml index 9dd9b902ff..7b50602228 100644 --- a/src/model/comment.ml +++ b/src/model/comment.ml @@ -40,7 +40,7 @@ type module_reference = { type nestable_block_element = [ `Paragraph of paragraph - | `Code_block of string option * string + | `Code_block of string with_location option * string with_location | `Verbatim of string | `Modules of module_reference list | `List of diff --git a/src/model/error.ml b/src/model/error.ml index 91fb90d90d..8127769fb0 100644 --- a/src/model/error.ml +++ b/src/model/error.ml @@ -128,9 +128,10 @@ let unpack_warnings ww = (ww.value, List.map (fun w -> w.w) ww.warnings) let t_of_parser_t : Odoc_parser.Warning.t -> t = fun x -> (`With_full_location x :> t) -let raise_parser_warnings { Odoc_parser.ast; warnings } = +let raise_parser_warnings v = (* Parsing errors may be fatal. *) + let warnings = Odoc_parser.warnings v in let non_fatal = false in raise_warnings' (List.map (fun p -> { w = t_of_parser_t p; non_fatal }) warnings); - ast + Odoc_parser.ast v diff --git a/src/model_desc/comment_desc.ml b/src/model_desc/comment_desc.ml index 280b1a7ddb..ab57fe2e5a 100644 --- a/src/model_desc/comment_desc.ml +++ b/src/model_desc/comment_desc.ml @@ -18,7 +18,7 @@ and general_link_content = general_inline_element with_location list type general_block_element = [ `Paragraph of general_link_content - | `Code_block of string option * string + | `Code_block of string with_location option * string with_location | `Verbatim of string | `Modules of Comment.module_reference list | `List of @@ -89,7 +89,11 @@ let rec block_element : general_block_element t = (function | `Paragraph x -> C ("`Paragraph", x, link_content) | `Code_block (x, y) -> - C ("`Code_block", (x, y), Pair (Option string, string)) + C + ( "`Code_block", + ( (match x with None -> None | Some x -> Some (ignore_loc x)), + ignore_loc y ), + Pair (Option string, string) ) | `Verbatim x -> C ("`Verbatim", x, string) | `Modules x -> C ("`Modules", x, List module_reference) | `List (x1, x2) -> diff --git a/src/odoc/dune b/src/odoc/dune index 5ca7d74d2e..8b11f4d5cd 100644 --- a/src/odoc/dune +++ b/src/odoc/dune @@ -1,8 +1,17 @@ (library (name odoc_odoc) (public_name odoc.odoc) - (libraries compiler-libs.common fpath odoc_html odoc_manpage odoc_latex - odoc_loader odoc_model odoc_xref2 tyxml unix) + (libraries + compiler-libs.common + fpath + odoc_html + odoc_manpage + odoc_latex + odoc_loader + odoc_model + odoc_xref2 + tyxml + unix) (instrumentation (backend bisect_ppx))) diff --git a/src/parser/ast.ml b/src/parser/ast.ml deleted file mode 100644 index 50ebc08868..0000000000 --- a/src/parser/ast.ml +++ /dev/null @@ -1,74 +0,0 @@ -(** Abstract syntax tree representing ocamldoc comments *) - -(** This is a syntactic representation of ocamldoc comments. See - {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html}The manual} for a detailed - description of the syntax understood. Note that there is no attempt at semantic - analysis, and hence these types are capable of representing values that will - be rejected by further stages, for example, invalid references or headings that - are out of range. *) - -type 'a with_location = 'a Loc.with_location - -type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ] - -type reference_kind = [ `Simple | `With_text ] -(** References in doc comments can be of two kinds: [{!simple}] or [{{!ref}With text}]. *) - -type inline_element = - [ `Space of string - | `Word of string - | `Code_span of string - | `Raw_markup of string option * string - | `Styled of style * inline_element with_location list - | `Reference of - reference_kind * string with_location * inline_element with_location list - | `Link of string * inline_element with_location list ] -(** Inline elements are equivalent to what would be found in a [span] in HTML. - Mostly these are straightforward. The [`Reference] constructor takes a triple - whose second element is the reference itself, and the third the replacement - text. Similarly the [`Link] constructor has the link itself as first parameter - and the second is the replacement text. *) - -type nestable_block_element = - [ `Paragraph of inline_element with_location list - | `Code_block of string option * string - | `Verbatim of string - | `Modules of string with_location list - | `List of - [ `Unordered | `Ordered ] - * [ `Light | `Heavy ] - * nestable_block_element with_location list list ] -(** Some block elements may be nested within lists or tags, but not all. - The [`List] constructor has a parameter of type [\[`Light | `Heavy\]]. - This corresponds to the syntactic constructor used (see the - {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#sss:ocamldoc-list}manual}). - *) - -type internal_tag = - [ `Canonical of string with_location | `Inline | `Open | `Closed ] -(** Internal tags are used to exercise fine control over the output of odoc. They - are never rendered in the output *) - -type ocamldoc_tag = - [ `Author of string - | `Deprecated of nestable_block_element with_location list - | `Param of string * nestable_block_element with_location list - | `Raise of string * nestable_block_element with_location list - | `Return of nestable_block_element with_location list - | `See of - [ `Url | `File | `Document ] - * string - * nestable_block_element with_location list - | `Since of string - | `Before of string * nestable_block_element with_location list - | `Version of string ] -(** ocamldoc tags are those that are specified in the {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#ss:ocamldoc-tags}manual}) *) - -type tag = [ ocamldoc_tag | internal_tag ] - -type heading = int * string option * inline_element with_location list - -type block_element = - [ nestable_block_element | `Heading of heading | `Tag of tag ] - -type t = block_element with_location list diff --git a/src/parser/dune b/src/parser/dune deleted file mode 100644 index e87ffb22b1..0000000000 --- a/src/parser/dune +++ /dev/null @@ -1,8 +0,0 @@ -(ocamllex lexer) - -(library - (name odoc_parser) - (public_name odoc-parser) - (instrumentation - (backend bisect_ppx)) - (libraries astring result compiler-libs.common)) diff --git a/src/parser/lexer.mli b/src/parser/lexer.mli deleted file mode 100644 index ce053b495e..0000000000 --- a/src/parser/lexer.mli +++ /dev/null @@ -1,10 +0,0 @@ -(* Internal module, not exposed *) - -type input = { - file : string; - offset_to_location : int -> Loc.point; - warnings : Warning.t list ref; - lexbuf : Lexing.lexbuf; -} - -val token : input -> Lexing.lexbuf -> Token.t Loc.with_location diff --git a/src/parser/lexer.mll b/src/parser/lexer.mll deleted file mode 100644 index b1ea13aca6..0000000000 --- a/src/parser/lexer.mll +++ /dev/null @@ -1,579 +0,0 @@ -{ - -let unescape_word : string -> string = fun s -> - (* The common case is that there are no escape sequences. *) - match String.index s '\\' with - | exception Not_found -> s - | _ -> - let buffer = Buffer.create (String.length s) in - let rec scan_word index = - if index >= String.length s then - () - else - let c = s.[index] in - let c, increment = - match c with - | '\\' -> - if index + 1 < String.length s then - match s.[index + 1] with - | '{' | '}' | '[' | ']' | '@' as c -> c, 2 - | _ -> c, 1 - else c, 1 - | _ -> c, 1 - in - Buffer.add_char buffer c; - scan_word (index + increment) - in - scan_word 0; - Buffer.contents buffer - - - -(* This is used for code and verbatim blocks. It can be done with a regular - expression, but the regexp gets quite ugly, so a function is easier to - understand. *) -let trim_leading_blank_lines : string -> string = fun s -> - let rec scan_for_last_newline : int -> int -> int = - fun index trim_until -> - if index >= String.length s then - String.length s - else - match s.[index] with - | ' ' | '\t' | '\r' -> scan_for_last_newline (index + 1) trim_until - | '\n' -> scan_for_last_newline (index + 1) (index + 1) - | _ -> trim_until - in - let trim_until = scan_for_last_newline 0 0 in - String.sub s trim_until (String.length s - trim_until) - -let trim_trailing_blank_lines : string -> string = fun s -> - let rec scan_for_last_newline : int -> int option -> int option = - fun index trim_from -> - if index < 0 then - Some 0 - else - match s.[index] with - | ' ' | '\t' | '\r' -> scan_for_last_newline (index - 1) trim_from - | '\n' -> scan_for_last_newline (index - 1) (Some index) - | _ -> trim_from - in - let last = String.length s - 1 in - match scan_for_last_newline last None with - | None -> - s - | Some trim_from -> - let trim_from = - if trim_from > 0 && s.[trim_from - 1] = '\r' then - trim_from - 1 - else - trim_from - in - String.sub s 0 trim_from - -(** Returns [None] for an empty, [Some ident] for an indented line. *) -let trim_leading_whitespace : first_line_offset:int -> string -> string = - fun ~first_line_offset s -> - let count_leading_whitespace line = - let rec count_leading_whitespace' index len = - if index = len then None - else - match line.[index] with - | ' ' | '\t' -> count_leading_whitespace' (index + 1) len - | _ -> Some index - in - let len = String.length line in - (* '\r' may remain because we only split on '\n' below. This is important - for the first line, which would be considered not empty without this check. *) - let len = if len > 0 && line.[len - 1] = '\r' then len - 1 else len in - count_leading_whitespace' 0 len - in - - let lines = Astring.String.cuts ~sep:"\n" s in - - let least_amount_of_whitespace = - List.fold_left (fun least_so_far line -> - match (count_leading_whitespace line, least_so_far) with - | (Some _ as n', None) -> n' - | (Some n as n', Some least) when n < least -> n' - | _ -> least_so_far) - in - - let first_line_max_drop, least_amount_of_whitespace = - match lines with - | [] -> 0, None - | first_line :: tl -> - begin match count_leading_whitespace first_line with - | Some n -> - n, least_amount_of_whitespace (Some (first_line_offset + n)) tl - | None -> - 0, least_amount_of_whitespace None tl - end - in - - match least_amount_of_whitespace with - | None -> - s - | Some least_amount_of_whitespace -> - let drop n line = - (* Since blank lines were ignored when calculating - [least_amount_of_whitespace], their length might be less than the - amount. *) - if String.length line < n then line - else String.sub line n (String.length line - n) - in - let lines = - match lines with - | [] -> [] - | first_line :: tl -> - drop (min first_line_max_drop least_amount_of_whitespace) first_line - :: List.map (drop least_amount_of_whitespace) tl - in - String.concat "\n" lines - -type input = { - file : string; - offset_to_location : int -> Loc.point; - warnings : Warning.t list ref; - lexbuf : Lexing.lexbuf; -} - -let with_location_adjustments - k input ?start_offset ?adjust_start_by ?end_offset ?adjust_end_by value = - - let start = - match start_offset with - | None -> Lexing.lexeme_start input.lexbuf - | Some s -> s - in - let start = - match adjust_start_by with - | None -> start - | Some s -> start + String.length s - in - let end_ = - match end_offset with - | None -> Lexing.lexeme_end input.lexbuf - | Some e -> e - in - let end_ = - match adjust_end_by with - | None -> end_ - | Some s -> end_ - String.length s - in - let location = { - Loc.file = input.file; - start = input.offset_to_location start; - end_ = input.offset_to_location end_; - } - in - k input location value - -let emit = - with_location_adjustments (fun _ -> Loc.at) - -let warning = - with_location_adjustments (fun input location error -> - input.warnings := (error location) :: !(input.warnings)) - -let reference_token start target = - match start with - | "{!" -> `Simple_reference target - | "{{!" -> `Begin_reference_with_replacement_text target - | "{:" -> `Simple_link target - | "{{:" -> `Begin_link_with_replacement_text target - | _ -> assert false - - - -let trim_leading_space_or_accept_whitespace input start_offset text = - match text.[0] with - | ' ' -> String.sub text 1 (String.length text - 1) - | '\t' | '\r' | '\n' -> text - | exception Invalid_argument _ -> "" - | _ -> - warning - input - ~start_offset - ~end_offset:(start_offset + 2) - Parse_error.no_leading_whitespace_in_verbatim; - text - -let trim_trailing_space_or_accept_whitespace text = - match text.[String.length text - 1] with - | ' ' -> String.sub text 0 (String.length text - 1) - | '\t' | '\r' | '\n' -> text - | _ -> text - | exception Invalid_argument _ -> text - -let emit_verbatim input start_offset buffer = - let t = Buffer.contents buffer in - let t = trim_trailing_space_or_accept_whitespace t in - let t = trim_leading_space_or_accept_whitespace input start_offset t in - let t = trim_leading_blank_lines t in - let t = trim_trailing_blank_lines t in - emit input (`Verbatim t) ~start_offset - -let emit_code_block input meta c = - let c = trim_trailing_blank_lines c in - let c = - with_location_adjustments - (fun _ location c -> - let first_line_offset = location.start.column + 2 (* Length of {[ *) in - trim_leading_whitespace ~first_line_offset c) - input c - in - let c = trim_leading_blank_lines c in - emit input (`Code_block (meta, c)) - - - -let heading_level input level = - if String.length level >= 2 && level.[0] = '0' then begin - warning - input ~start_offset:1 (Parse_error.leading_zero_in_heading_level level) - end; - int_of_string level - -} - - - -let markup_char = - ['{' '}' '[' ']' '@'] -let space_char = - [' ' '\t' '\n' '\r'] -let bullet_char = - ['-' '+'] - -let word_char = - (_ # markup_char # space_char # bullet_char) | ('\\' markup_char) - -let horizontal_space = - [' ' '\t'] -let newline = - '\n' | "\r\n" - -let reference_start = - "{!" | "{{!" | "{:" | "{{:" - -let code_block_text = - ([^ ']'] | ']'+ [^ ']' '}'])* ']'* -let raw_markup = - ([^ '%'] | '%'+ [^ '%' '}'])* '%'* -let raw_markup_target = - ([^ ':' '%'] | '%'+ [^ ':' '%' '}'])* '%'* -let code_block_meta = - ([^ '['])* - - - -rule token input = parse - | horizontal_space* eof - { emit input `End } - - | ((horizontal_space* newline as prefix) - horizontal_space* ((newline horizontal_space*)+ as suffix) as ws) - { emit input (`Blank_line ws) ~adjust_start_by:prefix ~adjust_end_by:suffix } - - | (horizontal_space* newline horizontal_space* as ws) - { emit input (`Single_newline ws) } - - | (horizontal_space+ as ws) - { emit input (`Space ws) } - - | (horizontal_space* (newline horizontal_space*)? as p) '}' - { emit input `Right_brace ~adjust_start_by:p } - - | word_char (word_char | bullet_char | '@')* - | bullet_char (word_char | bullet_char | '@')+ as w - { emit input (`Word (unescape_word w)) } - - | '[' - { code_span - (Buffer.create 1024) 0 (Lexing.lexeme_start lexbuf) input lexbuf } - - | '-' - { emit input `Minus } - - | '+' - { emit input `Plus } - - | "{b" - { emit input (`Begin_style `Bold) } - - | "{i" - { emit input (`Begin_style `Italic) } - - | "{e" - { emit input (`Begin_style `Emphasis) } - - | "{L" - { emit input (`Begin_paragraph_style `Left) } - - | "{C" - { emit input (`Begin_paragraph_style `Center) } - - | "{R" - { emit input (`Begin_paragraph_style `Right) } - - | "{^" - { emit input (`Begin_style `Superscript) } - - | "{_" - { emit input (`Begin_style `Subscript) } - - | "{!modules:" ([^ '}']* as modules) '}' - { emit input (`Modules modules) } - - | (reference_start as start) ([^ '}']* as target) '}' - { emit input (reference_token start target) } - - | "{[" (code_block_text as c) "]}" - { emit_code_block input None c } - - | "{@" (code_block_meta as m) "[" (code_block_text as c) "]}" - { emit_code_block input (Some m) c } - - | "{v" - { verbatim - (Buffer.create 1024) None (Lexing.lexeme_start lexbuf) input lexbuf } - - | "{%" ((raw_markup_target as target) ':')? (raw_markup as s) - ("%}" | eof as e) - { let token = `Raw_markup (target, s) in - if e <> "%}" then - warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe token)); - emit input token } - - | "{ul" - { emit input (`Begin_list `Unordered) } - - | "{ol" - { emit input (`Begin_list `Ordered) } - - | "{li" - { emit input (`Begin_list_item `Li) } - - | "{-" - { emit input (`Begin_list_item `Dash) } - - | '{' (['0'-'9']+ as level) ':' (([^ '}'] # space_char)* as label) - { emit - input (`Begin_section_heading (heading_level input level, Some label)) } - - | '{' (['0'-'9']+ as level) - { emit input (`Begin_section_heading (heading_level input level, None)) } - - | "@author" ((horizontal_space+ [^ '\r' '\n']*)? as author) - { emit input (`Tag (`Author author)) } - - | "@deprecated" - { emit input (`Tag `Deprecated) } - - | "@param" horizontal_space+ ((_ # space_char)+ as name) - { emit input (`Tag (`Param name)) } - - | ("@raise" | "@raises") horizontal_space+ ((_ # space_char)+ as name) - { emit input (`Tag (`Raise name)) } - - | ("@return" | "@returns") - { emit input (`Tag `Return) } - - | "@see" horizontal_space* '<' ([^ '>']* as url) '>' - { emit input (`Tag (`See (`Url, url))) } - - | "@see" horizontal_space* '\'' ([^ '\'']* as filename) '\'' - { emit input (`Tag (`See (`File, filename))) } - - | "@see" horizontal_space* '"' ([^ '"']* as name) '"' - { emit input (`Tag (`See (`Document, name))) } - - | "@since" ((horizontal_space+ [^ '\r' '\n']*)? as version) - { emit input (`Tag (`Since version)) } - - | "@before" horizontal_space+ ((_ # space_char)+ as version) - { emit input (`Tag (`Before version)) } - - | "@version" ((horizontal_space+ [^ '\r' '\n']*)? as version) - { emit input (`Tag (`Version version)) } - - | "@canonical" ((horizontal_space+ [^ '\r' '\n']*)? as identifier) - { emit input (`Tag (`Canonical identifier)) } - - | "@inline" - { emit input (`Tag `Inline) } - - | "@open" - { emit input (`Tag `Open) } - - | "@closed" - { emit input (`Tag `Closed) } - - - - | '{' - { try bad_markup_recovery (Lexing.lexeme_start lexbuf) input lexbuf - with Failure _ -> - warning - input - (Parse_error.bad_markup - "{" ~suggestion:"escape the brace with '\\{'."); - emit input (`Word "{") } - - | ']' - { warning input Parse_error.unpaired_right_bracket; - emit input (`Word "]") } - - | "@param" - { warning input Parse_error.truncated_param; - emit input (`Tag (`Param "")) } - - | ("@raise" | "@raises") as tag - { warning input (Parse_error.truncated_raise tag); - emit input (`Tag (`Raise "")) } - - | "@before" - { warning input Parse_error.truncated_before; - emit input (`Tag (`Before "")) } - - | "@see" - { warning input Parse_error.truncated_see; - emit input (`Word "@see") } - - | '@' ['a'-'z' 'A'-'Z']+ as tag - { warning input (Parse_error.unknown_tag tag); - emit input (`Word tag) } - - | '@' - { warning input Parse_error.stray_at; - emit input (`Word "@") } - - | '\r' - { warning input Parse_error.stray_cr; - token input lexbuf } - - | "{!modules:" ([^ '}']* as modules) eof - { warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (`Modules ""))); - emit input (`Modules modules) } - - | (reference_start as start) ([^ '}']* as target) eof - { warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (reference_token start ""))); - emit input (reference_token start target) } - - | "{[" (code_block_text as c) eof - { warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (`Code_block (None, "")))); - emit_code_block input None c } - - | "{@" (code_block_meta as m) "[" (code_block_text as c) eof - { warning - input - ~start_offset:(Lexing.lexeme_end lexbuf) - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (`Code_block (None, "")))); - emit_code_block input (Some m) c } - - - -and code_span buffer nesting_level start_offset input = parse - | ']' - { if nesting_level = 0 then - emit input (`Code_span (Buffer.contents buffer)) ~start_offset - else begin - Buffer.add_char buffer ']'; - code_span buffer (nesting_level - 1) start_offset input lexbuf - end } - - | '[' - { Buffer.add_char buffer '['; - code_span buffer (nesting_level + 1) start_offset input lexbuf } - - | '\\' ('[' | ']' as c) - { Buffer.add_char buffer c; - code_span buffer nesting_level start_offset input lexbuf } - - | newline newline - { warning - input - (Parse_error.not_allowed - ~what:(Token.describe (`Blank_line "\n\n")) - ~in_what:(Token.describe (`Code_span ""))); - Buffer.add_char buffer '\n'; - code_span buffer nesting_level start_offset input lexbuf } - - | eof - { warning - input - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (`Code_span ""))); - emit input (`Code_span (Buffer.contents buffer)) ~start_offset } - - | _ as c - { Buffer.add_char buffer c; - code_span buffer nesting_level start_offset input lexbuf } - - - -and verbatim buffer last_false_terminator start_offset input = parse - | (space_char as c) "v}" - { Buffer.add_char buffer c; - emit_verbatim input start_offset buffer } - - | "v}" - { Buffer.add_string buffer "v}"; - verbatim - buffer (Some (Lexing.lexeme_start lexbuf)) start_offset input lexbuf } - - | eof - { begin match last_false_terminator with - | None -> - warning - input - (Parse_error.not_allowed - ~what:(Token.describe `End) - ~in_what:(Token.describe (`Verbatim ""))) - | Some location -> - warning - input - ~start_offset:location - ~end_offset:(location + 2) - Parse_error.no_trailing_whitespace_in_verbatim - end; - emit_verbatim input start_offset buffer } - - | _ as c - { Buffer.add_char buffer c; - verbatim buffer last_false_terminator start_offset input lexbuf } - - - -and bad_markup_recovery start_offset input = parse - | [^ '}']+ as text '}' as rest - { let suggestion = - Printf.sprintf "did you mean '{!%s}' or '[%s]'?" text text in - warning - input - ~start_offset - (Parse_error.bad_markup ("{" ^ rest) ~suggestion); - emit input (`Code_span text) ~start_offset} diff --git a/src/parser/loc.ml b/src/parser/loc.ml deleted file mode 100644 index 1bbad55243..0000000000 --- a/src/parser/loc.ml +++ /dev/null @@ -1,51 +0,0 @@ -type point = { line : int; column : int } - -type span = { file : string; start : point; end_ : point } - -type +'a with_location = { location : span; value : 'a } - -let at location value = { location; value } - -let location { location; _ } = location - -let value { value; _ } = value - -let map f annotated = { annotated with value = f annotated.value } - -let same annotated value = { annotated with value } - -let span spans = - match spans with - | [] -> - { - file = "_none_"; - start = { line = 1; column = 0 }; - end_ = { line = 1; column = 0 }; - } - | first :: spans -> - let last = List.fold_left (fun _ span -> span) first spans in - { file = first.file; start = first.start; end_ = last.end_ } - -let nudge_start offset span = - { span with start = { span.start with column = span.start.column + offset } } - -let to_loc span = - let loc_start = - Lexing. - { - pos_fname = span.file; - pos_lnum = span.start.line; - pos_bol = 0; - pos_cnum = span.start.column; - } - in - let loc_end = - Lexing. - { - pos_fname = span.file; - pos_lnum = span.end_.line; - pos_bol = 0; - pos_cnum = span.end_.column; - } - in - Location.{ loc_start; loc_end; loc_ghost = false } diff --git a/src/parser/loc.mli b/src/parser/loc.mli deleted file mode 100644 index 9932b0de4b..0000000000 --- a/src/parser/loc.mli +++ /dev/null @@ -1,44 +0,0 @@ -(** Locations in files. *) - -(** This module concerns locations in source files, both points indicating a specific - character and spans between two points. *) - -(** {2 Basic types} *) - -type point = { line : int; column : int } -(** A specific character *) - -type span = { file : string; start : point; end_ : point } -(** A range of characters between [start] and [end_] in a particular file *) - -val span : span list -> span -(** [span spans] takes a list of spans and returns a single {!type-span} starting - at the start of the first span and ending at the end of the final span *) - -val nudge_start : int -> span -> span -(** This adjusts only the column number, implicitly assuming that the offset does - not move the location across a newline character. *) - -val to_loc : span -> Location.t -(** Returns a {!Warning.loc} that represents the span *) - -(** {2 Located values} *) - -type +'a with_location = { location : span; value : 'a } -(** Describes values located at a particular span *) - -val at : span -> 'a -> 'a with_location -(** Constructor for {!with_location} *) - -val location : 'a with_location -> span -(** Returns the location of a located value *) - -val value : 'a with_location -> 'a -(** Returns the value of a located value *) - -val map : ('a -> 'b) -> 'a with_location -> 'b with_location -(** Map over a located value without changing its location *) - -val same : _ with_location -> 'b -> 'b with_location -(** [same x y] retuns the value y wrapped in a {!with_location} whose - location is that of [x] *) diff --git a/src/parser/odoc_parser.ml b/src/parser/odoc_parser.ml deleted file mode 100644 index c6d8ce7fd7..0000000000 --- a/src/parser/odoc_parser.ml +++ /dev/null @@ -1,79 +0,0 @@ -module Ast = Ast -module Loc = Loc -module Warning = Warning - -type t = Syntax.output = { ast : Ast.t; warnings : Warning.t list } - -(* odoc uses an ocamllex lexer. The "engine" for such lexers is the standard - [Lexing] module. - - As the [Lexing] module reads the input, it keeps track of only the byte - offset into the input. It is normally the job of each particular lexer - implementation to decide which character sequences count as newlines, and - keep track of line/column locations. This is usually done by writing several - extra regular expressions, and calling [Lexing.new_line] at the right time. - - Keeping track of newlines like this makes the odoc lexer somewhat too - diffiult to read, however. To factor the aspect of keeping track of newlines - fully out of the odoc lexer, instead of having it keep track of newlines as - it's scanning the input, the input is pre-scanned before feeding it into the - lexer. A table of all the newlines is assembled, and used to convert offsets - into line/column pairs after the lexer emits tokens. - - [offset_to_location ~input ~comment_location offset] converts the byte - [offset], relative to the beginning of a comment, into a location, relative - to the beginning of the file containing the comment. [input] is the comment - text, and [comment_location] is the location of the comment within its file. - The function is meant to be partially applied to its first two arguments, at - which point it creates the table described above. The remaining function is - then passed to the lexer, so it can apply the table to its emitted tokens. *) -let offset_to_location : - input:string -> comment_location:Lexing.position -> int -> Loc.point = - fun ~input ~comment_location -> - let rec find_newlines line_number input_index newlines_accumulator = - if input_index >= String.length input then newlines_accumulator - else if - (* This is good enough to detect CR-LF also. *) - input.[input_index] = '\n' - then - find_newlines (line_number + 1) (input_index + 1) - ((line_number + 1, input_index + 1) :: newlines_accumulator) - else find_newlines line_number (input_index + 1) newlines_accumulator - in - - let reversed_newlines : (int * int) list = find_newlines 1 0 [ (1, 0) ] in - - fun byte_offset -> - let rec scan_to_last_newline reversed_newlines_prefix = - match reversed_newlines_prefix with - | [] -> assert false - | (line_in_comment, line_start_offset) :: prefix -> - if line_start_offset > byte_offset then scan_to_last_newline prefix - else - let column_in_comment = byte_offset - line_start_offset in - let line_in_file = - line_in_comment + comment_location.Lexing.pos_lnum - 1 - in - let column_in_file = - if line_in_comment = 1 then - column_in_comment + comment_location.Lexing.pos_cnum - - comment_location.Lexing.pos_bol - else column_in_comment - in - { Loc.line = line_in_file; column = column_in_file } - in - scan_to_last_newline reversed_newlines - -let parse_comment ~location ~text = - let warnings = ref [] in - let token_stream = - let lexbuf = Lexing.from_string text in - let offset_to_location = - offset_to_location ~input:text ~comment_location:location - in - let input : Lexer.input = - { file = location.Lexing.pos_fname; offset_to_location; warnings; lexbuf } - in - Stream.from (fun _token_index -> Some (Lexer.token input lexbuf)) - in - Syntax.parse warnings token_stream diff --git a/src/parser/odoc_parser.mli b/src/parser/odoc_parser.mli deleted file mode 100644 index 958ab3ef6c..0000000000 --- a/src/parser/odoc_parser.mli +++ /dev/null @@ -1,29 +0,0 @@ -(** Parser for ocamldoc formatted comments. *) - -module Ast = Ast -module Loc = Loc - -(** Warnings produced during parsing. *) -module Warning : sig - type t = Warning.t = { location : Loc.span; message : string } - (** Warnings are represented as human-readable text. *) - - val to_string : t -> string - (** [to_string] will format the location and warning as text to be - printed. *) -end - -type t = { ast : Ast.t; warnings : Warning.t list } -(** [type t] is the result of parsing. *) - -val parse_comment : location:Lexing.position -> text:string -> t -(** [parse_comment ~location ~text] parses [text] as an ocamldoc formatted - string. The parser will try to recover from any invalid syntax encountered, - and therefore this will always produce a result of some sort with zero or - more warnings. The location passed in should represent the start of the - {i content} of the documentation comment - so for a line such as - {[ - (** A comment starting in the first column (0) *) - ]} - the location should represent the space immediately before the [A], so the - in the 4th column (3) *) diff --git a/src/parser/parse_error.ml b/src/parser/parse_error.ml deleted file mode 100644 index 8c95c4d535..0000000000 --- a/src/parser/parse_error.ml +++ /dev/null @@ -1,64 +0,0 @@ -let capitalize_ascii = Astring.String.Ascii.capitalize - -let bad_markup : ?suggestion:string -> string -> Loc.span -> Warning.t = - fun ?suggestion -> Warning.make ?suggestion "'%s': bad markup." - -let leading_zero_in_heading_level : string -> Loc.span -> Warning.t = - Warning.make "'%s': leading zero in heading level." - -let should_not_be_empty : what:string -> Loc.span -> Warning.t = - fun ~what -> Warning.make "%s should not be empty." (capitalize_ascii what) - -let markup_should_not_be_used : what:string -> Loc.span -> Warning.t = - fun ~what -> - Warning.make "%s should not be used because it has no effect." - (capitalize_ascii what) - -let should_begin_on_its_own_line : what:string -> Loc.span -> Warning.t = - fun ~what -> - Warning.make "%s should begin on its own line." (capitalize_ascii what) - -let should_be_followed_by_whitespace : what:string -> Loc.span -> Warning.t = - fun ~what -> - Warning.make "%s should be followed by space, a tab, or a new line." - (capitalize_ascii what) - -let not_allowed : - ?suggestion:string -> what:string -> in_what:string -> Loc.span -> Warning.t - = - fun ?suggestion ~what ~in_what -> - Warning.make ?suggestion "%s is not allowed in %s." (capitalize_ascii what) - in_what - -let no_leading_whitespace_in_verbatim : Loc.span -> Warning.t = - Warning.make "'{v' should be followed by whitespace." - -let no_trailing_whitespace_in_verbatim : Loc.span -> Warning.t = - Warning.make "'v}' should be preceded by whitespace." - -let stray_at : Loc.span -> Warning.t = Warning.make "Stray '@'." - -let stray_cr : Loc.span -> Warning.t = - Warning.make "Stray '\\r' (carriage return character)." - -let truncated_before : Loc.span -> Warning.t = - Warning.make "'@before' expects version number on the same line." - -let truncated_param : Loc.span -> Warning.t = - Warning.make "'@param' expects parameter name on the same line." - -let truncated_raise : string -> Loc.span -> Warning.t = - Warning.make "'%s' expects exception constructor on the same line." - -let truncated_see : Loc.span -> Warning.t = - Warning.make - "'@see' should be followed by , 'file', or \"document title\"." - -let unknown_tag : string -> Loc.span -> Warning.t = - Warning.make "Unknown tag '%s'." - -let unpaired_right_brace : Loc.span -> Warning.t = - Warning.make ~suggestion:"try '\\}'." "Unpaired '}' (end of markup)." - -let unpaired_right_bracket : Loc.span -> Warning.t = - Warning.make ~suggestion:"try '\\]'." "Unpaired ']' (end of code)." diff --git a/src/parser/syntax.ml b/src/parser/syntax.ml deleted file mode 100644 index 8e489b018e..0000000000 --- a/src/parser/syntax.ml +++ /dev/null @@ -1,1090 +0,0 @@ -(* This module is a recursive descent parser for the ocamldoc syntax. The parser - consumes a token stream of type [Token.t Stream.t], provided by the lexer, - and produces a comment AST of the type defined in [Parser_.Ast]. - - The AST has two main levels: inline elements, which can appear inside - paragraphs, and are spaced horizontally when presented, and block elements, - such as paragraphs and lists, which are spaced vertically when presented. - Block elements contain inline elements, but not vice versa. - - Corresponding to this, the parser has three "main" functions: - - - [delimited_inline_element_list] parses a run of inline elements that is - delimited by curly brace markup ([{...}]). - - [paragraph] parses a run of inline elements that make up a paragraph, and - is not explicitly delimited with curly braces. - - [block_element_list] parses a sequence of block elements. A comment is a - sequence of block elements, so [block_element_list] is the top-level - parser. It is also used for list item and tag content. *) - -type 'a with_location = 'a Loc.with_location - -(* {2 Input} *) - -type input = { - tokens : Token.t Loc.with_location Stream.t; - warnings : Warning.t list ref; -} - -(* {2 Output} *) - -let add_warning input warning = input.warnings := warning :: !(input.warnings) - -let junk input = Stream.junk input.tokens - -let peek input = - match Stream.peek input.tokens with - | Some token -> token - | None -> assert false - -(* The last token in the stream is always [`End], and it is never consumed by - the parser, so the [None] case is impossible. *) - -let npeek n input = Stream.npeek n input.tokens - -(* {2 Non-link inline elements} *) -type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ] - -(* Convenient abbreviation for use in patterns. *) -type token_that_always_begins_an_inline_element = - [ `Word of string - | `Code_span of string - | `Raw_markup of string option * string - | `Begin_style of style - | `Simple_reference of string - | `Begin_reference_with_replacement_text of string - | `Simple_link of string - | `Begin_link_with_replacement_text of string ] - -(* Check that the token constructors above actually are all in [Token.t]. *) -let _check_subset : token_that_always_begins_an_inline_element -> Token.t = - fun t -> (t :> Token.t) - -(* Consumes tokens that make up a single non-link inline element: - - - a horizontal space ([`Space], significant in inline elements), - - a word (see [word]), - - a code span ([...], [`Code_span _]), or - - styled text ({e ...}). - - The latter requires a recursive call to [delimited_inline_element_list], - defined below. - - This should be part of [delimited_inline_element_list]; however, it is also - called by function [paragraph]. As a result, it is factored out, and made - mutually-recursive with [delimited_inline_element_list]. - - This is called only when it is known that the first token in the list is the - beginning of an inline element. In the case of [`Minus] and [`Plus], that - means the caller has determined that they are not a list bullet (i.e., not - the first non-whitespace tokens on their line). - - This function consumes exactly the tokens that make up the element. *) -let rec inline_element : - input -> Loc.span -> _ -> Ast.inline_element with_location = - fun input location next_token -> - match next_token with - | `Space _ as token -> - junk input; - Loc.at location token - | `Word _ as token -> - junk input; - Loc.at location token - (* This is actually the same memory representation as the token, complete - with location, and is probably the most common case. Perhaps the token - can be reused somehow. The same is true of [`Space], [`Code_span]. *) - | `Minus -> - junk input; - Loc.at location (`Word "-") - | `Plus -> - junk input; - Loc.at location (`Word "+") - | `Code_span c -> - junk input; - Loc.at location (`Code_span c) - | `Raw_markup (raw_markup_target, s) -> - junk input; - Loc.at location (`Raw_markup (raw_markup_target, s)) - | `Begin_style s as parent_markup -> - junk input; - - let requires_leading_whitespace = - match s with - | `Bold | `Italic | `Emphasis -> true - | `Superscript | `Subscript -> false - in - let content, brace_location = - delimited_inline_element_list ~parent_markup - ~parent_markup_location:location ~requires_leading_whitespace input - in - - let location = Loc.span [ location; brace_location ] in - - if content = [] then - Parse_error.should_not_be_empty - ~what:(Token.describe parent_markup) - location - |> add_warning input; - - Loc.at location (`Styled (s, content)) - | `Simple_reference r -> - junk input; - - let r_location = Loc.nudge_start (String.length "{!") location in - let r = Loc.at r_location r in - - Loc.at location (`Reference (`Simple, r, [])) - | `Begin_reference_with_replacement_text r as parent_markup -> - junk input; - - let r_location = Loc.nudge_start (String.length "{{!") location in - let r = Loc.at r_location r in - - let content, brace_location = - delimited_inline_element_list ~parent_markup - ~parent_markup_location:location ~requires_leading_whitespace:false - input - in - - let location = Loc.span [ location; brace_location ] in - - if content = [] then - Parse_error.should_not_be_empty - ~what:(Token.describe parent_markup) - location - |> add_warning input; - - Loc.at location (`Reference (`With_text, r, content)) - | `Simple_link u -> - junk input; - - let u = String.trim u in - - if u = "" then - Parse_error.should_not_be_empty - ~what:(Token.describe next_token) - location - |> add_warning input; - - Loc.at location (`Link (u, [])) - | `Begin_link_with_replacement_text u as parent_markup -> - junk input; - - let u = String.trim u in - - if u = "" then - Parse_error.should_not_be_empty - ~what:(Token.describe parent_markup) - location - |> add_warning input; - - let content, brace_location = - delimited_inline_element_list ~parent_markup - ~parent_markup_location:location ~requires_leading_whitespace:false - input - in - - `Link (u, content) |> Loc.at (Loc.span [ location; brace_location ]) - -(* Consumes tokens that make up a sequence of inline elements that is ended by - a '}', a [`Right_brace] token. The brace token is also consumed. - - The sequences are also preceded by some markup like '{b'. Some of these - markup tokens require whitespace immediately after the token, and others not. - The caller indicates which way that is through the - [~requires_leading_whitespace] argument. - - Whitespace is significant in inline element lists. In particular, "foo [bar]" - is represented as [`Word "foo"; `Space; `Code_span "bar"], while "foo[bar]" - is [`Word "foo"; `Code_span "bar"]. It doesn't matter how much whitespace is - there, just whether it is present or not. Single newlines and horizontal - space in any amount are allowed. Blank lines are not, as these are separators - for {e block} elements. - - In correct input, the first and last elements emitted will not be [`Space], - i.e. [`Space] appears only between other non-link inline elements. In - incorrect input, there might be [`Space] followed immediately by something - like an @author tag. - - The [~parent_markup] and [~parent_markup_location] arguments are used for - generating error messages. *) -and delimited_inline_element_list : - parent_markup:[< Token.t ] -> - parent_markup_location:Loc.span -> - requires_leading_whitespace:bool -> - input -> - Ast.inline_element with_location list * Loc.span = - fun ~parent_markup ~parent_markup_location ~requires_leading_whitespace input -> - (* [~at_start_of_line] is used to interpret [`Minus] and [`Plus]. These are - word tokens if not the first non-whitespace tokens on their line. Then, - they are allowed in a non-link element list. *) - let rec consume_elements : - at_start_of_line:bool -> - Ast.inline_element with_location list -> - Ast.inline_element with_location list * Loc.span = - fun ~at_start_of_line acc -> - let next_token = peek input in - match next_token.value with - | `Right_brace -> - junk input; - (List.rev acc, next_token.location) - (* The [`Space] token is not space at the beginning or end of line, because - that is combined into [`Single_newline] or [`Blank_line] tokens. It is - also not at the beginning of markup (after e.g. '{b'), because that is - handled separately before calling - [consume_non_link_inline_elements], and not immediately before '}', - because that is combined into the [`Right_brace] token by the lexer. So, - it is an internal space, and we want to add it to the non-link inline - element list. *) - | (`Space _ | #token_that_always_begins_an_inline_element) as token -> - let acc = inline_element input next_token.location token :: acc in - consume_elements ~at_start_of_line:false acc - | `Single_newline ws -> - junk input; - let element = Loc.same next_token (`Space ws) in - consume_elements ~at_start_of_line:true (element :: acc) - | `Blank_line ws as blank -> - Parse_error.not_allowed ~what:(Token.describe blank) - ~in_what:(Token.describe parent_markup) - next_token.location - |> add_warning input; - - junk input; - let element = Loc.same next_token (`Space ws) in - consume_elements ~at_start_of_line:true (element :: acc) - | (`Minus | `Plus) as bullet -> - (if at_start_of_line then - let suggestion = - Printf.sprintf "move %s so it isn't the first thing on the line." - (Token.print bullet) - in - Parse_error.not_allowed ~what:(Token.describe bullet) - ~in_what:(Token.describe parent_markup) - ~suggestion next_token.location - |> add_warning input); - - let acc = inline_element input next_token.location bullet :: acc in - consume_elements ~at_start_of_line:false acc - | other_token -> - Parse_error.not_allowed - ~what:(Token.describe other_token) - ~in_what:(Token.describe parent_markup) - next_token.location - |> add_warning input; - - let last_location = - match acc with - | last_token :: _ -> last_token.location - | [] -> parent_markup_location - in - - (List.rev acc, last_location) - in - - let first_token = peek input in - match first_token.value with - | `Space _ -> - junk input; - consume_elements ~at_start_of_line:false [] - (* [~at_start_of_line] is [false] here because the preceding token was some - some markup like '{b', and we didn't move to the next line, so the next - token will not be the first non-whitespace token on its line. *) - | `Single_newline _ -> - junk input; - consume_elements ~at_start_of_line:true [] - | `Blank_line _ as blank -> - (* In case the markup is immediately followed by a blank line, the error - message printed by the catch-all case below can be confusing, as it will - suggest that the markup must be followed by a newline (which it is). It - just must not be followed by two newlines. To explain that clearly, - handle that case specifically. *) - Parse_error.not_allowed ~what:(Token.describe blank) - ~in_what:(Token.describe parent_markup) - first_token.location - |> add_warning input; - - junk input; - consume_elements ~at_start_of_line:true [] - | `Right_brace -> - junk input; - ([], first_token.location) - | _ -> - if requires_leading_whitespace then - Parse_error.should_be_followed_by_whitespace - ~what:(Token.print parent_markup) - parent_markup_location - |> add_warning input; - consume_elements ~at_start_of_line:false [] - -(* {2 Paragraphs} *) - -(* Consumes tokens that make up a paragraph. - - A paragraph is a sequence of inline elements that ends on a blank line, or - explicit block markup such as a verbatim block on a new line. - - Because of the significance of newlines, paragraphs are parsed line-by-line. - The function [paragraph] is called only when the current token is the first - non-whitespace token on its line, and begins an inline element. [paragraph] - then parses a line of inline elements. Afterwards, it looks ahead to the next - line. If that line also begins with an inline element, it parses that line, - and so on. *) -let paragraph : input -> Ast.nestable_block_element with_location = - fun input -> - (* Parses a single line of a paragraph, consisting of inline elements. The - only valid ways to end a paragraph line are with [`End], [`Single_newline], - [`Blank_line], and [`Right_brace]. Everything else either belongs in the - paragraph, or signifies an attempt to begin a block element inside a - paragraph line, which is an error. These errors are caught elsewhere; the - paragraph parser just stops. *) - let rec paragraph_line : - Ast.inline_element with_location list -> - Ast.inline_element with_location list = - fun acc -> - let next_token = peek input in - match next_token.value with - | (`Space _ | `Minus | `Plus | #token_that_always_begins_an_inline_element) - as token -> - let element = inline_element input next_token.location token in - paragraph_line (element :: acc) - | _ -> acc - in - - (* After each line is parsed, decides whether to parse more lines. *) - let rec additional_lines : - Ast.inline_element with_location list -> - Ast.inline_element with_location list = - fun acc -> - match npeek 2 input with - | { value = `Single_newline ws; location } - :: { value = #token_that_always_begins_an_inline_element; _ } :: _ -> - junk input; - let acc = Loc.at location (`Space ws) :: acc in - let acc = paragraph_line acc in - additional_lines acc - | _ -> List.rev acc - in - - let elements = paragraph_line [] |> additional_lines in - `Paragraph elements |> Loc.at (Loc.span (List.map Loc.location elements)) - -(* {2 Block elements} *) - -(* {3 Helper types} *) - -(* The interpretation of tokens in the block parser depends on where on a line - each token appears. The five possible "locations" are: - - - [`At_start_of_line], when only whitespace has been read on the current - line. - - [`After_tag], when a valid tag token, such as [@deprecated], has been read, - and only whitespace has been read since. - - [`After_shorthand_bullet], when a valid shorthand list item bullet, such as - [-], has been read, and only whitespace has been read since. - - [`After_explicit_list_bullet], when a valid explicit bullet, such as [{li], - has been read, and only whitespace has been read since. - - [`After_text], when any other valid non-whitespace token has already been - read on the current line. - - Here are some examples of how this affects the interpretation of tokens: - - - A paragraph can start anywhere except [`After_text] (two paragraphs cannot - be on the same line, but paragraphs can be nested in just about anything). - - [`Minus] is interpreted as a list item bullet [`At_start_of_line], - [`After_tag], and [`After_explicit_list_bullet]. - - Tags are only allowed [`At_start_of_line]. - - To track the location accurately, the functions that make up the block parser - pass explicit [where_in_line] values around and return them. - - In a few cases, [where_in_line] can be inferred from what helper was called. - For example, the [paragraph] parser always stops on the same line as the last - significant token that is in the paragraph it consumed, so the location must - be [`After_text]. *) -type where_in_line = - [ `At_start_of_line - | `After_tag - | `After_shorthand_bullet - | `After_explicit_list_bullet - | `After_text ] - -(* The block parsing loop, function [block_element_list], stops when it - encounters certain tokens. - - When it is called for the whole comment, or for in explicit list item - ([{li foo}]), it can only stop on end of input or a right brace. - - When it is called inside a shorthand list item ([- foo]), it stops on end of - input, right brace, a blank line (indicating end of shorthand list), plus or - minus (indicating the start of the next liste item), or a section heading or - tag, which cannot be nested in list markup. - - The block parser [block_element_list] explicitly returns the token that - stopped it, with a type more precise than [Token.t stream_head]: if it was - called for the whole comment or an explicit list item, the stop token will - have type [stops_at_delimiters stream_head], and if it was called for a - shorthand list item, the stop token will have type - [implicit_stop stream_head]. This allows the calling parsers to write precise - cases for exactly the tokens that might be at the front of the stream after - the block parser returns. *) -type stops_at_delimiters = [ `End | `Right_brace ] - -type stopped_implicitly = - [ `End - | `Blank_line of string - | `Right_brace - | `Minus - | `Plus - | Token.section_heading - | Token.tag ] - -(* Ensure that the above two types are really subsets of [Token.t]. *) -let _check_subset : stops_at_delimiters -> Token.t = fun t -> (t :> Token.t) - -let _check_subset : stopped_implicitly -> Token.t = fun t -> (t :> Token.t) - -(* The different contexts in which the block parser [block_element_list] can be - called. The block parser's behavior depends somewhat on the context. For - example, while paragraphs are allowed anywhere, shorthand lists are not - allowed immediately inside other shorthand lists, while tags are not allowed - anywhere except at the comment top level. - - Besides telling the block parser how to behave, each context also carries two - types, which determine the return type of the block parser: - - - The type of blocks the parser returns. Note that [nestable_block_element] - is included in [block_element]. However, the extra block kinds in - [block_element] are only allowed at the comment top level. - - The type of token that the block parser stops at. See discussion above. *) -type ('block, 'stops_at_which_tokens) context = - | Top_level : (Ast.block_element, stops_at_delimiters) context - | In_shorthand_list : (Ast.nestable_block_element, stopped_implicitly) context - | In_explicit_list : (Ast.nestable_block_element, stops_at_delimiters) context - | In_tag : (Ast.nestable_block_element, Token.t) context - -(* This is a no-op. It is needed to prove to the type system that nestable block - elements are acceptable block elements in all contexts. *) -let accepted_in_all_contexts : - type block stops_at_which_tokens. - (block, stops_at_which_tokens) context -> - Ast.nestable_block_element -> - block = - fun context block -> - match context with - | Top_level -> (block :> Ast.block_element) - | In_shorthand_list -> block - | In_explicit_list -> block - | In_tag -> block - -(* Converts a tag to a series of words. This is used in error recovery, when a - tag cannot be generated. *) -let tag_to_words = function - | `Author s -> [ `Word "@author"; `Space " "; `Word s ] - | `Before s -> [ `Word "@before"; `Space " "; `Word s ] - | `Canonical s -> [ `Word "@canonical"; `Space " "; `Word s ] - | `Deprecated -> [ `Word "@deprecated" ] - | `Inline -> [ `Word "@inline" ] - | `Open -> [ `Word "@open" ] - | `Closed -> [ `Word "@closed" ] - | `Param s -> [ `Word "@param"; `Space " "; `Word s ] - | `Raise s -> [ `Word "@raise"; `Space " "; `Word s ] - | `Return -> [ `Word "@return" ] - | `See (`Document, s) -> [ `Word "@see"; `Space " "; `Word ("\"" ^ s ^ "\"") ] - | `See (`File, s) -> [ `Word "@see"; `Space " "; `Word ("'" ^ s ^ "'") ] - | `See (`Url, s) -> [ `Word "@see"; `Space " "; `Word ("<" ^ s ^ ">") ] - | `Since s -> [ `Word "@since"; `Space " "; `Word s ] - | `Version s -> [ `Word "@version"; `Space " "; `Word s ] - -(* {3 Block element lists} *) - -(* Consumes tokens making up a sequence of block elements. These are: - - - paragraphs, - - code blocks, - - verbatim text blocks, - - lists, and - - section headings. *) -let rec block_element_list : - type block stops_at_which_tokens. - (block, stops_at_which_tokens) context -> - parent_markup:[< Token.t | `Comment ] -> - input -> - block with_location list - * stops_at_which_tokens with_location - * where_in_line = - fun context ~parent_markup input -> - let rec consume_block_elements : - parsed_a_tag:bool -> - where_in_line -> - block with_location list -> - block with_location list - * stops_at_which_tokens with_location - * where_in_line = - fun ~parsed_a_tag where_in_line acc -> - let describe token = - match token with - | #token_that_always_begins_an_inline_element -> "paragraph" - | _ -> Token.describe token - in - - let warn_if_after_text { Loc.location; value = token } = - if where_in_line = `After_text then - Parse_error.should_begin_on_its_own_line ~what:(describe token) location - |> add_warning input - in - - let warn_if_after_tags { Loc.location; value = token } = - if parsed_a_tag then - let suggestion = - Printf.sprintf "move %s before any tags." (Token.describe token) - in - Parse_error.not_allowed ~what:(describe token) - ~in_what:"the tags section" ~suggestion location - |> add_warning input - in - - let warn_because_not_at_top_level { Loc.location; value = token } = - let suggestion = - Printf.sprintf "move %s outside of any other markup." - (Token.print token) - in - Parse_error.not_allowed ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - ~suggestion location - |> add_warning input - in - - match peek input with - (* Terminators: the two tokens that terminate anything. *) - | ({ value = `End; _ } | { value = `Right_brace; _ }) as next_token -> ( - (* This little absurdity is needed to satisfy the type system. Without it, - OCaml is unable to prove that [stream_head] has the right type for all - possible values of [context]. *) - match context with - | Top_level -> (List.rev acc, next_token, where_in_line) - | In_shorthand_list -> (List.rev acc, next_token, where_in_line) - | In_explicit_list -> (List.rev acc, next_token, where_in_line) - | In_tag -> (List.rev acc, next_token, where_in_line)) - (* Whitespace. This can terminate some kinds of block elements. It is also - necessary to track it to interpret [`Minus] and [`Plus] correctly, as - well as to ensure that all block elements begin on their own line. *) - | { value = `Space _; _ } -> - junk input; - consume_block_elements ~parsed_a_tag where_in_line acc - | { value = `Single_newline _; _ } -> - junk input; - consume_block_elements ~parsed_a_tag `At_start_of_line acc - | { value = `Blank_line _; _ } as next_token -> ( - match context with - (* Blank lines terminate shorthand lists ([- foo]). They also terminate - paragraphs, but the paragraph parser is aware of that internally. *) - | In_shorthand_list -> (List.rev acc, next_token, where_in_line) - (* Otherwise, blank lines are pretty much like single newlines. *) - | _ -> - junk input; - consume_block_elements ~parsed_a_tag `At_start_of_line acc) - (* Explicit list items ([{li ...}] and [{- ...}]) can never appear directly - in block content. They can only appear inside [{ul ...}] and [{ol ...}]. - So, catch those. *) - | { value = `Begin_list_item _ as token; location } -> - let suggestion = - Printf.sprintf "move %s into %s, or use %s." (Token.print token) - (Token.describe (`Begin_list `Unordered)) - (Token.describe `Minus) - in - Parse_error.not_allowed ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - ~suggestion location - |> add_warning input; - - junk input; - consume_block_elements ~parsed_a_tag where_in_line acc - (* Tags. These can appear at the top level only. Also, once one tag is seen, - the only top-level elements allowed are more tags. *) - | { value = `Tag tag as token; location } as next_token -> ( - let recover_when_not_at_top_level context = - warn_because_not_at_top_level next_token; - junk input; - let words = List.map (Loc.at location) (tag_to_words tag) in - let paragraph = - `Paragraph words - |> accepted_in_all_contexts context - |> Loc.at location - in - consume_block_elements ~parsed_a_tag `At_start_of_line - (paragraph :: acc) - in - - match context with - (* Tags cannot make sense in an explicit list ([{ul {li ...}}]). *) - | In_explicit_list -> recover_when_not_at_top_level context - (* If a tag starts at the beginning of a line, it terminates the preceding - tag and/or the current shorthand list. In this case, return to the - caller, and let the caller decide how to interpret the tag token. *) - | In_shorthand_list -> - if where_in_line = `At_start_of_line then - (List.rev acc, next_token, where_in_line) - else recover_when_not_at_top_level context - | In_tag -> - if where_in_line = `At_start_of_line then - (List.rev acc, next_token, where_in_line) - else recover_when_not_at_top_level context - (* If this is the top-level call to [block_element_list], parse the - tag. *) - | Top_level -> ( - if where_in_line <> `At_start_of_line then - Parse_error.should_begin_on_its_own_line - ~what:(Token.describe token) location - |> add_warning input; - - junk input; - - match tag with - | (`Author s | `Since s | `Version s | `Canonical s) as tag -> - let s = String.trim s in - if s = "" then - Parse_error.should_not_be_empty ~what:(Token.describe token) - location - |> add_warning input; - let tag = - match tag with - | `Author _ -> `Author s - | `Since _ -> `Since s - | `Version _ -> `Version s - | `Canonical _ -> - (* TODO The location is only approximate, as we need lexer - cooperation to get the real location. *) - let r_location = - Loc.nudge_start (String.length "@canonical ") location - in - `Canonical (Loc.at r_location s) - in - - let tag = Loc.at location (`Tag tag) in - consume_block_elements ~parsed_a_tag:true `After_text - (tag :: acc) - | (`Deprecated | `Return) as tag -> - let content, _stream_head, where_in_line = - block_element_list In_tag ~parent_markup:token input - in - let tag = - match tag with - | `Deprecated -> `Deprecated content - | `Return -> `Return content - in - let location = - location :: List.map Loc.location content |> Loc.span - in - let tag = Loc.at location (`Tag tag) in - consume_block_elements ~parsed_a_tag:true where_in_line - (tag :: acc) - | (`Param _ | `Raise _ | `Before _) as tag -> - let content, _stream_head, where_in_line = - block_element_list In_tag ~parent_markup:token input - in - let tag = - match tag with - | `Param s -> `Param (s, content) - | `Raise s -> `Raise (s, content) - | `Before s -> `Before (s, content) - in - let location = - location :: List.map Loc.location content |> Loc.span - in - let tag = Loc.at location (`Tag tag) in - consume_block_elements ~parsed_a_tag:true where_in_line - (tag :: acc) - | `See (kind, target) -> - let content, _next_token, where_in_line = - block_element_list In_tag ~parent_markup:token input - in - let location = - location :: List.map Loc.location content |> Loc.span - in - let tag = `Tag (`See (kind, target, content)) in - let tag = Loc.at location tag in - consume_block_elements ~parsed_a_tag:true where_in_line - (tag :: acc) - | (`Inline | `Open | `Closed) as tag -> - let tag = Loc.at location (`Tag tag) in - consume_block_elements ~parsed_a_tag:true `After_text - (tag :: acc))) - | { value = #token_that_always_begins_an_inline_element; _ } as next_token - -> - warn_if_after_tags next_token; - warn_if_after_text next_token; - - let block = paragraph input in - let block = Loc.map (accepted_in_all_contexts context) block in - let acc = block :: acc in - consume_block_elements ~parsed_a_tag `After_text acc - | { value = (`Code_block (_, s) | `Verbatim s) as token; location } as - next_token -> - warn_if_after_tags next_token; - warn_if_after_text next_token; - if s = "" then - Parse_error.should_not_be_empty ~what:(Token.describe token) location - |> add_warning input; - - junk input; - let block = accepted_in_all_contexts context token in - let block = Loc.at location block in - let acc = block :: acc in - consume_block_elements ~parsed_a_tag `After_text acc - | { value = `Modules s as token; location } as next_token -> - warn_if_after_tags next_token; - warn_if_after_text next_token; - - junk input; - - (* TODO Use some library for a splitting function, or move this out into a - Util module. *) - let split_string delimiters s = - let rec scan_delimiters acc index = - if index >= String.length s then List.rev acc - else if String.contains delimiters s.[index] then - scan_delimiters acc (index + 1) - else scan_word acc index (index + 1) - and scan_word acc start_index index = - if index >= String.length s then - let word = String.sub s start_index (index - start_index) in - List.rev (word :: acc) - else if String.contains delimiters s.[index] then - let word = String.sub s start_index (index - start_index) in - scan_delimiters (word :: acc) (index + 1) - else scan_word acc start_index (index + 1) - in - - scan_delimiters [] 0 - in - - (* TODO Correct locations await a full implementation of {!modules} - parsing. *) - let modules = - split_string " \t\r\n" s |> List.map (fun r -> Loc.at location r) - in - - if modules = [] then - Parse_error.should_not_be_empty ~what:(Token.describe token) location - |> add_warning input; - - let block = accepted_in_all_contexts context (`Modules modules) in - let block = Loc.at location block in - let acc = block :: acc in - consume_block_elements ~parsed_a_tag `After_text acc - | { value = `Begin_list kind as token; location } as next_token -> - warn_if_after_tags next_token; - warn_if_after_text next_token; - - junk input; - - let items, brace_location = - explicit_list_items ~parent_markup:token input - in - if items = [] then - Parse_error.should_not_be_empty ~what:(Token.describe token) location - |> add_warning input; - - let location = Loc.span [ location; brace_location ] in - let block = `List (kind, `Heavy, items) in - let block = accepted_in_all_contexts context block in - let block = Loc.at location block in - let acc = block :: acc in - consume_block_elements ~parsed_a_tag `After_text acc - | { value = (`Minus | `Plus) as token; location } as next_token -> ( - (match where_in_line with - | `After_text | `After_shorthand_bullet -> - Parse_error.should_begin_on_its_own_line - ~what:(Token.describe token) location - |> add_warning input - | _ -> ()); - - warn_if_after_tags next_token; - - match context with - | In_shorthand_list -> (List.rev acc, next_token, where_in_line) - | _ -> - let items, where_in_line = - shorthand_list_items next_token where_in_line input - in - let kind = - match token with `Minus -> `Unordered | `Plus -> `Ordered - in - let location = - location :: List.map Loc.location (List.flatten items) |> Loc.span - in - let block = `List (kind, `Light, items) in - let block = accepted_in_all_contexts context block in - let block = Loc.at location block in - let acc = block :: acc in - consume_block_elements ~parsed_a_tag where_in_line acc) - | { value = `Begin_section_heading (level, label) as token; location } as - next_token -> ( - warn_if_after_tags next_token; - - let recover_when_not_at_top_level context = - warn_because_not_at_top_level next_token; - junk input; - let content, brace_location = - delimited_inline_element_list ~parent_markup:token - ~parent_markup_location:location ~requires_leading_whitespace:true - input - in - let location = Loc.span [ location; brace_location ] in - let paragraph = - `Paragraph content - |> accepted_in_all_contexts context - |> Loc.at location - in - consume_block_elements ~parsed_a_tag `At_start_of_line - (paragraph :: acc) - in - - match context with - | In_shorthand_list -> - if where_in_line = `At_start_of_line then - (List.rev acc, next_token, where_in_line) - else recover_when_not_at_top_level context - | In_explicit_list -> recover_when_not_at_top_level context - | In_tag -> recover_when_not_at_top_level context - | Top_level -> - if where_in_line <> `At_start_of_line then - Parse_error.should_begin_on_its_own_line - ~what:(Token.describe token) location - |> add_warning input; - - let label = - match label with - | Some "" -> - Parse_error.should_not_be_empty ~what:"heading label" location - |> add_warning input; - None - | _ -> label - in - - junk input; - - let content, brace_location = - delimited_inline_element_list ~parent_markup:token - ~parent_markup_location:location - ~requires_leading_whitespace:true input - in - if content = [] then - Parse_error.should_not_be_empty ~what:(Token.describe token) - location - |> add_warning input; - - let location = Loc.span [ location; brace_location ] in - let heading = `Heading (level, label, content) in - let heading = Loc.at location heading in - let acc = heading :: acc in - consume_block_elements ~parsed_a_tag `After_text acc) - | { value = `Begin_paragraph_style _ as token; location } -> - junk input; - let content, brace_location = - delimited_inline_element_list ~parent_markup:token - ~parent_markup_location:location ~requires_leading_whitespace:true - input - in - let location = Loc.span [ location; brace_location ] in - - Parse_error.markup_should_not_be_used ~what:(Token.describe token) - location - |> add_warning input; - - let paragraph = - `Paragraph content - |> accepted_in_all_contexts context - |> Loc.at location - in - consume_block_elements ~parsed_a_tag `At_start_of_line - (paragraph :: acc) - in - - let where_in_line = - match context with - | Top_level -> `At_start_of_line - | In_shorthand_list -> `After_shorthand_bullet - | In_explicit_list -> `After_explicit_list_bullet - | In_tag -> `After_tag - in - - consume_block_elements ~parsed_a_tag:false where_in_line [] - -(* {3 Lists} *) - -(* Consumes a sequence of implicit list items. Each one consists of a [`Minus] - or [`Plus] token, followed by block elements until: - - - a blank line, or - - a list bullet of the opposite kind (e.g. [`Plus] for a [`Minus] list). - - This function is called when the next token is known to be [`Minus] or - [`Plus]. It consumes that token, and calls the block element parser (see - above). That parser returns to [implicit_list_items] only on [`Blank_line], - [`End], [`Minus] or [`Plus] at the start of a line, or [`Right_brace]. *) -and shorthand_list_items : - [ `Minus | `Plus ] with_location -> - where_in_line -> - input -> - Ast.nestable_block_element with_location list list * where_in_line = - fun first_token where_in_line input -> - let bullet_token = first_token.value in - - let rec consume_list_items : - [> ] with_location -> - where_in_line -> - Ast.nestable_block_element with_location list list -> - Ast.nestable_block_element with_location list list * where_in_line = - fun next_token where_in_line acc -> - match next_token.value with - | `End | `Right_brace | `Blank_line _ | `Tag _ | `Begin_section_heading _ -> - (List.rev acc, where_in_line) - | (`Minus | `Plus) as bullet -> - if bullet = bullet_token then ( - junk input; - - let content, stream_head, where_in_line = - block_element_list In_shorthand_list ~parent_markup:bullet input - in - if content = [] then - Parse_error.should_not_be_empty ~what:(Token.describe bullet) - next_token.location - |> add_warning input; - - let acc = content :: acc in - consume_list_items stream_head where_in_line acc) - else (List.rev acc, where_in_line) - in - - consume_list_items - (first_token :> stopped_implicitly with_location) - where_in_line [] - -(* Consumes a sequence of explicit list items (starting with '{li ...}' and - '{-...}', which are represented by [`Begin_list_item _] tokens). - - This function is called immediately after '{ul' or '{ol' ([`Begin_list _]) is - read. The only "valid" way to exit is by reading a [`Right_brace] token, - which is consumed. - - Whitespace inside the list, but outside list items, is not significant – this - parsing function consumes all of it. Otherwise, only list item start tokens - are accepted. Everything else is an error. *) -and explicit_list_items : - parent_markup:[< Token.t ] -> - input -> - Ast.nestable_block_element with_location list list * Loc.span = - fun ~parent_markup input -> - let rec consume_list_items : - Ast.nestable_block_element with_location list list -> - Ast.nestable_block_element with_location list list * Loc.span = - fun acc -> - let next_token = peek input in - match next_token.value with - | `End -> - Parse_error.not_allowed next_token.location - ~what:(Token.describe `End) - ~in_what:(Token.describe parent_markup) - |> add_warning input; - (List.rev acc, next_token.location) - | `Right_brace -> - junk input; - (List.rev acc, next_token.location) - | `Space _ | `Single_newline _ | `Blank_line _ -> - junk input; - consume_list_items acc - | `Begin_list_item kind as token -> - junk input; - - (* '{li', represented by [`Begin_list_item `Li], must be followed by - whitespace. *) - (if kind = `Li then - match (peek input).value with - | `Space _ | `Single_newline _ | `Blank_line _ | `Right_brace -> - () - (* The presence of [`Right_brace] above requires some explanation: - - - It is better to be silent about missing whitespace if the next - token is [`Right_brace], because the error about an empty list - item will be generated below, and that error is more important to - the user. - - The [`Right_brace] token also happens to include all whitespace - before it, as a convenience for the rest of the parser. As a - result, not ignoring it could be wrong: there could in fact be - whitespace in the concrete syntax immediately after '{li', just - it is not represented as [`Space], [`Single_newline], or - [`Blank_line]. *) - | _ -> - Parse_error.should_be_followed_by_whitespace next_token.location - ~what:(Token.print token) - |> add_warning input); - - let content, token_after_list_item, _where_in_line = - block_element_list In_explicit_list ~parent_markup:token input - in - - if content = [] then - Parse_error.should_not_be_empty next_token.location - ~what:(Token.describe token) - |> add_warning input; - - (match token_after_list_item.value with - | `Right_brace -> junk input - | `End -> - Parse_error.not_allowed token_after_list_item.location - ~what:(Token.describe `End) - ~in_what:(Token.describe token) - |> add_warning input); - - let acc = content :: acc in - consume_list_items acc - | token -> - let suggestion = - match token with - | `Begin_section_heading _ | `Tag _ -> - Printf.sprintf "move %s outside the list." (Token.describe token) - | _ -> - Printf.sprintf "move %s into a list item, %s or %s." - (Token.describe token) - (Token.print (`Begin_list_item `Li)) - (Token.print (`Begin_list_item `Dash)) - in - Parse_error.not_allowed next_token.location ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - ~suggestion - |> add_warning input; - - junk input; - consume_list_items acc - in - - consume_list_items [] - -(* {2 Entry point} *) - -type output = { ast : Ast.t; warnings : Warning.t list } - -let parse warnings tokens = - let input : input = { tokens; warnings } in - - let rec parse_block_elements () = - let elements, last_token, _where_in_line = - block_element_list Top_level ~parent_markup:`Comment input - in - - match last_token.value with - | `End -> elements - | `Right_brace -> - Parse_error.unpaired_right_brace last_token.location - |> add_warning input; - - let block = - Loc.same last_token (`Paragraph [ Loc.same last_token (`Word "}") ]) - in - - junk input; - elements @ block :: parse_block_elements () - in - let ast = parse_block_elements () in - { ast; warnings = List.rev !(input.warnings) } diff --git a/src/parser/syntax.mli b/src/parser/syntax.mli deleted file mode 100644 index 64ab92ad02..0000000000 --- a/src/parser/syntax.mli +++ /dev/null @@ -1,5 +0,0 @@ -(* Internal module, not exposed *) - -type output = { ast : Ast.t; warnings : Warning.t list } - -val parse : Warning.t list ref -> Token.t Loc.with_location Stream.t -> output diff --git a/src/parser/test/dune b/src/parser/test/dune deleted file mode 100644 index 7a46d5acd1..0000000000 --- a/src/parser/test/dune +++ /dev/null @@ -1,8 +0,0 @@ -(library - (name odoc_parser_test) - (inline_tests) - (enabled_if - (>= %{ocaml_version} 4.04.1)) - (preprocess - (pps ppx_expect)) - (libraries sexplib0 odoc-parser)) diff --git a/src/parser/test/test.ml b/src/parser/test/test.ml deleted file mode 100644 index d139e0267d..0000000000 --- a/src/parser/test/test.ml +++ /dev/null @@ -1,4992 +0,0 @@ -open Odoc_parser - -type sexp = Sexplib0.Sexp.t = Atom of string | List of sexp list - -module Location_to_sexp = struct - let point : Loc.point -> sexp = - fun { line; column } -> - List [ Atom (string_of_int line); Atom (string_of_int column) ] - - let span : Loc.span -> sexp = - fun { file; start; end_ } -> List [ Atom file; point start; point end_ ] - - let at : ('a -> sexp) -> 'a Loc.with_location -> sexp = - fun f { location; value } -> List [ span location; f value ] -end - -module Ast_to_sexp = struct - let at = Location_to_sexp.at - - let str s = Atom s - - let opt f s = match s with Some s -> List [ f s ] | None -> List [] - - let style : Ast.style -> sexp = function - | `Bold -> Atom "bold" - | `Italic -> Atom "italic" - | `Emphasis -> Atom "emphasis" - | `Superscript -> Atom "superscript" - | `Subscript -> Atom "subscript" - - let reference_kind : Ast.reference_kind -> sexp = function - | `Simple -> Atom "simple" - | `With_text -> Atom "with_text" - - let rec inline_element : Ast.inline_element -> sexp = function - | `Space _ -> Atom "space" - | `Word w -> List [ Atom "word"; Atom w ] - | `Code_span c -> List [ Atom "code_span"; Atom c ] - | `Raw_markup (target, s) -> - List [ Atom "raw_markup"; opt str target; Atom s ] - | `Styled (s, es) -> - List [ style s; List (List.map (at inline_element) es) ] - | `Reference (kind, r, es) -> - List - [ - reference_kind kind; - at str r; - List (List.map (at inline_element) es); - ] - | `Link (u, es) -> List [ str u; List (List.map (at inline_element) es) ] - - let rec nestable_block_element : Ast.nestable_block_element -> sexp = function - | `Paragraph es -> - List [ Atom "paragraph"; List (List.map (at inline_element) es) ] - | `Code_block (None, c) -> List [ Atom "code_block"; Atom c ] - | `Code_block (Some m, c) -> List [ Atom "code_block"; Atom m; Atom c ] - | `Verbatim t -> List [ Atom "verbatim"; Atom t ] - | `Modules ps -> List [ Atom "modules"; List (List.map (at str) ps) ] - | `List (kind, weight, items) -> - let kind = - match kind with `Unordered -> "unordered" | `Ordered -> "ordered" - in - let weight = - match weight with `Light -> "light" | `Heavy -> "heavy" - in - let items = - items - |> List.map (fun item -> - List (List.map (at nestable_block_element) item)) - |> fun items -> List items - in - List [ Atom kind; Atom weight; items ] - - let tag : Ast.tag -> sexp = function - | `Author s -> List [ Atom "@author"; Atom s ] - | `Deprecated es -> - List (Atom "@deprecated" :: List.map (at nestable_block_element) es) - | `Param (s, es) -> - List - ([ Atom "@param"; Atom s ] @ List.map (at nestable_block_element) es) - | `Raise (s, es) -> - List - ([ Atom "@raise"; Atom s ] @ List.map (at nestable_block_element) es) - | `Return es -> - List (Atom "@return" :: List.map (at nestable_block_element) es) - | `See (kind, s, es) -> - let kind = - match kind with - | `Url -> "url" - | `File -> "file" - | `Document -> "document" - in - List - ([ Atom "@see"; Atom kind; Atom s ] - @ List.map (at nestable_block_element) es) - | `Since s -> List [ Atom "@since"; Atom s ] - | `Before (s, es) -> - List - ([ Atom "@before"; Atom s ] @ List.map (at nestable_block_element) es) - | `Version s -> List [ Atom "@version"; Atom s ] - | `Canonical p -> List [ Atom "@canonical"; at str p ] - | `Inline -> Atom "@inline" - | `Open -> Atom "@open" - | `Closed -> Atom "@closed" - - let block_element : Ast.block_element -> sexp = function - | #Ast.nestable_block_element as e -> nestable_block_element e - | `Heading (level, label, es) -> - let label = List [ Atom "label"; opt str label ] in - let level = string_of_int level in - List [ Atom level; label; List (List.map (at inline_element) es) ] - | `Tag t -> tag t - - let docs : Ast.t -> sexp = fun f -> List (List.map (at block_element) f) -end - -let error err = Atom (Odoc_parser.Warning.to_string err) - -let parser_output formatter { Odoc_parser.ast; warnings } = - let value = Ast_to_sexp.docs ast in - let warnings = List (List.map error warnings) in - let output = - List [ List [ Atom "output"; value ]; List [ Atom "warnings"; warnings ] ] - in - Sexplib0.Sexp.pp_hum formatter output; - Format.pp_print_flush formatter () - -let test ?(location = { Loc.line = 1; column = 0 }) str = - let dummy_filename = "f.ml" in - let location = - { - Lexing.pos_fname = dummy_filename; - pos_lnum = location.line; - pos_bol = 0; - pos_cnum = location.column; - } - in - let ast = Odoc_parser.parse_comment ~location ~text:str in - Format.printf "%a" parser_output ast - -[@@@ocaml.warning "-32"] - -let%expect_test _ = - let module Trivial = struct - let empty = - test ""; - [%expect "((output ()) (warnings ()))"] - - let space = - test " "; - [%expect "((output ()) (warnings ()))"] - - let two_spaces = - test " "; - [%expect "((output ()) (warnings ()))"] - - let tab = - test "\t"; - [%expect "((output ()) (warnings ()))"] - - let mixed_space = - test " \t \t"; - [%expect "((output ()) (warnings ()))"] - - let newline = - test "\n"; - [%expect "((output ()) (warnings ()))"] - - let blank_line = - test "\n\n"; - [%expect "((output ()) (warnings ()))"] - - let cf_lf = - test "\r\n"; - [%expect "((output ()) (warnings ()))"] - end in - () - -let%expect_test _ = - let module One_paragraph = struct - let word = - test "foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))))) - (warnings ())) |}] - - let two_words = - test "foo bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 7)) (word bar))))))) - (warnings ())) |}] - - let two_words = - test "foo bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 7)) (word bar))))))) - (warnings ())) |}] - - let two_spaces = - test "foo bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 5)) space) - ((f.ml (1 5) (1 8)) (word bar))))))) - (warnings ())) |}] - - let mixed_space = - test "foo \t \t bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 8)) space) - ((f.ml (1 8) (1 11)) (word bar))))))) - (warnings ())) |}] - - let two_lines = - test "foo\n"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))))) - (warnings ())) |}] - - let two_lines_cr_lf = - test "foo\r\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar))))))) - (warnings ())) |}] - - let leading_space = - test " foo"; - [%expect - {| - ((output - (((f.ml (1 1) (1 4)) (paragraph (((f.ml (1 1) (1 4)) (word foo))))))) - (warnings ())) |}] - - let trailing_space = - test "foo "; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))))) - (warnings ())) |}] - - let leading_space_on_line = - test "foo\n bar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (2 1)) space) - ((f.ml (2 1) (2 4)) (word bar))))))) - (warnings ())) |}] - - let trailing_space_on_line = - test "foo \nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar))))))) - (warnings ())) |}] - - let leading_tab_on_line = - test "foo\n\tbar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (2 1)) space) - ((f.ml (2 1) (2 4)) (word bar))))))) - (warnings ())) |}] - - let trailing_tab_on_line = - test "foo\t\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar))))))) - (warnings ())) |}] - - let email = - test "foo@bar.com"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph (((f.ml (1 0) (1 11)) (word foo@bar.com))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Two_paragraphs = struct - let basic = - test "foo\n\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))) - (warnings ())) |}] - - let leading_space = - test "foo \n\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))) - (warnings ())) |}] - - let trailing_space = - test "foo\n\n bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (3 1) (3 4)) (paragraph (((f.ml (3 1) (3 4)) (word bar))))))) - (warnings ())) |}] - - let cr_lf = - test "foo\r\n\r\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))) - (warnings ())) |}] - - let mixed_cr_lf = - test "foo\n\r\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Plus_minus_words = struct - let minus_in_word = - test "foo-bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 0) (1 7)) (word foo-bar))))))) - (warnings ())) |}] - - let minus_as_word = - test "foo -"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 5)) (word -))))))) - (warnings ())) |}] - - let plus_in_word = - test "foo+bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 0) (1 7)) (word foo+bar))))))) - (warnings ())) |}] - - let plus_as_word = - test "foo +"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 5)) (word +))))))) - (warnings ())) |}] - - let negative_number = - test "-3.14 -1337"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 5)) (word -3.14)) ((f.ml (1 5) (1 6)) space) - ((f.ml (1 6) (1 11)) (word -1337))))))) - (warnings ())) |}] - - let n_em_dash = - test "-- ---"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 2)) (word --)) ((f.ml (1 2) (1 3)) space) - ((f.ml (1 3) (1 6)) (word ---))))))) - (warnings ())) |}] - - let minus_at = - test "-@"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word -@))))))) - (warnings ())) |}] - - let at_minus = - test "-@-"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word -@-))))))) - (warnings ())) |}] - - let option = - test "--option"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word --option))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Escape_sequence = struct - let left_brace = - test "\\{"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word {))))))) - (warnings ())) |}] - - let left_brace_in_word = - test "foo\\{bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word foo{bar))))))) - (warnings ())) |}] - - let right_brace = - test "\\}"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word }))))))) - (warnings ())) |}] - - let right_brace_in_word = - test "foo\\{bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word foo{bar))))))) - (warnings ())) |}] - - let left_bracket = - test "\\["; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word [))))))) - (warnings ())) |}] - - let left_bracket_in_word = - test "foo\\[bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word foo[bar))))))) - (warnings ())) |}] - - let right_bracket = - test "\\]"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word ]))))))) - (warnings ())) |}] - - let right_bracket_in_word = - test "foo\\]bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word foo]bar))))))) - (warnings ())) |}] - - let at = - test "@"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word @))))))) - (warnings ( "File \"f.ml\", line 1, characters 0-1:\ - \nStray '@'."))) |}] - - let not_a_tag = - test "\\@author"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word @author))))))) - (warnings ())) |}] - - let at_in_word = - test "foo\\@bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word foo@bar))))))) - (warnings ())) |}] - - let trailing_backslash = - test "foo\\"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (word "foo\\"))))))) - (warnings ())) |}] - - let none_escape = - test "foo\\bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 0) (1 7)) (word "foo\\bar"))))))) - (warnings ())) |}] - - let backslash_not_escaped = - test "foo\\\\{bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (paragraph (((f.ml (1 0) (1 9)) (word "foo\\{bar"))))))) - (warnings ())) |}] - - let single_backslash = - test "\\"; - [%expect - {| - ((output - (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word "\\"))))))) - (warnings ())) |}] - - let escape_minus = - test "\\{- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 3)) (word {-)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 7)) (word foo))))))) - (warnings ())) |}] - - let escape_plus = - test "\\{+ foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 3)) (word {+)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 7)) (word foo))))))) - (warnings ())) |}] - - let minus_escape = - test "-\\{"; - [%expect - {| - ((output (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word -{))))))) - (warnings ())) |}] - - let plus_escape = - test "+\\{"; - [%expect - {| - ((output (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word +{))))))) - (warnings ())) |}] - - let escape_at = - test "\\{@author"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (paragraph (((f.ml (1 0) (1 9)) (word {@author))))))) - (warnings ())) |}] - - let two = - test "\\{\\}"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (word {}))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Code_span = struct - let basic = - test "[foo]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) (paragraph (((f.ml (1 0) (1 5)) (code_span foo))))))) - (warnings ())) |}] - - let empty = - test "[]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (code_span ""))))))) - (warnings ())) |}] - - let list = - test "[[]]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (code_span []))))))) - (warnings ())) |}] - (* TODO The next two error messages are particularly unintuitive. *) - - let unbalanced_list = - test "[[]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (code_span []))))))) - (warnings - ( "File \"f.ml\", line 1, characters 3-3:\ - \nEnd of text is not allowed in '[...]' (code)."))) |}] - - let no_markup = - test "[{b"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (code_span {b))))))) - (warnings - ( "File \"f.ml\", line 1, characters 3-3:\ - \nEnd of text is not allowed in '[...]' (code)."))) |}] - - let few_escapes = - test "[\\{]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (code_span "\\{"))))))) - (warnings ())) |}] - - let escaped_right_bracket = - test "[\\]]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (code_span ]))))))) - (warnings ())) |}] - - let escaped_left_bracket = - test "[\\[]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (code_span [))))))) - (warnings ())) |}] - - let whitespace_preserved = - test "[ foo bar ]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph (((f.ml (1 0) (1 11)) (code_span " foo bar "))))))) - (warnings ())) |}] - - let no_new_lines = - test "[foo\nbar]"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph (((f.ml (1 0) (2 4)) (code_span "foo\ - \nbar"))))))) - (warnings ())) |}] - - let cr_lf_preserved = - test "[foo\r\nbar]"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph (((f.ml (1 0) (2 4)) (code_span "foo\r\ - \nbar"))))))) - (warnings ())) |}] - - let no_double_new_line = - test "[foo\r\n\r\nbar]"; - [%expect - {| - ((output - (((f.ml (1 0) (3 4)) - (paragraph (((f.ml (1 0) (3 4)) (code_span "foo\ - \nbar"))))))) - (warnings - ( "File \"f.ml\", line 1, character 4 to line 3, character 0:\ - \nBlank line is not allowed in '[...]' (code)."))) |}] - - let no_double_crlf = - test "[foo\r\n\r\nbar]"; - [%expect - {| - ((output - (((f.ml (1 0) (3 4)) - (paragraph (((f.ml (1 0) (3 4)) (code_span "foo\ - \nbar"))))))) - (warnings - ( "File \"f.ml\", line 1, character 4 to line 3, character 0:\ - \nBlank line is not allowed in '[...]' (code)."))) |}] - - let not_merged = - test "[foo][bar]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 5)) (code_span foo)) - ((f.ml (1 5) (1 10)) (code_span bar))))))) - (warnings ())) |}] - - let explicit_space = - test "[foo] [bar]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 5)) (code_span foo)) ((f.ml (1 5) (1 6)) space) - ((f.ml (1 6) (1 11)) (code_span bar))))))) - (warnings ())) |}] - - let untermindated = - test "[foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (code_span foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-4:\ - \nEnd of text is not allowed in '[...]' (code)."))) |}] - end in - () - -let%expect_test _ = - let module Bold = struct - let basic = - test "{b foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (bold (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let extra_leading_whitespace = - test "{b \t foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (bold (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline = - test "{b\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (bold (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_cr_lf = - test "{b\r\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (bold (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline_and_whitespace = - test "{b\n foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (paragraph - (((f.ml (1 0) (2 5)) (bold (((f.ml (2 1) (2 4)) (word foo)))))))))) - (warnings ())) |}] - - let no_leading_whitespace = - test "{bfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (bold (((f.ml (1 2) (1 5)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-2:\ - \n'{b' should be followed by space, a tab, or a new line."))) |}] - - let trailing_whitespace = - test "{b foo }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (bold (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let trailing_newline = - test "{b foo\n}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 1)) - (paragraph - (((f.ml (1 0) (2 1)) (bold (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let trailing_cr_lf = - test "{b foo\r\n}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 1)) - (paragraph - (((f.ml (1 0) (2 1)) (bold (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let two_words = - test "{b foo bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (1 6) (1 7)) space) - ((f.ml (1 7) (1 10)) (word bar)))))))))) - (warnings ())) |}] - - let not_merged = - test "{b foo}{b bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (paragraph - (((f.ml (1 0) (1 7)) (bold (((f.ml (1 3) (1 6)) (word foo))))) - ((f.ml (1 7) (1 14)) (bold (((f.ml (1 10) (1 13)) (word bar)))))))))) - (warnings ())) |}] - - let nested = - test "{b foo{b bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (paragraph - (((f.ml (1 0) (1 14)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) - ((f.ml (1 6) (1 13)) (bold (((f.ml (1 9) (1 12)) (word bar))))))))))))) - (warnings ())) |}] - - let newline = - test "{b foo\nbar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (1 6) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar)))))))))) - (warnings ())) |}] - - let cr_lf = - test "{b foo\r\nbar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (1 6) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar)))))))))) - (warnings ())) |}] - - let minus = - test "{b -}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph (((f.ml (1 0) (1 5)) (bold (((f.ml (1 3) (1 4)) (word -)))))))))) - (warnings ())) |}] - - let minus_list_item = - test "{b foo\n - bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 7)) - (paragraph - (((f.ml (1 0) (2 7)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (1 6) (2 1)) space) - ((f.ml (2 1) (2 2)) (word -)) ((f.ml (2 2) (2 3)) space) - ((f.ml (2 3) (2 6)) (word bar)))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 1-2:\ - \n'-' (bulleted list item) is not allowed in '{b ...}' (boldface text).\ - \nSuggestion: move '-' so it isn't the first thing on the line."))) |}] - - let plus_list_item = - test "{b foo\n + bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 7)) - (paragraph - (((f.ml (1 0) (2 7)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (1 6) (2 1)) space) - ((f.ml (2 1) (2 2)) (word +)) ((f.ml (2 2) (2 3)) space) - ((f.ml (2 3) (2 6)) (word bar)))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 1-2:\ - \n'+' (numbered list item) is not allowed in '{b ...}' (boldface text).\ - \nSuggestion: move '+' so it isn't the first thing on the line."))) |}] - - let immediate_minus_list_item = - test "{b\n- foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 6)) - (paragraph - (((f.ml (1 0) (2 6)) - (bold - (((f.ml (2 0) (2 1)) (word -)) ((f.ml (2 1) (2 2)) space) - ((f.ml (2 2) (2 5)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-1:\ - \n'-' (bulleted list item) is not allowed in '{b ...}' (boldface text).\ - \nSuggestion: move '-' so it isn't the first thing on the line."))) |}] - - let immediate_plus_list_item = - test "{b\n+ foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 6)) - (paragraph - (((f.ml (1 0) (2 6)) - (bold - (((f.ml (2 0) (2 1)) (word +)) ((f.ml (2 1) (2 2)) space) - ((f.ml (2 2) (2 5)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-1:\ - \n'+' (numbered list item) is not allowed in '{b ...}' (boldface text).\ - \nSuggestion: move '+' so it isn't the first thing on the line."))) |}] - - let blank_line = - test "{b foo\n\nbar}"; - [%expect - {| - ((output - (((f.ml (1 0) (3 4)) - (paragraph - (((f.ml (1 0) (3 4)) - (bold - (((f.ml (1 3) (1 6)) (word foo)) ((f.ml (2 0) (2 0)) space) - ((f.ml (3 0) (3 3)) (word bar)))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-0:\ - \nBlank line is not allowed in '{b ...}' (boldface text)."))) |}] - - let immediate_blank_line = - test "{b"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (bold ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-2:\ - \n'{b' should be followed by space, a tab, or a new line." - "File \"f.ml\", line 1, characters 2-2:\ - \nEnd of text is not allowed in '{b ...}' (boldface text)." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{b ...}' (boldface text) should not be empty."))) |}] - - let end_of_comment = - test "{b foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (bold (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{b ...}' (boldface text)."))) |}] - - let nested_code_block = - test "{b {[foo]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (bold ()))))) - ((f.ml (1 3) (1 10)) (code_block foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 3-10:\ - \n'{[...]}' (code block) 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-10:\ - \n'{[...]}' (code block) should begin on its own line."))) |}] - - let degenerate = - test "{b}"; - [%expect - {| - ((output (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (bold ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-3:\ - \n'{b ...}' (boldface text) should not be empty."))) |}] - - let empty = - test "{b }"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (bold ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'{b ...}' (boldface text) should not be empty."))) |}] - end in - () - -let%expect_test _ = - let module Italic = struct - let basic = - test "{i foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (italic (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let extra_leading_whitespace = - test "{i \t foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (italic (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline = - test "{i\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (italic (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline_and_whitespace = - test "{i\n foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (paragraph - (((f.ml (1 0) (2 5)) (italic (((f.ml (2 1) (2 4)) (word foo)))))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Emphasis = struct - let basic = - test "{e foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (emphasis (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let extra_leading_whitespace = - test "{e \t foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (emphasis (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline = - test "{e\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (emphasis (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline_and_whitespace = - test "{e\n foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (paragraph - (((f.ml (1 0) (2 5)) (emphasis (((f.ml (2 1) (2 4)) (word foo)))))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Superscript = struct - let basic = - test "{^ foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (superscript (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let extra_leading_whitespace = - test "{^ \t foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (superscript (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline = - test "{^\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (superscript (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_cr_lf = - test "{^\r\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (superscript (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline_and_whitespace = - test "{^\n foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (paragraph - (((f.ml (1 0) (2 5)) (superscript (((f.ml (2 1) (2 4)) (word foo)))))))))) - (warnings ())) |}] - - let no_whitespace = - test "{^foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (superscript (((f.ml (1 2) (1 5)) (word foo)))))))))) - (warnings ())) |}] - - let degenerate = - test "{^}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (superscript ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-3:\ - \n'{^...}' (superscript) should not be empty."))) |}] - - let empty = - test "{^ }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (superscript ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'{^...}' (superscript) should not be empty."))) |}] - end in - () - -let%expect_test _ = - let module Subscript = struct - let basic = - test "{_ foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (subscript (((f.ml (1 3) (1 6)) (word foo)))))))))) - (warnings ())) |}] - - let extra_leading_whitespace = - test "{_ \t foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (subscript (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline = - test "{_\nfoo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (paragraph - (((f.ml (1 0) (2 4)) (subscript (((f.ml (2 0) (2 3)) (word foo)))))))))) - (warnings ())) |}] - - let leading_newline_and_whitespace = - test "{_\n foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (paragraph - (((f.ml (1 0) (2 5)) (subscript (((f.ml (2 1) (2 4)) (word foo)))))))))) - (warnings ())) |}] - - let no_whitespace = - test "{_foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (subscript (((f.ml (1 2) (1 5)) (word foo)))))))))) - (warnings ())) |}] - - let v_verbose = - test "{_uv}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 5)) (subscript (((f.ml (1 2) (1 4)) (word uv)))))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Simple_reference = struct - let basic = - test "{!foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph (((f.ml (1 0) (1 6)) (simple ((f.ml (1 2) (1 6)) foo) ()))))))) - (warnings ())) |}] - - let leading_whitespace = - test "{! foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (simple ((f.ml (1 2) (1 7)) " foo") ()))))))) - (warnings ())) |}] - - let trailing_whitespace = - test "{!foo }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (simple ((f.ml (1 2) (1 7)) "foo ") ()))))))) - (warnings ())) |}] - - let adjacent_word_leading = - test "bar{!foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 3)) (word bar)) - ((f.ml (1 3) (1 9)) (simple ((f.ml (1 5) (1 9)) foo) ()))))))) - (warnings ())) |}] - - let explicit_leading_space = - test "bar {!foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 3)) (word bar)) ((f.ml (1 3) (1 4)) space) - ((f.ml (1 4) (1 10)) (simple ((f.ml (1 6) (1 10)) foo) ()))))))) - (warnings ())) |}] - - let adjacent_word_trailing = - test "{!foo}bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 6)) (simple ((f.ml (1 2) (1 6)) foo) ())) - ((f.ml (1 6) (1 9)) (word bar))))))) - (warnings ())) |}] - - let explicit_trailing_space = - test "{!foo} bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 6)) (simple ((f.ml (1 2) (1 6)) foo) ())) - ((f.ml (1 6) (1 7)) space) ((f.ml (1 7) (1 10)) (word bar))))))) - (warnings ())) |}] - - let kind = - test "{!val:foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) (simple ((f.ml (1 2) (1 10)) val:foo) ()))))))) - (warnings ())) |}] - - let empty = - test "{!}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) - (paragraph (((f.ml (1 0) (1 3)) (simple ((f.ml (1 2) (1 3)) "") ()))))))) - (warnings ())) |}] - - let whitespace_only = - test "{! }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 4)) (simple ((f.ml (1 2) (1 4)) " ") ()))))))) - (warnings ())) |}] - - let internal_whitespace = - test "{!( * )}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) "( * )") ()))))))) - (warnings ())) |}] - - (* TODO Limiting the character combinations allowed will make it easier to - catch expressions accidentally written inside references. This can also - be caught by a good resolver and resolver error messages. *) - (* t "expression" *) - let unterminated = - test "{!foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph (((f.ml (1 0) (1 5)) (simple ((f.ml (1 2) (1 5)) foo) ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 5-5:\ - \nEnd of text is not allowed in '{!...}' (cross-reference)."))) |}] - - let empty_kind = - test "{!:foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph (((f.ml (1 0) (1 7)) (simple ((f.ml (1 2) (1 7)) :foo) ()))))))) - (warnings ())) |}] - - let whitespace_kind = - test "{! :foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) " :foo") ()))))))) - (warnings ())) |}] - - let with_kind_but_empty = - test "{!val:}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph (((f.ml (1 0) (1 7)) (simple ((f.ml (1 2) (1 7)) val:) ()))))))) - (warnings ())) |}] - - let with_kind_but_whitespace = - test "{!val: }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) "val: ") ()))))))) - (warnings ())) |}] - - let leading_whitespace_in_kind = - test "{! val:foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) (simple ((f.ml (1 2) (1 11)) " val:foo") ()))))))) - (warnings ())) |}] - - let internal_whitespace_in_kind = - test "{!va l:foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) (simple ((f.ml (1 2) (1 11)) "va l:foo") ()))))))) - (warnings ())) |}] - - let internal_whitespace_in_referent = - test "{!val:( * )}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 12)) - (paragraph - (((f.ml (1 0) (1 12)) (simple ((f.ml (1 2) (1 12)) "val:( * )") ()))))))) - (warnings ())) |}] - - let two_colons = - test "{!val:foo:bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (paragraph - (((f.ml (1 0) (1 14)) (simple ((f.ml (1 2) (1 14)) val:foo:bar) ()))))))) - (warnings ())) |}] - - let space_before_colon = - test "{!val :foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) (simple ((f.ml (1 2) (1 11)) "val :foo") ()))))))) - (warnings ())) |}] - - let space_after_colon = - test "{!val: foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) (simple ((f.ml (1 2) (1 11)) "val: foo") ()))))))) - (warnings ())) |}] - - let unterminated_after_kind = - test "{!val:foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 9)) (simple ((f.ml (1 2) (1 9)) val:foo) ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 9-9:\ - \nEnd of text is not allowed in '{!...}' (cross-reference)."))) |}] - - let operator = - test "{!(>>=)}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) "(>>=)") ()))))))) - (warnings ())) |}] - - let operator_with_dash = - test "{!(@->)}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) "(@->)") ()))))))) - (warnings ())) |}] - - let operator_with_dot = - test "{!(*.)}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph - (((f.ml (1 0) (1 7)) (simple ((f.ml (1 2) (1 7)) "(*.)") ()))))))) - (warnings ())) |}] - - let operator_with_colon = - test "{!(>::)}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (simple ((f.ml (1 2) (1 8)) "(>::)") ()))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Reference_with_text = struct - let basic = - test "{{!foo} bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 12)) - (paragraph - (((f.ml (1 0) (1 12)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 11)) (word bar)))))))))) - (warnings ())) |}] - - let degenerate = - test "{{!foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 8)) (with_text ((f.ml (1 3) (1 7)) foo) ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-8:\ - \n'{{!...} ...}' (cross-reference) should not be empty."))) |}] - - let empty = - test "{{!foo} }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 9)) (with_text ((f.ml (1 3) (1 7)) foo) ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-9:\ - \n'{{!...} ...}' (cross-reference) should not be empty."))) |}] - - let nested_markup = - test "{{!foo} {b bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 15)) (bold (((f.ml (1 11) (1 14)) (word bar))))))))))))) - (warnings ())) |}] - - let in_markup = - test "{e {{!foo} bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) - (emphasis - (((f.ml (1 3) (1 15)) - (with_text ((f.ml (1 6) (1 10)) foo) - (((f.ml (1 11) (1 14)) (word bar))))))))))))) - (warnings ())) |}] - - let no_separating_space = - test "{{!foo}bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 7) (1 10)) (word bar)))))))))) - (warnings ())) |}] - - let kind = - test "{{!val:foo} bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) - (with_text ((f.ml (1 3) (1 11)) val:foo) - (((f.ml (1 12) (1 15)) (word bar)))))))))) - (warnings ())) |}] - - let nested_reference = - test "{{!foo} {!bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 15)) - (paragraph - (((f.ml (1 0) (1 15)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 14)) (simple ((f.ml (1 10) (1 14)) bar) ())))))))))) - (warnings ())) |}] - - let nested_empty = - test "{{!foo} {{!bar}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 17)) - (paragraph - (((f.ml (1 0) (1 17)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 16)) (with_text ((f.ml (1 11) (1 15)) bar) ())))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-16:\ - \n'{{!...} ...}' (cross-reference) should not be empty."))) |}] - - let nested_through_emphasis = - test "{{!foo} {e {{!bar} baz}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 25)) - (paragraph - (((f.ml (1 0) (1 25)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 24)) - (emphasis - (((f.ml (1 11) (1 23)) - (with_text ((f.ml (1 14) (1 18)) bar) - (((f.ml (1 19) (1 22)) (word baz)))))))))))))))) - (warnings ())) |}] - - let simple_through_emphasis = - test "{{!foo} {e {!bar}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 19)) - (paragraph - (((f.ml (1 0) (1 19)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 18)) - (emphasis - (((f.ml (1 11) (1 17)) (simple ((f.ml (1 13) (1 17)) bar) ()))))))))))))) - (warnings ())) |}] - - let empty_target = - test "{{!} foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 9)) - (with_text ((f.ml (1 3) (1 4)) "") (((f.ml (1 5) (1 8)) (word foo)))))))))) - (warnings ())) |}] - - let whitespace_only_in_target = - test "{{! } foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) - (with_text ((f.ml (1 3) (1 5)) " ") (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings ())) |}] - - let internal_whitespace = - test "{{!( * )} baz}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (paragraph - (((f.ml (1 0) (1 14)) - (with_text ((f.ml (1 3) (1 9)) "( * )") - (((f.ml (1 10) (1 13)) (word baz)))))))))) - (warnings ())) |}] - - let unterminated = - test "{{!foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (with_text ((f.ml (1 3) (1 6)) foo) ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{{!...} ...}' (cross-reference)." - "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{{!...} ...}' (cross-reference)." - "File \"f.ml\", line 1, characters 0-6:\ - \n'{{!...} ...}' (cross-reference) should not be empty."))) |}] - - let unterminated_content = - test "{{!foo} bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 11)) (word bar)))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 11-11:\ - \nEnd of text is not allowed in '{{!...} ...}' (cross-reference)."))) |}] - end in - () - -let%expect_test _ = - let module Link = struct - let basic = - test "{{:foo} bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 12)) - (paragraph - (((f.ml (1 0) (1 12)) (foo (((f.ml (1 8) (1 11)) (word bar)))))))))) - (warnings ())) |}] - - let nested_markup = - test "{{:foo} {b bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) - (foo - (((f.ml (1 8) (1 15)) (bold (((f.ml (1 11) (1 14)) (word bar))))))))))))) - (warnings ())) |}] - - let in_markup = - test "{e {{:foo} bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) - (emphasis - (((f.ml (1 3) (1 15)) (foo (((f.ml (1 11) (1 14)) (word bar))))))))))))) - (warnings ())) |}] - - let no_separating_space = - test "{{:foo}bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph - (((f.ml (1 0) (1 11)) (foo (((f.ml (1 7) (1 10)) (word bar)))))))))) - (warnings ())) |}] - - let nested_link = - test "{{:foo} {{:bar} baz}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 21)) - (paragraph - (((f.ml (1 0) (1 21)) - (foo - (((f.ml (1 8) (1 20)) (bar (((f.ml (1 16) (1 19)) (word baz))))))))))))) - (warnings ())) |}] - - let nested_through_emphasis = - test "{{:foo} {e {{:bar} baz}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 25)) - (paragraph - (((f.ml (1 0) (1 25)) - (foo - (((f.ml (1 8) (1 24)) - (emphasis - (((f.ml (1 11) (1 23)) (bar (((f.ml (1 19) (1 22)) (word baz)))))))))))))))) - (warnings ())) |}] - - let reference_through_emphasis = - test "{{:foo} {e {!bar}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 19)) - (paragraph - (((f.ml (1 0) (1 19)) - (foo - (((f.ml (1 8) (1 18)) - (emphasis - (((f.ml (1 11) (1 17)) (simple ((f.ml (1 13) (1 17)) bar) ()))))))))))))) - (warnings ())) |}] - - let nested_in_reference = - test "{{!foo} {e {{:bar} baz}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 25)) - (paragraph - (((f.ml (1 0) (1 25)) - (with_text ((f.ml (1 3) (1 7)) foo) - (((f.ml (1 8) (1 24)) - (emphasis - (((f.ml (1 11) (1 23)) (bar (((f.ml (1 19) (1 22)) (word baz)))))))))))))))) - (warnings ())) |}] - - let empty_target = - test "{{:} foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph (((f.ml (1 0) (1 9)) ("" (((f.ml (1 5) (1 8)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'{{:...} ...}' (external link) should not be empty."))) |}] - - let whitespace_only_in_target = - test "{{: } foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph - (((f.ml (1 0) (1 10)) ("" (((f.ml (1 6) (1 9)) (word foo)))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-5:\ - \n'{{:...} ...}' (external link) should not be empty."))) |}] - - let empty = - test "{{:foo}}"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (foo ()))))))) - (warnings ())) |}] - - let internal_whitespace = - test "{{:foo bar} baz}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (paragraph - (((f.ml (1 0) (1 16)) ("foo bar" (((f.ml (1 12) (1 15)) (word baz)))))))))) - (warnings ())) |}] - - let unterminated = - test "{{:foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (paragraph (((f.ml (1 0) (1 6)) (foo ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{{:...} ...}' (external link)." - "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{{:...} ...}' (external link)."))) |}] - - let single_braces = - test "{:foo}"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (paragraph (((f.ml (1 0) (1 6)) (foo ()))))))) - (warnings ())) |}] - - let unterminated_single_braces = - test "{:foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 5)) (paragraph (((f.ml (1 0) (1 5)) (foo ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 5-5:\ - \nEnd of text is not allowed in '{:...} (external link)'."))) |}] - - let empty_single_braces = - test "{:}"; - [%expect - {| - ((output (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) ("" ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-3:\ - \n'{:...} (external link)' should not be empty."))) |}] - - let single_braces_whitespace_only = - test "{: }"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) ("" ()))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'{:...} (external link)' should not be empty."))) |}] - end in - () - -let%expect_test _ = - let module Module_list = struct - let basic = - test "{!modules:Foo}"; - [%expect - {| - ((output (((f.ml (1 0) (1 14)) (modules (((f.ml (1 0) (1 14)) Foo)))))) - (warnings ())) |}] - - let two = - test "{!modules:Foo Bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 18)) - (modules (((f.ml (1 0) (1 18)) Foo) ((f.ml (1 0) (1 18)) Bar)))))) - (warnings ())) |}] - - let extra_whitespace = - test "{!modules: Foo Bar }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 21)) - (modules (((f.ml (1 0) (1 21)) Foo) ((f.ml (1 0) (1 21)) Bar)))))) - (warnings ())) |}] - - let newline = - test "{!modules:Foo\nBar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (modules (((f.ml (1 0) (2 4)) Foo) ((f.ml (1 0) (2 4)) Bar)))))) - (warnings ())) |}] - - let cr_lf = - test "{!modules:Foo\r\nBar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 4)) - (modules (((f.ml (1 0) (2 4)) Foo) ((f.ml (1 0) (2 4)) Bar)))))) - (warnings ())) |}] - - let empty = - test "{!modules:}"; - [%expect - {| - ((output (((f.ml (1 0) (1 11)) (modules ())))) - (warnings - ( "File \"f.ml\", line 1, characters 0-11:\ - \n'{!modules ...}' should not be empty."))) |}] - - let whitespace_only = - test "{!modules: }"; - [%expect - {| - ((output (((f.ml (1 0) (1 12)) (modules ())))) - (warnings - ( "File \"f.ml\", line 1, characters 0-12:\ - \n'{!modules ...}' should not be empty."))) |}] - - let unterminated = - test "{!modules:"; - [%expect - {| - ((output (((f.ml (1 0) (1 10)) (modules ())))) - (warnings - ( "File \"f.ml\", line 1, characters 10-10:\ - \nEnd of text is not allowed in '{!modules ...}'." - "File \"f.ml\", line 1, characters 0-10:\ - \n'{!modules ...}' should not be empty."))) |}] - - let in_paragraph = - test "foo {!modules:Foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space)))) - ((f.ml (1 4) (1 18)) (modules (((f.ml (1 4) (1 18)) Foo)))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-18:\ - \n'{!modules ...}' should begin on its own line."))) |}] - - let followed_by_word = - test "{!modules:Foo} foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) (modules (((f.ml (1 0) (1 14)) Foo)))) - ((f.ml (1 15) (1 18)) (paragraph (((f.ml (1 15) (1 18)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 15-18:\ - \nParagraph should begin on its own line."))) |}] - - let in_list = - test "- {!modules:Foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (unordered light - ((((f.ml (1 2) (1 16)) (modules (((f.ml (1 2) (1 16)) Foo)))))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Code_block = struct - let basic = - test "{[foo]}"; - [%expect - {| ((output (((f.ml (1 0) (1 7)) (code_block foo)))) (warnings ())) |}] - - let empty = - test "{[]}"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (code_block "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'{[...]}' (code block) should not be empty."))) |}] - - let whitespace_only = - test "{[ ]}"; - [%expect - {| - ((output (((f.ml (1 0) (1 5)) (code_block "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-5:\ - \n'{[...]}' (code block) should not be empty."))) |}] - - let blank_line_only = - test "{[\n \n]}"; - [%expect - {| - ((output (((f.ml (1 0) (3 2)) (code_block "")))) - (warnings - ( "File \"f.ml\", line 1, character 0 to line 3, character 2:\ - \n'{[...]}' (code block) should not be empty."))) |}] - - let whitespace = - test "{[foo bar]}"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (code_block "foo bar")))) (warnings ())) |}] - - let newline = - test "{[foo\nbar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 5)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let cr_lf = - test "{[foo\r\nbar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 5)) (code_block "foo\r\ - \nbar")))) (warnings ())) |}] - - let blank_line = - test "{[foo\n\nbar]}"; - [%expect - {| - ((output (((f.ml (1 0) (3 5)) (code_block "foo\ - \n\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace = - test "{[ foo]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block foo)))) (warnings ())) |}] - - let leading_whitespace_two = - test "{[ foo\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_two_cr_lf = - test "{[ foo\r\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (code_block "foo\r\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_two_different_indent = - test "{[ foo\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 8)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_two_different_indent_rev = - test "{[ foo\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (code_block " foo\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_two_different_indent_reloc = - test "{[ foo\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 11)) (code_block "foo\ - \n bar")))) (warnings ())) |}] - - let leading_whitespace_with_empty_line = - test "{[ foo\n\n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (3 6)) (code_block "foo\ - \n\ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_with_whitespace_line_short = - test "{[ foo\n \n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (3 7)) (code_block "foo\ - \n \ - \nbar")))) (warnings ())) |}] - - let leading_whitespace_with_whitespace_line_long = - test "{[ foo\n \n bar]}"; - [%expect - {| - ((output (((f.ml (1 0) (3 6)) (code_block "foo\ - \n \ - \nbar")))) - (warnings ())) |}] - - let leading_whitespace_leading_newline = - test "{[\n foo\n bar\n]}"; - [%expect - {| - ((output (((f.ml (1 0) (4 2)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let leading_tab = - test "{[\tfoo]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block foo)))) (warnings ())) |}] - - let leading_tab_two = - test "{[\tfoo\n\tbar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let leading_tab_two_different_indent = - test "{[\tfoo\n\t\tbar]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 7)) (code_block "foo\ - \nbar")))) (warnings ())) |}] - - let leading_newline = - test "{[\nfoo]}"; - [%expect - {| ((output (((f.ml (1 0) (2 5)) (code_block foo)))) (warnings ())) |}] - - let leading_cr_lf = - test "{[\r\nfoo]}"; - [%expect - {| ((output (((f.ml (1 0) (2 5)) (code_block foo)))) (warnings ())) |}] - - let leading_newlines = - test "{[\n\nfoo]}"; - [%expect - {| ((output (((f.ml (1 0) (3 5)) (code_block foo)))) (warnings ())) |}] - - let leading_newline_with_space = - test "{[\n foo]}"; - [%expect - {| ((output (((f.ml (1 0) (2 6)) (code_block foo)))) (warnings ())) |}] - - let leading_newline_with_trash = - test "{[ \nfoo]}"; - [%expect - {| ((output (((f.ml (1 0) (2 5)) (code_block foo)))) (warnings ())) |}] - - let nested_opener = - test "{[{[]}"; - [%expect - {| ((output (((f.ml (1 0) (1 6)) (code_block {[)))) (warnings ())) |}] - - let nested_closer = - test "{[foo]}]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 7) (1 8)) (paragraph (((f.ml (1 7) (1 8)) (word ]))))) - ((f.ml (1 8) (1 9)) (paragraph (((f.ml (1 8) (1 9)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 7-8:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'." - "File \"f.ml\", line 1, characters 7-8:\ - \nParagraph should begin on its own line." - "File \"f.ml\", line 1, characters 8-9:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let nested_bracket = - test "{[]]}"; - [%expect - {| ((output (((f.ml (1 0) (1 5)) (code_block ])))) (warnings ())) |}] - - let two_nested_brackets = - test "{[]]]}"; - [%expect - {| ((output (((f.ml (1 0) (1 6)) (code_block ]])))) (warnings ())) |}] - - let nested_brackets_in_text = - test "{[foo]]bar]}"; - [%expect - {| ((output (((f.ml (1 0) (1 12)) (code_block foo]]bar)))) (warnings ())) |}] - - let trailing_whitespace = - test "{[foo ]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block "foo ")))) (warnings ())) |}] - - let trailing_tab = - test "{[foo\t]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block "foo\t")))) (warnings ())) |}] - - let trailing_newline = - test "{[foo\n]}"; - [%expect - {| ((output (((f.ml (1 0) (2 2)) (code_block foo)))) (warnings ())) |}] - - let trailing_cr_lf = - test "{[foo\r\n]}"; - [%expect - {| ((output (((f.ml (1 0) (2 2)) (code_block foo)))) (warnings ())) |}] - - let trailing_newlines = - test "{[foo\n\n]}"; - [%expect - {| ((output (((f.ml (1 0) (3 2)) (code_block foo)))) (warnings ())) |}] - - let preceded_by_whitespace = - test "{[foo]}"; - [%expect - {| ((output (((f.ml (1 0) (1 7)) (code_block foo)))) (warnings ())) |}] - - let followed_by_whitespace = - test "{[foo]}"; - [%expect - {| ((output (((f.ml (1 0) (1 7)) (code_block foo)))) (warnings ())) |}] - - let two_on_one_line = - test "{[foo]} {[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 8) (1 15)) (code_block bar)))) - (warnings - ( "File \"f.ml\", line 1, characters 8-15:\ - \n'{[...]}' (code block) should begin on its own line."))) |}] - - let two = - test "{[foo]}\n{[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (2 0) (2 7)) (code_block bar)))) - (warnings ())) |}] - - let two_with_blank_line = - test "{[foo]}\n\n{[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (3 0) (3 7)) (code_block bar)))) - (warnings ())) |}] - - let followed_by_words = - test "{[foo]} bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word bar))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-11:\ - \nParagraph should begin on its own line."))) |}] - - let preceded_by_words = - test "foo {[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space)))) - ((f.ml (1 4) (1 11)) (code_block bar)))) - (warnings - ( "File \"f.ml\", line 1, characters 4-11:\ - \n'{[...]}' (code block) should begin on its own line."))) |}] - - let preceded_by_paragraph = - test "foo\n{[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (2 0) (2 7)) (code_block bar)))) - (warnings ())) |}] - - let followed_by_paragraph = - test "{[foo]}\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word bar))))))) - (warnings ())) |}] - - let unterminated = - test "{[foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 5)) (code_block foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 5-5:\ - \nEnd of text is not allowed in '{[...]}' (code block)."))) |}] - - let unterminated_bracket = - test "{[foo]"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (code_block foo])))) - (warnings - ( "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{[...]}' (code block)."))) |}] - - let trailing_cr = - test "{[foo\r]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block "foo\r")))) (warnings ())) |}] - - let comment = - test "{[(* foo *)\nlet bar = ()]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 14)) (code_block "(* foo *)\ - \nlet bar = ()")))) - (warnings ())) |}] - - let docstring = - test "{[(** foo *)\nlet bar = ()]}"; - [%expect - {| - ((output (((f.ml (1 0) (2 14)) (code_block "(** foo *)\ - \nlet bar = ()")))) - (warnings ())) |}] - - let docstring_with_code_block = - test "{[(** {[foo]} *)\nlet bar = ()]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 13)) (code_block "(** {[foo")) - ((f.ml (1 14) (2 13)) - (paragraph - (((f.ml (1 14) (1 16)) (word "*)")) ((f.ml (1 16) (2 0)) space) - ((f.ml (2 0) (2 3)) (word let)) ((f.ml (2 3) (2 4)) space) - ((f.ml (2 4) (2 7)) (word bar)) ((f.ml (2 7) (2 8)) space) - ((f.ml (2 8) (2 9)) (word =)) ((f.ml (2 9) (2 10)) space) - ((f.ml (2 10) (2 12)) (word "()")) ((f.ml (2 12) (2 13)) (word ]))))) - ((f.ml (2 13) (2 14)) (paragraph (((f.ml (2 13) (2 14)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 14-16:\ - \nParagraph should begin on its own line." - "File \"f.ml\", line 2, characters 12-13:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'." - "File \"f.ml\", line 2, characters 13-14:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let code_block_with_meta = - test "{@ocaml env=f1 version>=4.06 [code goes here]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 46)) - (code_block "ocaml env=f1 version>=4.06 " "code goes here")))) - (warnings ())) |}] - - let code_block_empty_meta = - test "{@[code goes here]}"; - [%expect - {| - ((output (((f.ml (1 0) (1 19)) (code_block "" "code goes here")))) - (warnings ())) |}] - - let unterminated_code_block_with_meta = - test "{@meta[foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 10)) (code_block meta foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 10-10:\ - \nEnd of text is not allowed in '{[...]}' (code block)."))) |}] - - let unterminated_code_block_with_meta = - test "{@met"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 1)) (word {)) ((f.ml (1 1) (1 5)) (word @met))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'." - "File \"f.ml\", line 1, characters 1-5:\ - \nUnknown tag '@met'."))) |}] - end in - () - -let%expect_test _ = - let module Verbatim = struct - let basic = - test "{v foo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim foo)))) (warnings ())) |}] - - let empty = - test "{v v}"; - [%expect - {| - ((output (((f.ml (1 0) (1 5)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-5:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let degenerate = - test "{vv}"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (verbatim v})))) - (warnings - ( "File \"f.ml\", line 1, characters 2-4:\ - \n'v}' should be preceded by whitespace." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{v' should be followed by whitespace."))) |}] - - let whitespace_only = - test "{v v}"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let blank_line_only = - test "{v\n \nv}"; - [%expect - {| - ((output (((f.ml (1 0) (3 2)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, character 0 to line 3, character 2:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let no_leading_whitespace = - test "{vfoo v}"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (verbatim foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 0-2:\ - \n'{v' should be followed by whitespace."))) |}] - - let no_trailing_whitespace = - test "{v foov}"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (verbatim foov})))) - (warnings - ( "File \"f.ml\", line 1, characters 6-8:\ - \n'v}' should be preceded by whitespace."))) |}] - - let multiple_leading_whitespace = - test "{v foo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (verbatim " foo")))) (warnings ())) |}] - - let multiple_trailing_whitespace = - test "{v foo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (verbatim "foo ")))) (warnings ())) |}] - - let leading_tab = - test "{v\tfoo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim "\tfoo")))) (warnings ())) |}] - - let leading_newline = - test "{v\nfoo v}"; - [%expect - {| ((output (((f.ml (1 0) (2 6)) (verbatim foo)))) (warnings ())) |}] - - let leading_cr_lf = - test "{v\r\nfoo v}"; - [%expect - {| ((output (((f.ml (1 0) (2 6)) (verbatim foo)))) (warnings ())) |}] - - let trailing_tab = - test "{v foo\tv}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim "foo\t")))) (warnings ())) |}] - - let trailing_newline = - test "{v foo\nv}"; - [%expect - {| ((output (((f.ml (1 0) (2 2)) (verbatim foo)))) (warnings ())) |}] - - let trailing_cr_lf = - test "{v foo\r\nv}"; - [%expect - {| ((output (((f.ml (1 0) (2 2)) (verbatim foo)))) (warnings ())) |}] - - let internal_whitespace = - test "{v foo bar v}"; - [%expect - {| ((output (((f.ml (1 0) (1 13)) (verbatim "foo bar")))) (warnings ())) |}] - - let newline = - test "{v foo\nbar v}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (verbatim "foo\ - \nbar")))) (warnings ())) |}] - - let cr_lf = - test "{v foo\r\nbar v}"; - [%expect - {| - ((output (((f.ml (1 0) (2 6)) (verbatim "foo\r\ - \nbar")))) (warnings ())) |}] - - let blank_line = - test "{v foo\n\nbar v}"; - [%expect - {| - ((output (((f.ml (1 0) (3 6)) (verbatim "foo\ - \n\ - \nbar")))) (warnings ())) |}] - - let leading_newlines = - test "{v\n\nfoo v}"; - [%expect - {| ((output (((f.ml (1 0) (3 6)) (verbatim foo)))) (warnings ())) |}] - - let leading_newline_with_space = - test "{v\n foo v}"; - [%expect - {| ((output (((f.ml (1 0) (2 7)) (verbatim " foo")))) (warnings ())) |}] - - let leading_newline_with_trash = - test "{v \nfoo v}"; - [%expect - {| ((output (((f.ml (1 0) (2 6)) (verbatim foo)))) (warnings ())) |}] - - let nested_opener = - test "{v {v v}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (verbatim {v)))) (warnings ())) |}] - - let nested_closer = - test "{v foo v} v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) - ((f.ml (1 10) (1 11)) (paragraph (((f.ml (1 10) (1 11)) (word v))))) - ((f.ml (1 11) (1 12)) (paragraph (((f.ml (1 11) (1 12)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 10-11:\ - \nParagraph should begin on its own line." - "File \"f.ml\", line 1, characters 11-12:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let nested_closer_with_word = - test "{v {dev} v}"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (verbatim {dev})))) (warnings ())) |}] - - let nested_v = - test "{v v v}"; - [%expect - {| ((output (((f.ml (1 0) (1 7)) (verbatim v)))) (warnings ())) |}] - - let two_nested_vs = - test "{v vv v}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (verbatim vv)))) (warnings ())) |}] - - let nested_v_at_end = - test "{v vv}"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (verbatim vv})))) - (warnings - ( "File \"f.ml\", line 1, characters 4-6:\ - \n'v}' should be preceded by whitespace."))) |}] - - let two_nested_vs_at_end = - test "{v vvv}"; - [%expect - {| - ((output (((f.ml (1 0) (1 7)) (verbatim vvv})))) - (warnings - ( "File \"f.ml\", line 1, characters 5-7:\ - \n'v}' should be preceded by whitespace."))) |}] - - let nested_vs_in_text = - test "{v foovvbar v}"; - [%expect - {| ((output (((f.ml (1 0) (1 14)) (verbatim foovvbar)))) (warnings ())) |}] - - let trailing_newlines = - test "{v foo\n\nv}"; - [%expect - {| ((output (((f.ml (1 0) (3 2)) (verbatim foo)))) (warnings ())) |}] - - let preceded_by_whitespace = - test "{v foo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim foo)))) (warnings ())) |}] - - let followed_by_whitespace = - test "{v foo v}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim foo)))) (warnings ())) |}] - - let two_on_one_line = - test "{v foo v} {v bar v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) ((f.ml (1 10) (1 19)) (verbatim bar)))) - (warnings - ( "File \"f.ml\", line 1, characters 10-19:\ - \n'{v ... v}' (verbatim text) should begin on its own line."))) |}] - - let two = - test "{v foo v}\n{v bar v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) ((f.ml (2 0) (2 9)) (verbatim bar)))) - (warnings ())) |}] - - let two_with_blank_line = - test "{v foo v}\n\n{v bar v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) ((f.ml (3 0) (3 9)) (verbatim bar)))) - (warnings ())) |}] - - let followed_by_words = - test "{v foo v} bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) - ((f.ml (1 10) (1 13)) (paragraph (((f.ml (1 10) (1 13)) (word bar))))))) - (warnings - ( "File \"f.ml\", line 1, characters 10-13:\ - \nParagraph should begin on its own line."))) |}] - - let preceded_by_words = - test "foo {v bar v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space)))) - ((f.ml (1 4) (1 13)) (verbatim bar)))) - (warnings - ( "File \"f.ml\", line 1, characters 4-13:\ - \n'{v ... v}' (verbatim text) should begin on its own line."))) |}] - - let preceded_by_paragraph = - test "foo\n{v bar v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (2 0) (2 9)) (verbatim bar)))) - (warnings ())) |}] - - let followed_by_paragraph = - test "{v foo v}\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (verbatim foo)) - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word bar))))))) - (warnings ())) |}] - - let unterminated = - test "{v foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (verbatim foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 6-6:\ - \nEnd of text is not allowed in '{v ... v}' (verbatim text)."))) |}] - - let unterminated_v = - test "{v foo v"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (verbatim "foo v")))) - (warnings - ( "File \"f.ml\", line 1, characters 8-8:\ - \nEnd of text is not allowed in '{v ... v}' (verbatim text)."))) |}] - - let unterminated_empty = - test "{v"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, characters 2-2:\ - \nEnd of text is not allowed in '{v ... v}' (verbatim text)." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let unterminated_whitespace = - test "{v"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, characters 2-2:\ - \nEnd of text is not allowed in '{v ... v}' (verbatim text)." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let unterminated_whitespace_2 = - test "{v"; - [%expect - {| - ((output (((f.ml (1 0) (1 2)) (verbatim "")))) - (warnings - ( "File \"f.ml\", line 1, characters 2-2:\ - \nEnd of text is not allowed in '{v ... v}' (verbatim text)." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{v ... v}' (verbatim text) should not be empty."))) |}] - - let trailing_cr = - test "{v foo\rv}"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (verbatim "foo\r")))) (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Shorthand_list = struct - let basic = - test "- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))))) - (warnings ())) |}] - - let multiple_items = - test "- foo\n- bar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo)))))) - (((f.ml (2 2) (2 5)) (paragraph (((f.ml (2 2) (2 5)) (word bar))))))))))) - (warnings ())) |}] - - let two_lists = - test "- foo\n\n- bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))) - ((f.ml (3 0) (3 5)) - (unordered light - ((((f.ml (3 2) (3 5)) (paragraph (((f.ml (3 2) (3 5)) (word bar))))))))))) - (warnings ())) |}] - - let ordered = - test "+ foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (ordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))))) - (warnings ())) |}] - - let leading_whitespace = - test "- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))))) - (warnings ())) |}] - - let trailing_whitespace = - test "- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))))) - (warnings ())) |}] - - let bullet_in_line = - test "- foo - bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (unordered light - ((((f.ml (1 2) (1 11)) - (paragraph - (((f.ml (1 2) (1 5)) (word foo)) ((f.ml (1 5) (1 6)) space) - ((f.ml (1 6) (1 7)) (word -)) ((f.ml (1 7) (1 8)) space) - ((f.ml (1 8) (1 11)) (word bar))))))))))) - (warnings ())) |}] - - let bullet_in_line_immediately = - test "- - foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (unordered light - (() - (((f.ml (1 4) (1 7)) (paragraph (((f.ml (1 4) (1 7)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 2-3:\ - \n'-' (bulleted list item) should begin on its own line." - "File \"f.ml\", line 1, characters 0-1:\ - \n'-' (bulleted list item) should not be empty."))) |}] - - let code_block = - test "- {[foo]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (unordered light ((((f.ml (1 2) (1 9)) (code_block foo)))))))) - (warnings ())) |}] - - let verbatim = - test "- {v foo v}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (unordered light ((((f.ml (1 2) (1 11)) (verbatim foo)))))))) - (warnings ())) |}] - - let multiple_blocks = - test "- foo\n{[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 7)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))) - ((f.ml (2 0) (2 7)) (code_block bar)))))))) - (warnings ())) |}] - - let followed_by_code_block = - test "- foo\n\n{[bar]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))) - ((f.ml (3 0) (3 7)) (code_block bar)))) - (warnings ())) |}] - - let different_kinds = - test "- foo\n+ bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))) - ((f.ml (2 0) (2 5)) - (ordered light - ((((f.ml (2 2) (2 5)) (paragraph (((f.ml (2 2) (2 5)) (word bar))))))))))) - (warnings ())) |}] - - let no_content = - test "-"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (unordered light (()))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'-' (bulleted list item) should not be empty."))) |}] - - let immediate_newline = - test "-\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (unordered light - ((((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))))) - (warnings ())) |}] - - let immediate_blank_line = - test "-\n\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 1)) (unordered light (()))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'-' (bulleted list item) should not be empty."))) |}] - - let immediate_markup = - test "-{b foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (unordered light - ((((f.ml (1 1) (1 8)) - (paragraph - (((f.ml (1 1) (1 8)) (bold (((f.ml (1 4) (1 7)) (word foo)))))))))))))) - (warnings ())) |}] - - let after_code_block = - test "{[foo]} - bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 8) (1 13)) - (unordered light - ((((f.ml (1 10) (1 13)) (paragraph (((f.ml (1 10) (1 13)) (word bar))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-9:\ - \n'-' (bulleted list item) should begin on its own line."))) |}] - end in - () - -let%expect_test _ = - let module Explicit_list = struct - let basic = - test "{ul {li foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 13)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))))))) - (warnings ())) |}] - - let ordered = - test "{ol {li foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 13)) - (ordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))))))) - (warnings ())) |}] - - let two_items = - test "{ul {li foo} {li bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 22)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo)))))) - (((f.ml (1 17) (1 20)) (paragraph (((f.ml (1 17) (1 20)) (word bar))))))))))) - (warnings ())) |}] - - let items_on_separate_lines = - test "{ul {li foo}\n{li bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 9)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo)))))) - (((f.ml (2 4) (2 7)) (paragraph (((f.ml (2 4) (2 7)) (word bar))))))))))) - (warnings ())) |}] - - let blank_line = - test "{ul {li foo}\n\n{li bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (3 9)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo)))))) - (((f.ml (3 4) (3 7)) (paragraph (((f.ml (3 4) (3 7)) (word bar))))))))))) - (warnings ())) |}] - - let blank_line_in_item = - test "{ul {li foo\n\nbar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (3 5)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))))))) - (warnings ())) |}] - - let junk = - test "{ul foo}"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (unordered heavy ())))) - (warnings - ( "File \"f.ml\", line 1, characters 4-7:\ - \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."))) |}] - - let junk_with_no_whitespace = - test "{ulfoo}"; - [%expect - {| - ((output (((f.ml (1 0) (1 7)) (unordered heavy ())))) - (warnings - ( "File \"f.ml\", line 1, characters 3-6:\ - \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."))) |}] - - let empty = - test "{ul}"; - [%expect - {| - ((output (((f.ml (1 0) (1 4)) (unordered heavy ())))) - (warnings - ( "File \"f.ml\", line 1, characters 0-3:\ - \n'{ul ...}' (bulleted list) should not be empty."))) |}] - - let unterminated_list = - test "{ul"; - [%expect - {| - ((output (((f.ml (1 0) (1 3)) (unordered heavy ())))) - (warnings - ( "File \"f.ml\", line 1, characters 3-3:\ - \nEnd of text is not allowed in '{ul ...}' (bulleted list)." - "File \"f.ml\", line 1, characters 0-3:\ - \n'{ul ...}' (bulleted list) should not be empty."))) |}] - - let no_whitespace = - test "{ul{li foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 12)) - (unordered heavy - ((((f.ml (1 7) (1 10)) (paragraph (((f.ml (1 7) (1 10)) (word foo))))))))))) - (warnings ())) |}] - - let whitespace_at_end_of_item = - test "{ul {li foo\n\n\n}}"; - [%expect - {| - ((output - (((f.ml (1 0) (4 2)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))))))) - (warnings ())) |}] - - let unterminated_li_syntax = - test "{ul {li foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 11-11:\ - \nEnd of text is not allowed in '{li ...}' (list item)." - "File \"f.ml\", line 1, characters 11-11:\ - \nEnd of text is not allowed in '{ul ...}' (bulleted list)."))) |}] - - let unterminated_left_curly_brace = - test "{ul {- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (unordered heavy - ((((f.ml (1 7) (1 10)) (paragraph (((f.ml (1 7) (1 10)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 10-10:\ - \nEnd of text is not allowed in '{- ...}' (list item)." - "File \"f.ml\", line 1, characters 10-10:\ - \nEnd of text is not allowed in '{ul ...}' (bulleted list)."))) |}] - - let empty_li_styntax = - test "{ul {li }}"; - [%expect - {| - ((output (((f.ml (1 0) (1 10)) (unordered heavy (()))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-7:\ - \n'{li ...}' (list item) should not be empty."))) |}] - - let empty_left_curly_brace = - test "{ul {- }}"; - [%expect - {| - ((output (((f.ml (1 0) (1 9)) (unordered heavy (()))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-6:\ - \n'{- ...}' (list item) should not be empty."))) |}] - - let li_syntax_without_whitespace = - test "{ul {lifoo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 12)) - (unordered heavy - ((((f.ml (1 7) (1 10)) (paragraph (((f.ml (1 7) (1 10)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-7:\ - \n'{li ...}' should be followed by space, a tab, or a new line."))) |}] - - let li_syntax_followed_by_newline = - test "{ul {li\nfoo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (unordered heavy - ((((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))))) - (warnings ())) |}] - - let li_syntax_followed_by_cr_lf = - test "{ul {li\r\nfoo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (unordered heavy - ((((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))))) - (warnings ())) |}] - - let li_syntax_followed_by_blank_line = - test "{ul {li\n\nfoo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (3 5)) - (unordered heavy - ((((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word foo))))))))))) - (warnings ())) |}] - - let left_curly_brace_without_whitespace = - test "{ul {-foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (unordered heavy - ((((f.ml (1 6) (1 9)) (paragraph (((f.ml (1 6) (1 9)) (word foo))))))))))) - (warnings ())) |}] - - let mixed_list_items = - test "{ul {li foo} {- bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 21)) - (unordered heavy - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo)))))) - (((f.ml (1 16) (1 19)) (paragraph (((f.ml (1 16) (1 19)) (word bar))))))))))) - (warnings ())) |}] - - let nested = - test "{ul {li {ul {li foo}}}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 23)) - (unordered heavy - ((((f.ml (1 8) (1 21)) - (unordered heavy - ((((f.ml (1 16) (1 19)) - (paragraph (((f.ml (1 16) (1 19)) (word foo))))))))))))))) - (warnings ())) |}] - - let shorthand_in_explicit = - test "{ul {li - foo\n- bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 7)) - (unordered heavy - ((((f.ml (1 8) (2 5)) - (unordered light - ((((f.ml (1 10) (1 13)) - (paragraph (((f.ml (1 10) (1 13)) (word foo)))))) - (((f.ml (2 2) (2 5)) (paragraph (((f.ml (2 2) (2 5)) (word bar))))))))))))))) - (warnings ())) |}] - - let explicit_in_shorthand = - test "- {ul {li foo}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 15)) - (unordered light - ((((f.ml (1 2) (1 15)) - (unordered heavy - ((((f.ml (1 10) (1 13)) - (paragraph (((f.ml (1 10) (1 13)) (word foo))))))))))))))) - (warnings ())) |}] - - let bare_li_syntax = - test "{li foo}"; - [%expect - {| - ((output - (((f.ml (1 4) (1 7)) (paragraph (((f.ml (1 4) (1 7)) (word foo))))) - ((f.ml (1 7) (1 8)) (paragraph (((f.ml (1 7) (1 8)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-3:\ - \n'{li ...}' (list item) is not allowed in top-level text.\ - \nSuggestion: move '{li ...}' into '{ul ...}' (bulleted list), or use '-' (bulleted list item)." - "File \"f.ml\", line 1, characters 7-8:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let bare_left_curly_brace = - test "{- foo"; - [%expect - {| - ((output - (((f.ml (1 3) (1 6)) (paragraph (((f.ml (1 3) (1 6)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-2:\ - \n'{- ...}' (list item) is not allowed in top-level text.\ - \nSuggestion: move '{- ...}' into '{ul ...}' (bulleted list), or use '-' (bulleted list item)."))) |}] - - let after_code_block = - test "{[foo]} {ul {li bar}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 8) (1 21)) - (unordered heavy - ((((f.ml (1 16) (1 19)) (paragraph (((f.ml (1 16) (1 19)) (word bar))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-11:\ - \n'{ul ...}' (bulleted list) should begin on its own line."))) |}] - end in - () - -let%expect_test _ = - let module Deprecated = struct - let basic = - test "@deprecated"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@deprecated)))) (warnings ())) |}] - - let words = - test "@deprecated foo bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 19)) - (@deprecated - ((f.ml (1 12) (1 19)) - (paragraph - (((f.ml (1 12) (1 15)) (word foo)) ((f.ml (1 15) (1 16)) space) - ((f.ml (1 16) (1 19)) (word bar))))))))) - (warnings ())) |}] - - let multiline = - test "@deprecated foo\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (@deprecated - ((f.ml (1 12) (2 3)) - (paragraph - (((f.ml (1 12) (1 15)) (word foo)) ((f.ml (1 15) (2 0)) space) - ((f.ml (2 0) (2 3)) (word bar))))))))) - (warnings ())) |}] - - let paragraphs = - test "@deprecated foo\n\nbar"; - [%expect - {| - ((output - (((f.ml (1 0) (3 3)) - (@deprecated - ((f.ml (1 12) (1 15)) (paragraph (((f.ml (1 12) (1 15)) (word foo))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word bar))))))))) - (warnings ())) |}] - - let whitespace_only = - test "@deprecated"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@deprecated)))) (warnings ())) |}] - - let immediate_newline = - test "@deprecated\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (@deprecated - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))) - (warnings ())) |}] - - let immediate_cr_lf = - test "@deprecated\r\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (@deprecated - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))) - (warnings ())) |}] - - let immediate_blank_line = - test "@deprecated\n\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (3 3)) - (@deprecated - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word foo))))))))) - (warnings ())) |}] - - let extra_whitespace = - test "@deprecated foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 16)) - (@deprecated - ((f.ml (1 13) (1 16)) (paragraph (((f.ml (1 13) (1 16)) (word foo))))))))) - (warnings ())) |}] - - let followed_by_deprecated = - test "@deprecated foo\n@deprecated bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 15)) - (@deprecated - ((f.ml (1 12) (1 15)) (paragraph (((f.ml (1 12) (1 15)) (word foo))))))) - ((f.ml (2 0) (2 15)) - (@deprecated - ((f.ml (2 12) (2 15)) (paragraph (((f.ml (2 12) (2 15)) (word bar))))))))) - (warnings ())) |}] - - let followed_by_deprecated_cr_lf = - test "@deprecated foo\r\n@deprecated bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 15)) - (@deprecated - ((f.ml (1 12) (1 15)) (paragraph (((f.ml (1 12) (1 15)) (word foo))))))) - ((f.ml (2 0) (2 15)) - (@deprecated - ((f.ml (2 12) (2 15)) (paragraph (((f.ml (2 12) (2 15)) (word bar))))))))) - (warnings ())) |}] - - let nested_in_self = - test "@deprecated foo @deprecated bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 31)) - (@deprecated - ((f.ml (1 12) (1 16)) - (paragraph - (((f.ml (1 12) (1 15)) (word foo)) ((f.ml (1 15) (1 16)) space)))) - ((f.ml (1 16) (1 27)) - (paragraph (((f.ml (1 16) (1 27)) (word @deprecated))))) - ((f.ml (1 28) (1 31)) (paragraph (((f.ml (1 28) (1 31)) (word bar))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 16-27:\ - \n'@deprecated' is not allowed in '@deprecated'.\ - \nSuggestion: move '@deprecated' outside of any other markup."))) |}] - - let nested_in_self_at_start = - test "@deprecated @deprecated foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 27)) - (@deprecated - ((f.ml (1 12) (1 23)) - (paragraph (((f.ml (1 12) (1 23)) (word @deprecated))))) - ((f.ml (1 24) (1 27)) (paragraph (((f.ml (1 24) (1 27)) (word foo))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 12-23:\ - \n'@deprecated' is not allowed in '@deprecated'.\ - \nSuggestion: move '@deprecated' outside of any other markup."))) |}] - - let preceded_by_paragraph = - test "foo\n@deprecated"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (2 0) (2 11)) (@deprecated)))) - (warnings ())) |}] - - let preceded_by_shorthand_list = - test "- foo\n@deprecated"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))) - ((f.ml (2 0) (2 11)) (@deprecated)))) - (warnings ())) |}] - - let with_shorthand_list = - test "@deprecated - foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 17)) - (@deprecated - ((f.ml (1 12) (1 17)) - (unordered light - ((((f.ml (1 14) (1 17)) - (paragraph (((f.ml (1 14) (1 17)) (word foo))))))))))))) - (warnings ())) |}] - - let with_shorthand_list_after_newline = - test "@deprecated\n- foo"; - [%expect - {| - ((output - (((f.ml (1 0) (2 5)) - (@deprecated - ((f.ml (2 0) (2 5)) - (unordered light - ((((f.ml (2 2) (2 5)) (paragraph (((f.ml (2 2) (2 5)) (word foo))))))))))))) - (warnings ())) |}] - - let prefix = - test "@deprecatedfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (paragraph (((f.ml (1 0) (1 14)) (word @deprecatedfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-14:\ - \nUnknown tag '@deprecatedfoo'."))) |}] - - let after_code_block = - test "{[foo]} @deprecated"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) ((f.ml (1 8) (1 19)) (@deprecated)))) - (warnings - ( "File \"f.ml\", line 1, characters 8-19:\ - \n'@deprecated' should begin on its own line."))) |}] - - let followed_by_section = - test "@deprecated foo\n{2 Bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (2 7)) - (@deprecated - ((f.ml (1 12) (1 15)) (paragraph (((f.ml (1 12) (1 15)) (word foo))))) - ((f.ml (2 0) (2 7)) (paragraph (((f.ml (2 3) (2 6)) (word Bar))))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-2:\ - \n'{2 ...}' (section heading) is not allowed in '@deprecated'.\ - \nSuggestion: move '{2' outside of any other markup."))) |}] - end in - () - -let%expect_test _ = - let module Param = struct - let basic = - test "@param foo"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@param foo)))) (warnings ())) |}] - - let bare = - test "@param"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (@param "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@param' expects parameter name on the same line."))) |}] - - let bare_with_whitespace = - test "@param"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (@param "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@param' expects parameter name on the same line."))) |}] - - let immediate_newline = - test "@param\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (@param "" - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@param' expects parameter name on the same line."))) |}] - - let followed_by_whitespace = - test "@param foo"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@param foo)))) (warnings ())) |}] - - let extra_whitespace = - test "@param foo"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@param foo)))) (warnings ())) |}] - - let words = - test "@param foo bar baz"; - [%expect - {| - ((output - (((f.ml (1 0) (1 18)) - (@param foo - ((f.ml (1 11) (1 18)) - (paragraph - (((f.ml (1 11) (1 14)) (word bar)) ((f.ml (1 14) (1 15)) space) - ((f.ml (1 15) (1 18)) (word baz))))))))) - (warnings ())) |}] - - let multiline = - test "@param foo\nbar\nbaz"; - [%expect - {| - ((output - (((f.ml (1 0) (3 3)) - (@param foo - ((f.ml (2 0) (3 3)) - (paragraph - (((f.ml (2 0) (2 3)) (word bar)) ((f.ml (2 3) (3 0)) space) - ((f.ml (3 0) (3 3)) (word baz))))))))) - (warnings ())) |}] - - let paragraphs = - test "@param foo bar\n\nbaz"; - [%expect - {| - ((output - (((f.ml (1 0) (3 3)) - (@param foo - ((f.ml (1 11) (1 14)) (paragraph (((f.ml (1 11) (1 14)) (word bar))))) - ((f.ml (3 0) (3 3)) (paragraph (((f.ml (3 0) (3 3)) (word baz))))))))) - (warnings ())) |}] - - let two = - test "@param foo\n@param bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) (@param foo)) ((f.ml (2 0) (2 10)) (@param bar)))) - (warnings ())) |}] - - let nested = - test "@param foo @param bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 21)) - (@param foo - ((f.ml (1 11) (1 21)) - (paragraph - (((f.ml (1 11) (1 21)) (word @param)) ((f.ml (1 11) (1 21)) space) - ((f.ml (1 11) (1 21)) (word bar))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 11-21:\ - \n'@param' is not allowed in '@param'.\ - \nSuggestion: move '@param' outside of any other markup."))) |}] - - let preceded_by_paragraph = - test "foo\n@param bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (2 0) (2 10)) (@param bar)))) - (warnings ())) |}] - - let prefix = - test "@paramfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (paragraph (((f.ml (1 0) (1 9)) (word @paramfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-9:\ - \nUnknown tag '@paramfoo'."))) |}] - - let after_code_block = - test "{[foo]} @param foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) ((f.ml (1 8) (1 18)) (@param foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 8-18:\ - \n'@param' should begin on its own line."))) |}] - end in - () - -let%expect_test _ = - let module Raise = struct - let basic = - test "@raise Foo"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@raise Foo)))) (warnings ())) |}] - - let bare = - test "@raise"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (@raise "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@raise' expects exception constructor on the same line."))) |}] - - let words = - test "@raise foo bar baz"; - [%expect - {| - ((output - (((f.ml (1 0) (1 18)) - (@raise foo - ((f.ml (1 11) (1 18)) - (paragraph - (((f.ml (1 11) (1 14)) (word bar)) ((f.ml (1 14) (1 15)) space) - ((f.ml (1 15) (1 18)) (word baz))))))))) - (warnings ())) |}] - - let prefix = - test "@raisefoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (paragraph (((f.ml (1 0) (1 9)) (word @raisefoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-9:\ - \nUnknown tag '@raisefoo'."))) |}] - end in - () - -let%expect_test _ = - let module Return = struct - let basic = - test "@return"; - [%expect {| ((output (((f.ml (1 0) (1 7)) (@return)))) (warnings ())) |}] - - let words = - test "@return foo bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 15)) - (@return - ((f.ml (1 8) (1 15)) - (paragraph - (((f.ml (1 8) (1 11)) (word foo)) ((f.ml (1 11) (1 12)) space) - ((f.ml (1 12) (1 15)) (word bar))))))))) - (warnings ())) |}] - - let prefix = - test "@returnfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph (((f.ml (1 0) (1 10)) (word @returnfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \nUnknown tag '@returnfoo'."))) |}] - end in - () - -let%expect_test _ = - let module See = struct - let url = - test "@see "; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@see url foo)))) (warnings ())) |}] - - let file = - test "@see 'foo'"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@see file foo)))) (warnings ())) |}] - - let document = - test "@see \"foo\""; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@see document foo)))) (warnings ())) |}] - - let bare = - test "@see"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (word @see))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'@see' should be followed by , 'file', or \"document title\"."))) |}] - - let unterminated_url = - test "@see , 'file', or \"document title\"."))) |}] - - let unterminated_file = - test "@see 'foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) - (paragraph - (((f.ml (1 0) (1 4)) (word @see)) ((f.ml (1 4) (1 5)) space) - ((f.ml (1 5) (1 9)) (word 'foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'@see' should be followed by , 'file', or \"document title\"."))) |}] - - let unterminated_document = - test "@see foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) - (paragraph - (((f.ml (1 0) (1 4)) (word @see)) ((f.ml (1 4) (1 5)) space) - ((f.ml (1 5) (1 8)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-4:\ - \n'@see' should be followed by , 'file', or \"document title\"."))) |}] - - let no_space = - test "@see"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (@see url foo)))) (warnings ())) |}] - - let words = - test "@see bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (@see url foo - ((f.ml (1 11) (1 14)) (paragraph (((f.ml (1 11) (1 14)) (word bar))))))))) - (warnings ())) |}] - - let prefix = - test "@seefoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 0) (1 7)) (word @seefoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \nUnknown tag '@seefoo'."))) |}] - - let after_code_block = - test "{[foo]} @see "; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (code_block foo)) - ((f.ml (1 8) (1 18)) (@see url foo)))) - (warnings - ( "File \"f.ml\", line 1, characters 8-18:\ - \n'@see' should begin on its own line."))) |}] - - let url_attempted_nested_closer = - test "@see bar>"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (@see url foo - ((f.ml (1 10) (1 14)) (paragraph (((f.ml (1 10) (1 14)) (word bar>))))))))) - (warnings ())) |}] - - let file_attempted_nested_closer = - test "@see 'foo'bar'"; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (@see file foo - ((f.ml (1 10) (1 14)) (paragraph (((f.ml (1 10) (1 14)) (word bar'))))))))) - (warnings ())) |}] - - let document_attempted_nested_closer = - test "@see \"foo\"bar\""; - [%expect - {| - ((output - (((f.ml (1 0) (1 14)) - (@see document foo - ((f.ml (1 10) (1 14)) - (paragraph (((f.ml (1 10) (1 14)) (word "bar\""))))))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Since = struct - let basic = - test "@since foo"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@since foo)))) (warnings ())) |}] - - let bare = - test "@since"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (@since "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@since' should not be empty."))) |}] - - let prefix = - test "@sincefoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 9)) (paragraph (((f.ml (1 0) (1 9)) (word @sincefoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-9:\ - \nUnknown tag '@sincefoo'."))) |}] - - let with_whitespace = - test "@since foo bar"; - [%expect - {| ((output (((f.ml (1 0) (1 14)) (@since "foo bar")))) (warnings ())) |}] - - let leading_whitespace = - test "@since foo"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@since foo)))) (warnings ())) |}] - - let trailing_whitespace = - test "@since foo"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@since foo)))) (warnings ())) |}] - - let whitespace_only = - test "@since"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (@since "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'@since' should not be empty."))) |}] - end in - () - -let%expect_test _ = - let module Before = struct - let basic = - test "@before Foo"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@before Foo)))) (warnings ())) |}] - - let bare = - test "@before"; - [%expect - {| - ((output (((f.ml (1 0) (1 7)) (@before "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'@before' expects version number on the same line."))) |}] - - let words = - test "@before foo bar baz"; - [%expect - {| - ((output - (((f.ml (1 0) (1 19)) - (@before foo - ((f.ml (1 12) (1 19)) - (paragraph - (((f.ml (1 12) (1 15)) (word bar)) ((f.ml (1 15) (1 16)) space) - ((f.ml (1 16) (1 19)) (word baz))))))))) - (warnings ())) |}] - - let prefix = - test "@beforefoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph (((f.ml (1 0) (1 10)) (word @beforefoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \nUnknown tag '@beforefoo'."))) |}] - end in - () - -let%expect_test _ = - let module Version = struct - let basic = - test "@version foo"; - [%expect - {| ((output (((f.ml (1 0) (1 12)) (@version foo)))) (warnings ())) |}] - - let bare = - test "@version"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (@version "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-8:\ - \n'@version' should not be empty."))) |}] - - let prefix = - test "@versionfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (paragraph (((f.ml (1 0) (1 11)) (word @versionfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-11:\ - \nUnknown tag '@versionfoo'."))) |}] - - let with_whitespace = - test "@version foo bar"; - [%expect - {| ((output (((f.ml (1 0) (1 16)) (@version "foo bar")))) (warnings ())) |}] - - let leading_whitespace = - test "@version foo"; - [%expect - {| ((output (((f.ml (1 0) (1 13)) (@version foo)))) (warnings ())) |}] - - let trailing_whitespace = - test "@version foo"; - [%expect - {| ((output (((f.ml (1 0) (1 12)) (@version foo)))) (warnings ())) |}] - - let whitespace_only = - test "@version"; - [%expect - {| - ((output (((f.ml (1 0) (1 8)) (@version "")))) - (warnings - ( "File \"f.ml\", line 1, characters 0-8:\ - \n'@version' should not be empty."))) |}] - end in - () - -let%expect_test _ = - let module Canonical = struct - let basic = - test "@canonical Foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 14)) (@canonical ((f.ml (1 11) (1 14)) Foo))))) - (warnings ())) |}] - - let empty = - test "@canonical"; - [%expect - {| - ((output (((f.ml (1 0) (1 10)) (@canonical ((f.ml (1 11) (1 10)) ""))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \n'@canonical' should not be empty."))) |}] - - let whitespace_only = - test "@canonical"; - [%expect - {| - ((output (((f.ml (1 0) (1 10)) (@canonical ((f.ml (1 11) (1 10)) ""))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \n'@canonical' should not be empty."))) |}] - - let extra_whitespace = - test "@canonical Foo"; - [%expect - {| - ((output (((f.ml (1 0) (1 15)) (@canonical ((f.ml (1 11) (1 15)) Foo))))) - (warnings ())) |}] - - let prefix = - test "@canonicalfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 13)) - (paragraph (((f.ml (1 0) (1 13)) (word @canonicalfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-13:\ - \nUnknown tag '@canonicalfoo'."))) |}] - - (* TODO This should probably be an error of some kind, as Foo Bar is not a - valid module path. *) - let with_whitespace = - test "@canonical Foo Bar"; - [%expect - {| - ((output - (((f.ml (1 0) (1 18)) (@canonical ((f.ml (1 11) (1 18)) "Foo Bar"))))) - (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Inline = struct - let basic = - test "@inline"; - [%expect {| ((output (((f.ml (1 0) (1 7)) @inline))) (warnings ())) |}] - - let prefix = - test "@inlinefoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph (((f.ml (1 0) (1 10)) (word @inlinefoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \nUnknown tag '@inlinefoo'."))) |}] - - let extra_whitespace = - test "@inline"; - [%expect {| ((output (((f.ml (1 0) (1 7)) @inline))) (warnings ())) |}] - - let followed_by_junk = - test "@inline foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @inline) - ((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-11:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags." - "File \"f.ml\", line 1, characters 8-11:\ - \nParagraph should begin on its own line."))) |}] - - let followed_by_paragraph = - test "@inline\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @inline) - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-3:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags."))) |}] - - let followed_by_tag = - test "@inline\n@deprecated"; - [%expect - {| - ((output (((f.ml (1 0) (1 7)) @inline) ((f.ml (2 0) (2 11)) (@deprecated)))) - (warnings ())) |}] - - let with_list = - test "@inline - foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @inline) - ((f.ml (1 8) (1 13)) - (unordered light - ((((f.ml (1 10) (1 13)) (paragraph (((f.ml (1 10) (1 13)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-9:\ - \n'-' (bulleted list item) should begin on its own line." - "File \"f.ml\", line 1, characters 8-9:\ - \n'-' (bulleted list item) is not allowed in the tags section.\ - \nSuggestion: move '-' (bulleted list item) before any tags."))) |}] - end in - () - -let%expect_test _ = - let module Open = struct - let basic = - test "@open"; - [%expect {| ((output (((f.ml (1 0) (1 5)) @open))) (warnings ())) |}] - - let prefix = - test "@openfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word @openfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-8:\ - \nUnknown tag '@openfoo'."))) |}] - - let extra_whitespace = - test "@open"; - [%expect {| ((output (((f.ml (1 0) (1 5)) @open))) (warnings ())) |}] - - let followed_by_junk = - test "@open foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) @open) - ((f.ml (1 6) (1 9)) (paragraph (((f.ml (1 6) (1 9)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 6-9:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags." - "File \"f.ml\", line 1, characters 6-9:\ - \nParagraph should begin on its own line."))) |}] - - let followed_by_paragraph = - test "@open\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) @open) - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-3:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags."))) |}] - - let followed_by_tag = - test "@open\n@deprecated"; - [%expect - {| - ((output (((f.ml (1 0) (1 5)) @open) ((f.ml (2 0) (2 11)) (@deprecated)))) - (warnings ())) |}] - - let with_list = - test "@open - foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) @open) - ((f.ml (1 6) (1 11)) - (unordered light - ((((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 6-7:\ - \n'-' (bulleted list item) should begin on its own line." - "File \"f.ml\", line 1, characters 6-7:\ - \n'-' (bulleted list item) is not allowed in the tags section.\ - \nSuggestion: move '-' (bulleted list item) before any tags."))) |}] - end in - () - -let%expect_test _ = - let module Closed = struct - let basic = - test "@closed"; - [%expect {| ((output (((f.ml (1 0) (1 7)) @closed))) (warnings ())) |}] - - let prefix = - test "@closedfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph (((f.ml (1 0) (1 10)) (word @closedfoo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-10:\ - \nUnknown tag '@closedfoo'."))) |}] - - let extra_whitespace = - test "@closed"; - [%expect {| ((output (((f.ml (1 0) (1 7)) @closed))) (warnings ())) |}] - - let followed_by_junk = - test "@closed foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @closed) - ((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-11:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags." - "File \"f.ml\", line 1, characters 8-11:\ - \nParagraph should begin on its own line."))) |}] - - let followed_by_paragraph = - test "@closed\nfoo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @closed) - ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 2, characters 0-3:\ - \nParagraph is not allowed in the tags section.\ - \nSuggestion: move 'foo' before any tags."))) |}] - - let followed_by_tag = - test "@closed\n@deprecated"; - [%expect - {| - ((output (((f.ml (1 0) (1 7)) @closed) ((f.ml (2 0) (2 11)) (@deprecated)))) - (warnings ())) |}] - - let with_list = - test "@closed - foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) @closed) - ((f.ml (1 8) (1 13)) - (unordered light - ((((f.ml (1 10) (1 13)) (paragraph (((f.ml (1 10) (1 13)) (word foo))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-9:\ - \n'-' (bulleted list item) should begin on its own line." - "File \"f.ml\", line 1, characters 8-9:\ - \n'-' (bulleted list item) is not allowed in the tags section.\ - \nSuggestion: move '-' (bulleted list item) before any tags."))) |}] - end in - () - -let%expect_test _ = - let module Bad_markup = struct - let left_brace = - test "{"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word {))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'."))) |}] - - let left_brace_with_letter = - test "{g"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) - (paragraph (((f.ml (1 0) (1 1)) (word {)) ((f.ml (1 1) (1 2)) (word g))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'."))) |}] - - let left_brace_with_letters = - test "{gg"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) - (paragraph - (((f.ml (1 0) (1 1)) (word {)) ((f.ml (1 1) (1 3)) (word gg))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'."))) |}] - - let empty_braces = - test "{}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word {))))) - ((f.ml (1 1) (1 2)) (paragraph (((f.ml (1 1) (1 2)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'." - "File \"f.ml\", line 1, characters 1-2:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let left_space = - test "{ foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) (paragraph (((f.ml (1 0) (1 6)) (code_span " foo"))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-6:\ - \n'{ foo}': bad markup.\ - \nSuggestion: did you mean '{! foo}' or '[ foo]'?"))) |}] - - let left_spaces = - test "{ foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph (((f.ml (1 0) (1 7)) (code_span " foo"))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'{ foo}': bad markup.\ - \nSuggestion: did you mean '{! foo}' or '[ foo]'?"))) |}] - - let left_space_eof = - test "{"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word {))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \n'{': bad markup.\ - \nSuggestion: escape the brace with '\\{'."))) |}] - - let braces_instead_of_brackets = - test "{foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) (paragraph (((f.ml (1 0) (1 5)) (code_span foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-5:\ - \n'{foo}': bad markup.\ - \nSuggestion: did you mean '{!foo}' or '[foo]'?"))) |}] - - let right_brace = - test "}"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let right_brace_in_paragraph = - test "foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (1 3) (1 4)) (paragraph (((f.ml (1 3) (1 4)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 3-4:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let multiple_right_brace = - test "foo } bar } baz"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) (paragraph (((f.ml (1 0) (1 3)) (word foo))))) - ((f.ml (1 4) (1 5)) (paragraph (((f.ml (1 4) (1 5)) (word }))))) - ((f.ml (1 6) (1 9)) (paragraph (((f.ml (1 6) (1 9)) (word bar))))) - ((f.ml (1 10) (1 11)) (paragraph (((f.ml (1 10) (1 11)) (word }))))) - ((f.ml (1 12) (1 15)) (paragraph (((f.ml (1 12) (1 15)) (word baz))))))) - (warnings - ( "File \"f.ml\", line 1, characters 4-5:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'." - "File \"f.ml\", line 1, characters 10-11:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let right_brace_in_list_item = - test "- foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (unordered light - ((((f.ml (1 2) (1 5)) (paragraph (((f.ml (1 2) (1 5)) (word foo))))))))) - ((f.ml (1 5) (1 6)) (paragraph (((f.ml (1 5) (1 6)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 5-6:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let right_brace_in_code_span = - test "[foo}]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) (paragraph (((f.ml (1 0) (1 6)) (code_span foo}))))))) - (warnings ())) |}] - - let right_brace_in_code_block = - test "{[foo}]}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (code_block foo})))) (warnings ())) |}] - - let right_brace_in_verbatim_text = - test "{v foo} v}"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (verbatim foo})))) (warnings ())) |}] - - let right_brace_in_author = - test "@author Foo}"; - [%expect - {| ((output (((f.ml (1 0) (1 12)) (@author Foo})))) (warnings ())) |}] - - let right_brace_in_deprecated = - test "@deprecated }"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) (@deprecated)) - ((f.ml (1 12) (1 13)) (paragraph (((f.ml (1 12) (1 13)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 12-13:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - - let right_bracket = - test "]"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word ]))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-1:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_paragraph = - test "foo]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph - (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) (word ]))))))) - (warnings - ( "File \"f.ml\", line 1, characters 3-4:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_shorthand_list = - test "- foo]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (unordered light - ((((f.ml (1 2) (1 6)) - (paragraph - (((f.ml (1 2) (1 5)) (word foo)) ((f.ml (1 5) (1 6)) (word ]))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 5-6:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_code_span = - test "[]]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 3)) - (paragraph - (((f.ml (1 0) (1 2)) (code_span "")) ((f.ml (1 2) (1 3)) (word ]))))))) - (warnings - ( "File \"f.ml\", line 1, characters 2-3:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_style = - test "{b]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 4)) (bold (((f.ml (1 2) (1 3)) (word ])))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 2-3:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'." - "File \"f.ml\", line 1, characters 0-2:\ - \n'{b' should be followed by space, a tab, or a new line."))) |}] - - let right_bracket_in_verbatim = - test "{v ] v}"; - [%expect - {| ((output (((f.ml (1 0) (1 7)) (verbatim ])))) (warnings ())) |}] - - let right_bracket_in_list = - test "{ul ]}"; - [%expect - {| - ((output (((f.ml (1 0) (1 6)) (unordered heavy ())))) - (warnings - ( "File \"f.ml\", line 1, characters 4-5:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'." - "File \"f.ml\", line 1, characters 4-5:\ - \n']' is not allowed in '{ul ...}' (bulleted list).\ - \nSuggestion: move ']' into a list item, '{li ...}' or '{- ...}'." - "File \"f.ml\", line 1, characters 0-3:\ - \n'{ul ...}' (bulleted list) should not be empty."))) |}] - - let right_bracket_in_list_item = - test "{ul {li ]}}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 11)) - (unordered heavy - ((((f.ml (1 8) (1 9)) (paragraph (((f.ml (1 8) (1 9)) (word ]))))))))))) - (warnings - ( "File \"f.ml\", line 1, characters 8-9:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_heading = - test "{2 ]}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) (2 (label ()) (((f.ml (1 3) (1 4)) (word ]))))))) - (warnings - ( "File \"f.ml\", line 1, characters 3-4:\ - \nUnpaired ']' (end of code).\ - \nSuggestion: try '\\]'."))) |}] - - let right_bracket_in_author = - test "@author Foo]"; - [%expect - {| ((output (((f.ml (1 0) (1 12)) (@author Foo])))) (warnings ())) |}] - - let at = - test "@"; - [%expect - {| - ((output (((f.ml (1 0) (1 1)) (paragraph (((f.ml (1 0) (1 1)) (word @))))))) - (warnings ( "File \"f.ml\", line 1, characters 0-1:\ - \nStray '@'."))) |}] - - let cr = - test ""; - [%expect {| ((output ()) (warnings ())) |}] - end in - () - -let%expect_test _ = - let module Utf_8 = struct - let lambda = - test "\xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word "\206\187"))))))) - (warnings ())) |}] - - let words = - test "\xce\xbb \xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 2)) (word "\206\187")) ((f.ml (1 2) (1 3)) space) - ((f.ml (1 3) (1 5)) (word "\206\187"))))))) - (warnings ())) |}] - - let no_validation = - test "Î"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word "\195\142"))))))) - (warnings ())) |}] - - let escapes = - test "\xce\xbb\\}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (word "\206\187}"))))))) - (warnings ())) |}] - - let newline = - test "\xce\xbb \n \xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (2 3)) - (paragraph - (((f.ml (1 0) (1 2)) (word "\206\187")) ((f.ml (1 2) (2 1)) space) - ((f.ml (2 1) (2 3)) (word "\206\187"))))))) - (warnings ())) |}] - - let paragraphs = - test "\xce\xbb \n\n \xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word "\206\187"))))) - ((f.ml (3 1) (3 3)) (paragraph (((f.ml (3 1) (3 3)) (word "\206\187"))))))) - (warnings ())) |}] - - let code_span = - test "[\xce\xbb]"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (paragraph (((f.ml (1 0) (1 4)) (code_span "\206\187"))))))) - (warnings ())) |}] - - let minus = - test "\xce\xbb-\xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph (((f.ml (1 0) (1 5)) (word "\206\187-\206\187"))))))) - (warnings ())) |}] - - let shorthand_list = - test "- \xce\xbb"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) - (unordered light - ((((f.ml (1 2) (1 4)) - (paragraph (((f.ml (1 2) (1 4)) (word "\206\187"))))))))))) - (warnings ())) |}] - - let styled = - test "{b \xce\xbb}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 6)) - (paragraph - (((f.ml (1 0) (1 6)) (bold (((f.ml (1 3) (1 5)) (word "\206\187")))))))))) - (warnings ())) |}] - - let reference_target = - test "{!\xce\xbb}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 5)) - (paragraph - (((f.ml (1 0) (1 5)) (simple ((f.ml (1 2) (1 5)) "\206\187") ()))))))) - (warnings ())) |}] - - let code_block = - test "{[\xce\xbb]}"; - [%expect - {| ((output (((f.ml (1 0) (1 6)) (code_block "\206\187")))) (warnings ())) |}] - - let verbatim = - test "{v \xce\xbb v}"; - [%expect - {| ((output (((f.ml (1 0) (1 8)) (verbatim "\206\187")))) (warnings ())) |}] - - let label = - test "{2:\xce\xbb Bar}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (2 (label ("\206\187")) (((f.ml (1 6) (1 9)) (word Bar))))))) - (warnings ())) |}] - - let author = - test "@author \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@author "\206\187")))) (warnings ())) |}] - - let param = - test "@param \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (@param "\206\187")))) (warnings ())) |}] - - let raise = - test "@raise \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (@raise "\206\187")))) (warnings ())) |}] - - let see = - test "@see <\xce\xbb>"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (@see url "\206\187")))) (warnings ())) |}] - - let since = - test "@since \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 9)) (@since "\206\187")))) (warnings ())) |}] - - let before = - test "@before \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 10)) (@before "\206\187")))) (warnings ())) |}] - - let version = - test "@version \xce\xbb"; - [%expect - {| ((output (((f.ml (1 0) (1 11)) (@version "\206\187")))) (warnings ())) |}] - - let right_brace = - test "\xce\xbb}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 2)) (paragraph (((f.ml (1 0) (1 2)) (word "\206\187"))))) - ((f.ml (1 2) (1 3)) (paragraph (((f.ml (1 2) (1 3)) (word }))))))) - (warnings - ( "File \"f.ml\", line 1, characters 2-3:\ - \nUnpaired '}' (end of markup).\ - \nSuggestion: try '\\}'."))) |}] - end in - () - -let%expect_test _ = - let module Comment_location = struct - let error_on_first_line = - test "@foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 4)) (paragraph (((f.ml (1 0) (1 4)) (word @foo))))))) - (warnings ( "File \"f.ml\", line 1, characters 0-4:\ - \nUnknown tag '@foo'."))) |}] - - let error_on_second_line = - test " \n @foo"; - [%expect - {| - ((output - (((f.ml (2 2) (2 6)) (paragraph (((f.ml (2 2) (2 6)) (word @foo))))))) - (warnings ( "File \"f.ml\", line 2, characters 2-6:\ - \nUnknown tag '@foo'."))) |}] - end in - () - -let%expect_test _ = - let module Unsupported = struct - (* test "index list" - "{!indexlist}" - (Ok []); *) - - let left_alignment = - test "{L foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 3) (1 6)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'{L ...}' (left alignment) should not be used because it has no effect."))) |}] - - let center_alignment = - test "{C foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 3) (1 6)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'{C ...}' (center alignment) should not be used because it has no effect."))) |}] - - let right_alignment = - test "{R foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 3) (1 6)) (word foo))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'{R ...}' (right alignment) should not be used because it has no effect."))) |}] - - let custom_style = - test "{c foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) - (paragraph (((f.ml (1 0) (1 7)) (code_span "c foo"))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \n'{c foo}': bad markup.\ - \nSuggestion: did you mean '{!c foo}' or '[c foo]'?"))) |}] - - let custom_tag = - test "@custom"; - [%expect - {| - ((output - (((f.ml (1 0) (1 7)) (paragraph (((f.ml (1 0) (1 7)) (word @custom))))))) - (warnings - ( "File \"f.ml\", line 1, characters 0-7:\ - \nUnknown tag '@custom'."))) |}] - - let custom_reference_kind = - test "{!custom:foo}"; - [%expect - {| - ((output - (((f.ml (1 0) (1 13)) - (paragraph - (((f.ml (1 0) (1 13)) (simple ((f.ml (1 2) (1 13)) custom:foo) ()))))))) - (warnings ())) |}] - - let html_tag = - test "foo"; - [%expect - {| - ((output - (((f.ml (1 0) (1 10)) - (paragraph (((f.ml (1 0) (1 10)) (word foo))))))) - (warnings ())) |}] - end in - () diff --git a/src/parser/token.ml b/src/parser/token.ml deleted file mode 100644 index a14a1caba9..0000000000 --- a/src/parser/token.ml +++ /dev/null @@ -1,165 +0,0 @@ -(* This module contains the token type, emitted by the lexer, and consumed by - the comment syntax parser. It also contains two functions that format tokens - for error messages. *) - -type section_heading = [ `Begin_section_heading of int * string option ] - -type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ] - -type paragraph_style = [ `Left | `Center | `Right ] - -type tag = - [ `Tag of - [ `Author of string - | `Deprecated - | `Param of string - | `Raise of string - | `Return - | `See of [ `Url | `File | `Document ] * string - | `Since of string - | `Before of string - | `Version of string - | `Canonical of string - | `Inline - | `Open - | `Closed ] ] - -type t = - [ (* End of input. *) - `End - | (* Runs of whitespace. [Blank_line] is any run of whitespace that contains two - or more newline characters. [Single_newline] is any run of whitespace that - contains exactly one newline character. [Space] is any run of whitespace - that contains no newline characters. - - It is an important invariant in the parser that no adjacent whitespace - tokens are emitted by the lexer. Otherwise, there would be the need for - unbounded lookahead, a (co-?)ambiguity between - [Single_newline Single_newline] and [Blank_line], and other problems. *) - `Space of - string - | `Single_newline of string - | `Blank_line of string - | (* A right curly brace ([}]), i.e. end of markup. *) - `Right_brace - | (* Words are anything that is not whitespace or markup. Markup symbols can be - be part of words if escaped. - - Words can contain plus and minus symbols, but those are emitted as [Plus] - and [Minus] tokens. The parser combines plus and minus into words, except - when they appear first on a line, in which case the tokens are list item - bullets. *) - `Word of - string - | `Code_span of string - | `Raw_markup of string option * string - | `Begin_style of style - | `Begin_paragraph_style of paragraph_style - | (* Other inline element markup. *) - `Simple_reference of string - | `Begin_reference_with_replacement_text of string - | `Simple_link of string - | `Begin_link_with_replacement_text of string - | (* Leaf block element markup. *) - `Code_block of string option * string - | `Verbatim of string - | `Modules of string - | (* List markup. *) - `Begin_list of [ `Unordered | `Ordered ] - | `Begin_list_item of [ `Li | `Dash ] - | `Minus - | `Plus - | section_heading - | tag ] - -let print : [< t ] -> string = function - | `Begin_paragraph_style `Left -> "'{L'" - | `Begin_paragraph_style `Center -> "'{C'" - | `Begin_paragraph_style `Right -> "'{R'" - | `Begin_style `Bold -> "'{b'" - | `Begin_style `Italic -> "'{i'" - | `Begin_style `Emphasis -> "'{e'" - | `Begin_style `Superscript -> "'{^'" - | `Begin_style `Subscript -> "'{_'" - | `Begin_reference_with_replacement_text _ -> "'{{!'" - | `Begin_link_with_replacement_text _ -> "'{{:'" - | `Begin_list_item `Li -> "'{li ...}'" - | `Begin_list_item `Dash -> "'{- ...}'" - | `Minus -> "'-'" - | `Plus -> "'+'" - | `Begin_section_heading (level, label) -> - let label = match label with None -> "" | Some label -> ":" ^ label in - Printf.sprintf "'{%i%s'" level label - | `Tag (`Author _) -> "'@author'" - | `Tag `Deprecated -> "'@deprecated'" - | `Tag (`Param _) -> "'@param'" - | `Tag (`Raise _) -> "'@raise'" - | `Tag `Return -> "'@return'" - | `Tag (`See _) -> "'@see'" - | `Tag (`Since _) -> "'@since'" - | `Tag (`Before _) -> "'@before'" - | `Tag (`Version _) -> "'@version'" - | `Tag (`Canonical _) -> "'@canonical'" - | `Tag `Inline -> "'@inline'" - | `Tag `Open -> "'@open'" - | `Tag `Closed -> "'@closed'" - | `Raw_markup (None, _) -> "'{%...%}'" - | `Raw_markup (Some target, _) -> "'{%" ^ target ^ ":...%}'" - -(* [`Minus] and [`Plus] are interpreted as if they start list items. Therefore, - for error messages based on [Token.describe] to be accurate, formatted - [`Minus] and [`Plus] should always be plausibly list item bullets. *) -let describe : [< t | `Comment ] -> string = function - | `Word w -> Printf.sprintf "'%s'" w - | `Code_span _ -> "'[...]' (code)" - | `Raw_markup _ -> "'{%...%}' (raw markup)" - | `Begin_paragraph_style `Left -> "'{L ...}' (left alignment)" - | `Begin_paragraph_style `Center -> "'{C ...}' (center alignment)" - | `Begin_paragraph_style `Right -> "'{R ...}' (right alignment)" - | `Begin_style `Bold -> "'{b ...}' (boldface text)" - | `Begin_style `Italic -> "'{i ...}' (italic text)" - | `Begin_style `Emphasis -> "'{e ...}' (emphasized text)" - | `Begin_style `Superscript -> "'{^...}' (superscript)" - | `Begin_style `Subscript -> "'{_...}' (subscript)" - | `Simple_reference _ -> "'{!...}' (cross-reference)" - | `Begin_reference_with_replacement_text _ -> - "'{{!...} ...}' (cross-reference)" - | `Simple_link _ -> "'{:...} (external link)'" - | `Begin_link_with_replacement_text _ -> "'{{:...} ...}' (external link)" - | `End -> "end of text" - | `Space _ -> "whitespace" - | `Single_newline _ -> "line break" - | `Blank_line _ -> "blank line" - | `Right_brace -> "'}'" - | `Code_block _ -> "'{[...]}' (code block)" - | `Verbatim _ -> "'{v ... v}' (verbatim text)" - | `Modules _ -> "'{!modules ...}'" - | `Begin_list `Unordered -> "'{ul ...}' (bulleted list)" - | `Begin_list `Ordered -> "'{ol ...}' (numbered list)" - | `Begin_list_item `Li -> "'{li ...}' (list item)" - | `Begin_list_item `Dash -> "'{- ...}' (list item)" - | `Minus -> "'-' (bulleted list item)" - | `Plus -> "'+' (numbered list item)" - | `Begin_section_heading (level, _) -> - Printf.sprintf "'{%i ...}' (section heading)" level - | `Tag (`Author _) -> "'@author'" - | `Tag `Deprecated -> "'@deprecated'" - | `Tag (`Param _) -> "'@param'" - | `Tag (`Raise _) -> "'@raise'" - | `Tag `Return -> "'@return'" - | `Tag (`See _) -> "'@see'" - | `Tag (`Since _) -> "'@since'" - | `Tag (`Before _) -> "'@before'" - | `Tag (`Version _) -> "'@version'" - | `Tag (`Canonical _) -> "'@canonical'" - | `Tag `Inline -> "'@inline'" - | `Tag `Open -> "'@open'" - | `Tag `Closed -> "'@closed'" - | `Comment -> "top-level text" - -let describe_element = function - | `Reference (`Simple, _, _) -> describe (`Simple_reference "") - | `Reference (`With_text, _, _) -> - describe (`Begin_reference_with_replacement_text "") - | `Link _ -> describe (`Begin_link_with_replacement_text "") - | `Heading (level, _, _) -> describe (`Begin_section_heading (level, None)) diff --git a/src/parser/warning.ml b/src/parser/warning.ml deleted file mode 100644 index 41b8037581..0000000000 --- a/src/parser/warning.ml +++ /dev/null @@ -1,27 +0,0 @@ -type t = { location : Loc.span; message : string } - -let to_string e = - let { location; message } = e in - let location_string = - if location.start.line = location.end_.line then - Printf.sprintf "line %i, characters %i-%i" location.start.line - location.start.column location.end_.column - else - Printf.sprintf "line %i, character %i to line %i, character %i" - location.start.line location.start.column location.end_.line - location.end_.column - in - Printf.sprintf "File \"%s\", %s:\n%s" location.file location_string message - -let kasprintf k fmt = - Format.(kfprintf (fun _ -> k (flush_str_formatter ())) str_formatter fmt) - -let kmake k ?suggestion = - kasprintf (fun message -> - match suggestion with - | None -> k message - | Some suggestion -> k (message ^ "\nSuggestion: " ^ suggestion)) - -let make ?suggestion format = - let k message location = { location; message } in - kmake k ?suggestion format diff --git a/src/parser/warning.mli b/src/parser/warning.mli deleted file mode 100644 index baf28eff78..0000000000 --- a/src/parser/warning.mli +++ /dev/null @@ -1,10 +0,0 @@ -(* This module is exposed, but via the signature declared in Odoc_parser *) - -type t = { location : Loc.span; message : string } - -val to_string : t -> string - -val make : - ?suggestion:string -> - ('a, Format.formatter, unit, Loc.span -> t) format4 -> - 'a diff --git a/test/xref2/lib/dune b/test/xref2/lib/dune index 0821b0505c..f4a4a45781 100644 --- a/test/xref2/lib/dune +++ b/test/xref2/lib/dune @@ -11,6 +11,11 @@ (name odoc_xref_test) (public_name odoc.xref_test) (modes byte) - (libraries tyxml compiler-libs.toplevel compiler-libs.common odoc_xref2 - odoc_odoc odoc_model) + (libraries + tyxml + compiler-libs.toplevel + compiler-libs.common + odoc_xref2 + odoc_odoc + odoc_model) (modules common)) diff --git a/test/xref2/refs/dune b/test/xref2/refs/dune index 912f9653f9..90d6d849f0 100644 --- a/test/xref2/refs/dune +++ b/test/xref2/refs/dune @@ -5,8 +5,12 @@ (deps (package odoc)) (action - (run ocaml-mdx-test --prelude=%{dep:../lib/prelude.ml} -o %{targets} - %{dep:refs.md}))) + (run + ocaml-mdx-test + --prelude=%{dep:../lib/prelude.ml} + -o + %{targets} + %{dep:refs.md}))) (rule (alias runmdx) diff --git a/test/xref2/resolve/dune b/test/xref2/resolve/dune index b288fe3d1e..d08d57dabb 100644 --- a/test/xref2/resolve/dune +++ b/test/xref2/resolve/dune @@ -3,8 +3,12 @@ (deps (package odoc)) (action - (run ocaml-mdx-test --prelude=%{dep:../lib/prelude.ml} -o %{targets} - %{dep:test.md}))) + (run + ocaml-mdx-test + --prelude=%{dep:../lib/prelude.ml} + -o + %{targets} + %{dep:test.md}))) (rule (alias runmdx) diff --git a/test/xref2/strengthen/dune b/test/xref2/strengthen/dune index 785bd7ed23..c8efc6952f 100644 --- a/test/xref2/strengthen/dune +++ b/test/xref2/strengthen/dune @@ -3,8 +3,12 @@ (deps (package odoc)) (action - (run ocaml-mdx-test --prelude=%{dep:../lib/prelude.ml} -o %{targets} - %{dep:test.md}))) + (run + ocaml-mdx-test + --prelude=%{dep:../lib/prelude.ml} + -o + %{targets} + %{dep:test.md}))) (rule (alias runmdx) diff --git a/test/xref2/subst/dune b/test/xref2/subst/dune index 95ce1a41b0..f986482230 100644 --- a/test/xref2/subst/dune +++ b/test/xref2/subst/dune @@ -3,8 +3,12 @@ (deps (package odoc)) (action - (run ocaml-mdx-test --prelude=%{dep:../lib/prelude.ml} -o %{targets} - %{dep:test.md}))) + (run + ocaml-mdx-test + --prelude=%{dep:../lib/prelude.ml} + -o + %{targets} + %{dep:test.md}))) (rule (alias runmdx)