Media: Fix loc and tests for media alt text

Author: panglesd

src/parser/loc.ml

@@ -23,6 +23,9 @@ let span spans =
 let nudge_start offset span =
   { span with start = { span.start with column = span.start.column + offset } }
 
+let nudge_end offset span =
+  { span with end_ = { span.end_ with column = span.end_.column - offset } }
+
 let spans_multiple_lines = function
   | {
       location =

src/parser/loc.mli

@@ -19,6 +19,10 @@ 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 nudge_end : int -> span -> span
+(** This adjusts only the column number, implicitly assuming that the offset does
+   not move the location across a newline character. *)
+
 (** {2 Located values} *)
 
 type +'a with_location = { location : span; value : 'a }

src/parser/syntax.ml

@@ -1159,11 +1159,22 @@ let rec block_element_list :
           Loc.nudge_start
             (String.length @@ Token.s_of_media `Replaced media)
             location
+          |> Loc.nudge_end (String.length content + 1)
+          (* +1 for closing character *)
         in
+        let c_location =
+          Loc.nudge_start
+            (String.length (Token.s_of_media `Replaced media)
+            + String.length (match href with `Reference s | `Link s -> s))
+            location
+          |> Loc.nudge_end 1
+        in
+        let content = String.trim content in
         let href = href |> Loc.at r_location in
 
         if content = "" then
-          Parse_error.should_not_be_empty ~what:(Token.describe token) location
+          Parse_error.should_not_be_empty ~what:(Token.describe token)
+            c_location
           |> add_warning input;
 
         let block = `Media (`Simple, href, content, media) in
@@ -1178,8 +1189,9 @@ let rec block_element_list :
 
         let r_location =
           Loc.nudge_start
-            (String.length @@ Token.s_of_media `Replaced media)
+            (String.length @@ Token.s_of_media `Simple media)
             location
+          |> Loc.nudge_end 1
         in
         let href = href |> Loc.at r_location in
         let block = `Media (`Simple, href, "", media) in

src/parser/test/test.ml

@@ -1973,6 +1973,206 @@ let%expect_test _ =
   end in
   ()
 
+let%expect_test _ =
+  let module Medias = struct
+    let basic_simple =
+      test
+        "{image!foo}\n\n\
+         {audio!foo}\n\n\
+         {video!foo}\n\n\
+         {image:foo}\n\n\
+         {audio:foo}\n\n\
+         {video:foo}";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 11))
+            (simple ((f.ml (1 7) (1 10)) (Reference foo)) "" image))
+           ((f.ml (3 0) (3 11))
+            (simple ((f.ml (3 7) (3 10)) (Reference foo)) "" audio))
+           ((f.ml (5 0) (5 11))
+            (simple ((f.ml (5 7) (5 10)) (Reference foo)) "" video))
+           ((f.ml (7 0) (7 11)) (simple ((f.ml (7 7) (7 10)) (Link foo)) "" image))
+           ((f.ml (9 0) (9 11)) (simple ((f.ml (9 7) (9 10)) (Link foo)) "" audio))
+           ((f.ml (11 0) (11 11))
+            (simple ((f.ml (11 7) (11 10)) (Link foo)) "" video))))
+         (warnings ())) |}]
+
+    let basic =
+      test
+        "{{image!foo}bar}\n\n\
+         {{audio!foo}bar}\n\n\
+         {{video!foo}bar}\n\n\
+         {{image:foo}bar}\n\n\
+         {{audio:foo}bar}\n\n\
+         {{video:foo}bar}";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 16))
+            (simple ((f.ml (1 8) (1 12)) (Reference foo)) bar image))
+           ((f.ml (3 0) (3 16))
+            (simple ((f.ml (3 8) (3 12)) (Reference foo)) bar audio))
+           ((f.ml (5 0) (5 16))
+            (simple ((f.ml (5 8) (5 12)) (Reference foo)) bar video))
+           ((f.ml (7 0) (7 16)) (simple ((f.ml (7 8) (7 12)) (Link foo)) bar image))
+           ((f.ml (9 0) (9 16)) (simple ((f.ml (9 8) (9 12)) (Link foo)) bar audio))
+           ((f.ml (11 0) (11 16))
+            (simple ((f.ml (11 8) (11 12)) (Link foo)) bar video))))
+         (warnings ())) |}]
+
+    let empty =
+      test "{{image!foo}}";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 13))
+               (simple ((f.ml (1 8) (1 12)) (Reference foo)) "" image))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 11-12:\
+              \n'{{image!...} ...}' (image-reference) should not be empty."))) |}]
+
+    let whitespace =
+      test "{{image!foo}   }";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 16))
+               (simple ((f.ml (1 8) (1 12)) (Reference foo)) "" image))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 11-15:\
+              \n'{{image!...} ...}' (image-reference) should not be empty."))) |}]
+
+    let trimming =
+      test "{{image!foo}    hello     }";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 27))
+               (simple ((f.ml (1 8) (1 12)) (Reference foo)) hello image))))
+            (warnings ())) |}]
+
+    let nested_markup_is_uninterpreted =
+      test "{{image!foo}{b bar}}";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 20))
+               (simple ((f.ml (1 8) (1 12)) (Reference foo)) "{b bar}" image))))
+            (warnings ())) |}]
+
+    let in_markup =
+      test "{ul {li {{image!foo}bar}}}";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 26))
+               (unordered heavy
+                ((((f.ml (1 8) (1 24))
+                   (simple ((f.ml (1 16) (1 20)) (Reference foo)) bar image))))))))
+            (warnings ())) |}]
+
+    let unterminated_image =
+      test "{{image!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 11))
+               (simple ((f.ml (1 8) (1 10)) (Reference foo)) "" image))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-11:\
+              \nOpen bracket '{{image!' is never closed."
+               "File \"f.ml\", line 1, characters 11-11:\
+              \nEnd of text is not allowed in '{{image!...} ...}' (image-reference)."
+               "File \"f.ml\", line 1, characters 11-10:\
+              \n'{{image!...} ...}' (image-reference) should not be empty."))) |}]
+
+    let unterminated_image_simple =
+      test "{image!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 10))
+               (simple ((f.ml (1 7) (1 9)) (Reference foo)) "" image))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-10:\
+              \nOpen bracket '{image!' is never closed."))) |}]
+
+    let unterminated_video =
+      test "{{video!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 11))
+               (simple ((f.ml (1 8) (1 10)) (Reference foo)) "" video))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-11:\
+              \nOpen bracket '{{video!' is never closed."
+               "File \"f.ml\", line 1, characters 11-11:\
+              \nEnd of text is not allowed in '{{video!...} ...}' (video-reference)."
+               "File \"f.ml\", line 1, characters 11-10:\
+              \n'{{video!...} ...}' (video-reference) should not be empty."))) |}]
+
+    let unterminated_video_simple =
+      test "{video!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 10))
+               (simple ((f.ml (1 7) (1 9)) (Reference foo)) "" video))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-10:\
+              \nOpen bracket '{video!' is never closed."))) |}]
+
+    let unterminated_audio =
+      test "{{audio!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 11))
+               (simple ((f.ml (1 8) (1 10)) (Reference foo)) "" audio))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-11:\
+              \nOpen bracket '{{audio!' is never closed."
+               "File \"f.ml\", line 1, characters 11-11:\
+              \nEnd of text is not allowed in '{{audio!...} ...}' (audio-reference)."
+               "File \"f.ml\", line 1, characters 11-10:\
+              \n'{{audio!...} ...}' (audio-reference) should not be empty."))) |}]
+
+    let unterminated_audio_simple =
+      test "{audio!foo";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 10))
+               (simple ((f.ml (1 7) (1 9)) (Reference foo)) "" audio))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 0-10:\
+              \nOpen bracket '{audio!' is never closed."))) |}]
+
+    let unterminated_content =
+      test "{{image!foo} bar";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (1 16))
+               (simple ((f.ml (1 8) (1 11)) (Reference foo)) bar image))))
+            (warnings
+             ( "File \"f.ml\", line 1, characters 16-16:\
+              \nEnd of text is not allowed in '{{image!...} ...}' (image-reference)."))) |}]
+
+    let newline_in_content =
+      test "{{image!foo} bar \n baz}";
+      [%expect
+        {|
+           ((output
+             (((f.ml (1 0) (2 5))
+               (simple ((f.ml (1 8) (2 -6)) (Reference foo))  "bar \
+                                                             \n baz" image))))
+            (warnings ())) |}]
+  end in
+  ()
+
 let%expect_test _ =
   let module Link = struct
     let basic =

