ocaml · gasche · Apr 22, 2021 · Apr 20, 2021
diff --git a/Changes b/Changes
@@ -172,6 +172,9 @@ Working version
 
 ### Tools:
 
+- #8645, #10363: ocamldoc: escape `<`, `>`, and `&` in html backend.
+  (Florian Angeletti, report by Wim Lewis, review by Gabriel Scherer)
+
 - #10139: Remove confusing navigation bar from stdlib documentation.
   Adds a -nonavbar option to ocamldoc, and uses it to improve navigation within
   the reference manual.

diff --git a/ocamldoc/odoc_html.ml b/ocamldoc/odoc_html.ml
@@ -816,12 +816,17 @@ let print_concat b sep f =
   in
   iter
 
-let newline_to_indented_br s =
+
+(** Escape "\n", "<", ">", and "&" *)
+let text_to_html s =
   let len = String.length s in
   let b = Buffer.create len in
   for i = 0 to len - 1 do
     match s.[i] with
-      '\n' -> Buffer.add_string b "<br>     "
+    | '\n' -> Buffer.add_string b "<br>     "
+    | '<' -> Buffer.add_string b "&lt;"
+    | '>' -> Buffer.add_string b "&gt;"
+    | '&' -> Buffer.add_string b "&amp;"
     | c -> Buffer.add_char b c
   done;
   Buffer.contents b
@@ -1307,7 +1312,7 @@ class html =
     (** Print html code to display a [Types.type_expr]. *)
     method html_of_type_expr b m_name t =
       let s = Odoc_info.remove_ending_newline (Odoc_info.string_of_type_expr t) in
-      let s2 = newline_to_indented_br s in
+      let s2 = text_to_html s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
@@ -1317,7 +1322,7 @@ class html =
       match l with
       | Cstr_tuple l ->
           let s = Odoc_info.string_of_type_list ?par sep l in
-          let s2 = newline_to_indented_br s in
+          let s2 = text_to_html s in
           bs b "<code class=\"type\">";
           bs b (self#create_fully_qualified_idents_links m_name s2);
           bs b "</code>"
@@ -1331,23 +1336,23 @@ class html =
        of a class of class type. *)
     method html_of_class_type_param_expr_list b m_name l =
       let s = Odoc_info.string_of_class_type_param_list l in
-      let s2 = newline_to_indented_br s in
+      let s2 = text_to_html s in
       bs b "<code class=\"type\">[";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "]</code>"
 
     method html_of_class_parameter_list b father c =
       let s = Odoc_info.string_of_class_params c in
       let s = Odoc_info.remove_ending_newline s in
-      let s2 = newline_to_indented_br s in
+      let s2 = text_to_html s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links father s2);
       bs b "</code>"
 
     (** Print html code to display a list of type parameters for the given type.*)
     method html_of_type_expr_param_list b m_name t =
       let s = Odoc_info.string_of_type_param_list t in
-      let s2 = newline_to_indented_br s in
+      let s2 = text_to_html s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>"
@@ -1563,7 +1568,7 @@ class html =
       bs b "<pre><code>";
       bs b ((self#keyword "type")^" ");
       let s = Odoc_info.string_of_type_extension_param_list te in
-      let s2 = newline_to_indented_br s in
+      let s2 = text_to_html s in
       bs b "<code class=\"type\">";
       bs b (self#create_fully_qualified_idents_links m_name s2);
       bs b "</code>";

diff --git a/testsuite/tests/tool-ocamldoc/Entities.html.reference b/testsuite/tests/tool-ocamldoc/Entities.html.reference
@@ -0,0 +1,40 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
+<html>
+<head>
+<link rel="stylesheet" href="style.css" type="text/css">
+<meta content="text/html; charset=iso-8859-1" http-equiv="Content-Type">
+<meta name="viewport" content="width=device-width, initial-scale=1">
+<link rel="Start" href="index.html">
+<link rel="Up" href="index.html">
+<link title="Index of types" rel=Appendix href="index_types.html">
+<link title="Index of modules" rel=Appendix href="index_modules.html">
+<link title="Entities" rel="Chapter" href="Entities.html"><title>Entities</title>
+</head>
+<body>
+<div class="navbar">&nbsp;<a class="up" href="index.html" title="Index">Up</a>
+&nbsp;</div>
+<h1>Module <a href="type_Entities.html">Entities</a></h1>
+
+<pre><span id="MODULEEntities"><span class="keyword">module</span> Entities</span>: <code class="code"><span class="keyword">sig</span></code> <a href="Entities.html">..</a> <code class="code"><span class="keyword">end</span></code></pre><hr width="100%">
+
+<pre><span id="TYPEul"><span class="keyword">type</span> <code class="type"></code>ul</span> </pre>
+
+
+<pre><span id="TYPEli"><span class="keyword">type</span> <code class="type"></code>li</span> </pre>
+
+
+<pre><span id="TYPEamp"><span class="keyword">type</span> <code class="type"></code>amp</span> </pre>
+
+
+<pre><span id="TYPEt"><span class="keyword">type</span> <code class="type">[&lt; `A of &amp; <a href="Entities.html#TYPEamp">amp</a> ]</code> t</span> = &lt;</pre><table class="typetable">
+<tr>
+<td align="left" valign="top" >
+<code>&nbsp;&nbsp;</code></td>
+<td align="left" valign="top" >
+<code><span id="TYPEELTt.ul">ul</span>&nbsp;: <code class="type">&lt; li : [&lt; `A of &amp; <a href="Entities.html#TYPEamp">amp</a> ] as 'a &gt;</code>;</code></td>
+
+</tr></table>
+>
+ </pre>
+
+</body></html>
diff --git a/testsuite/tests/tool-ocamldoc/Entities.ml b/testsuite/tests/tool-ocamldoc/Entities.ml
@@ -0,0 +1,8 @@
+(* TEST
+   * ocamldoc with html
+*)
+
+type ul
+type li
+type amp
+type 'a t = <ul: <li:[<`A of &amp] as 'a> >
diff --git a/testsuite/tests/tool-ocamldoc/Inline_records.html.reference b/testsuite/tests/tool-ocamldoc/Inline_records.html.reference
@@ -299,7 +299,7 @@
 <td align="left" valign="top" >
 <code>&nbsp;&nbsp;</code></td>
 <td align="left" valign="top" >
-<code><span id="TYPEELTInline_records.F.even_more">even_more</span>&nbsp;: <code class="type">int -> int</code>;</code></td>
+<code><span id="TYPEELTInline_records.F.even_more">even_more</span>&nbsp;: <code class="type">int -&gt; int</code>;</code></td>
 <td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
 <div class="info-desc">
 <p>Some field documentations for <code class="code"><span class="constructor">F</span></code></p>
@@ -325,7 +325,7 @@
 <td align="left" valign="top" >
 <code>&nbsp;&nbsp;</code></td>
 <td align="left" valign="top" >
-<code><span id="TYPEELTInline_records.G.last">last</span>&nbsp;: <code class="type">int -> int</code>;</code></td>
+<code><span id="TYPEELTInline_records.G.last">last</span>&nbsp;: <code class="type">int -&gt; int</code>;</code></td>
 <td class="typefieldcomment" align="left" valign="top" ><code>(*</code></td><td class="typefieldcomment" align="left" valign="top" ><div class="info ">
 <div class="info-desc">
 <p>The last and least field documentation</p>

diff --git a/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference b/testsuite/tests/tool-ocamldoc/Module_whitespace.html.reference
@@ -20,5 +20,5 @@
 <pre><span id="TYPEt"><span class="keyword">type</span> <code class="type"></code>t</span> = <code class="type">int</code> </pre>
 
 
-<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -> 'a -> int</code></pre></div>
+<pre><span id="VALcompare"><span class="keyword">val</span> compare</span> : <code class="type">'a -&gt; 'a -&gt; int</code></pre></div>
 <pre><code class="code"><span class="keyword">end</span></code><code class="code">)</code></pre></body></html>