test/pages/medias.t/run.t

@@ -29,7 +29,7 @@ Testing the working references:
         <a href="caml.gif" class="img-link">
          <img src="caml.gif" alt="caml.gif"/>
         <a href="caml.gif" class="img-link">
-         <img src="caml.gif" alt="With alt text and emphasis"/>
+         <img src="caml.gif" alt="With alt text and {b emphasis}"/>
         <a href="https://picsum.photos/200/300" class="img-link">
          <img src="https://picsum.photos/200/300" alt="reference"/>
         <a href="https://picsum.photos/200/300" class="img-link">
@@ -53,21 +53,21 @@ Testing the working references:
 Testing the unresolved references:
 
   $ cat html/pkg1/doc/index.html | grep xref-unresolved
-       <div><span class="xref-unresolved"><code>./caqzdqzdml.gif</code></span>
-        <span class="xref-unresolved">With alt text and <b>emphasis</b></span>
-       <div><span class="xref-unresolved"><code>./module-x</code></span></div>
+       <div><span class="xref-unresolved">./caqzdqzdml.gif</span></div>
+       <div><span class="xref-unresolved">With alt text and {b emphasis}</span>
+       <div><span class="xref-unresolved">./module-x</span></div>
 
 Testing latex and manpages
 
   $ odoc latex-generate -o latex _odoc/pkg1/doc/page-index.odocl
   $ cat latex/pkg1/doc/index.tex | grep gif
-  \ocamlinlinecode{caml.\allowbreak{}gif}
-  \ocamlinlinecode{.\allowbreak{}/caqzdqzdml.\allowbreak{}gif}
+  caml.gif
+  ./caqzdqzdml.gif
 
   $ odoc man-generate -o man _odoc/pkg1/doc/page-index.odocl
   $ cat man/pkg1/doc/index.3o | grep gif
   caml\.gif
   \./caqzdqzdml\.gif
   $ cat man/pkg1/doc/index.3o | grep "With alt text"
-  With alt text and \fBemphasis\fR
-  With alt text and \fBemphasis\fR
+  With alt text and {b emphasis}
+  With alt text and {b emphasis}