ocaml · Julow · Dec 5, 2023 · Nov 27, 2023 · Dec 5, 2023
diff --git a/CHANGES.md b/CHANGES.md
@@ -17,6 +17,7 @@ Tags:
 
 ### Fixed
 
+- Fix crash on functors returning an alias (@Julow, #1046)
 - Fix rendering of polymorphic variants (@wikku, @panglesd, #971)
 - Add references to extension declarations (@gpetiot, @panglesd, #949)
 

diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml
@@ -938,7 +938,9 @@ let rec read_module_type env parent (mty : Odoc_model.Compat.module_type) =
         in
         let res = read_module_type env (Identifier.Mk.result parent) res in
         Functor( f_parameter, res)
-    | Mty_alias _ -> assert false
+    | Mty_alias p ->
+        let t_desc = ModPath (Env.Path.read_module env p) in
+        TypeOf { t_desc; t_expansion = None }
 
 and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_declaration) =
   let open ModuleType in

diff --git a/test/generators/cases/functor_ml.ml b/test/generators/cases/functor_ml.ml
@@ -0,0 +1,13 @@
+module Foo (X : sig
+  val foo : int
+end) =
+  String
+
+module Bar = struct
+  type t
+end
+
+module Foo' (X : sig
+  val foo : int
+end) =
+  Bar
diff --git a/test/generators/html/Functor_ml-Bar.html b/test/generators/html/Functor_ml-Bar.html
@@ -0,0 +1,26 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Bar (Functor_ml.Bar)</title>
+  <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
+  <meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <nav class="odoc-nav"><a href="Functor_ml.html">Up</a> – 
+   <a href="Functor_ml.html">Functor_ml</a> &#x00BB; Bar
+  </nav>
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Functor_ml.Bar</span></code></h1>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec type anchored" id="type-t">
+     <a href="#type-t" class="anchor"></a>
+     <code><span><span class="keyword">type</span> t</span></code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>
diff --git a/test/generators/html/Functor_ml-Foo'-argument-1-X.html b/test/generators/html/Functor_ml-Foo'-argument-1-X.html
@@ -0,0 +1,27 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>X (Functor_ml.Foo'.X)</title>
+  <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
+  <meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <nav class="odoc-nav"><a href="Functor_ml-Foo'.html">Up</a> – 
+   <a href="Functor_ml.html">Functor_ml</a> &#x00BB; 
+   <a href="Functor_ml-Foo'.html">Foo'</a> &#x00BB; X
+  </nav>
+  <header class="odoc-preamble">
+   <h1>Parameter <code><span>Foo'.X</span></code></h1>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec value anchored" id="val-foo">
+     <a href="#val-foo" class="anchor"></a>
+     <code><span><span class="keyword">val</span> foo : int</span></code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>
diff --git a/test/generators/html/Functor_ml-Foo'.html b/test/generators/html/Functor_ml-Foo'.html
@@ -0,0 +1,47 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Foo' (Functor_ml.Foo')</title>
+  <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
+  <meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <nav class="odoc-nav"><a href="Functor_ml.html">Up</a> – 
+   <a href="Functor_ml.html">Functor_ml</a> &#x00BB; Foo'
+  </nav>
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Functor_ml.Foo'</span></code></h1>
+  </header>
+  <nav class="odoc-toc">
+   <ul><li><a href="#parameters">Parameters</a></li>
+    <li><a href="#signature">Signature</a></li>
+   </ul>
+  </nav>
+  <div class="odoc-content">
+   <h2 id="parameters"><a href="#parameters" class="anchor"></a>Parameters
+   </h2>
+   <div class="odoc-spec">
+    <div class="spec parameter anchored" id="argument-1-X">
+     <a href="#argument-1-X" class="anchor"></a>
+     <code><span><span class="keyword">module</span> </span>
+      <span><a href="Functor_ml-Foo'-argument-1-X.html">X</a></span>
+      <span> : <span class="keyword">sig</span> ... 
+       <span class="keyword">end</span>
+      </span>
+     </code>
+    </div>
+   </div>
+   <h2 id="signature"><a href="#signature" class="anchor"></a>Signature</h2>
+   <div class="odoc-spec">
+    <div class="spec type anchored" id="type-t">
+     <a href="#type-t" class="anchor"></a>
+     <code><span><span class="keyword">type</span> t</span>
+      <span> = <a href="Functor_ml-Bar.html#type-t">Bar.t</a></span>
+     </code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>
diff --git a/test/generators/html/Functor_ml.html b/test/generators/html/Functor_ml.html
@@ -0,0 +1,58 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Functor_ml (Functor_ml)</title>
+  <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
+  <meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Functor_ml</span></code></h1>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec module anchored" id="module-Foo">
+     <a href="#module-Foo" class="anchor"></a>
+     <code><span><span class="keyword">module</span> Foo</span>
+      <span> (<a href="Functor_ml-Foo-argument-1-X.html">X</a> : 
+       <span class="keyword">sig</span> ... <span class="keyword">end</span>
+       ) : <span class="keyword">module</span> 
+       <span class="keyword">type</span> <span class="keyword">of</span>
+        <span class="xref-unresolved">Stdlib</span>.String
+      </span>
+     </code>
+    </div>
+   </div>
+   <div class="odoc-spec">
+    <div class="spec module anchored" id="module-Bar">
+     <a href="#module-Bar" class="anchor"></a>
+     <code>
+      <span><span class="keyword">module</span> 
+       <a href="Functor_ml-Bar.html">Bar</a>
+      </span>
+      <span> : <span class="keyword">sig</span> ... 
+       <span class="keyword">end</span>
+      </span>
+     </code>
+    </div>
+   </div>
+   <div class="odoc-spec">
+    <div class="spec module anchored" id="module-Foo'">
+     <a href="#module-Foo'" class="anchor"></a>
+     <code>
+      <span><span class="keyword">module</span> 
+       <a href="Functor_ml-Foo'.html">Foo'</a>
+      </span>
+      <span> (<a href="Functor_ml-Foo'-argument-1-X.html">X</a> : 
+       <span class="keyword">sig</span> ... <span class="keyword">end</span>
+       ) : <span class="keyword">sig</span> ... 
+       <span class="keyword">end</span>
+      </span>
+     </code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>
diff --git a/test/generators/html/functor_ml.targets b/test/generators/html/functor_ml.targets
@@ -0,0 +1,4 @@
+Functor_ml.html
+Functor_ml-Bar.html
+Functor_ml-Foo'.html
+Functor_ml-Foo'-argument-1-X.html
diff --git a/test/generators/latex/Functor_ml.Foo'.tex b/test/generators/latex/Functor_ml.Foo'.tex
@@ -0,0 +1,9 @@
+\section{Module \ocamlinlinecode{Functor\_\allowbreak{}ml.\allowbreak{}Foo'}}\label{module-Functor_ml-module-Foo'}%
+\subsection{Parameters\label{parameters}}%
+\label{module-Functor_ml-module-Foo'-argument-1-X}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Functor_ml-module-Foo'-argument-1-X]{\ocamlinlinecode{X}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Functor_ml-module-Foo'-argument-1-X-val-foo}\ocamlcodefragment{\ocamltag{keyword}{val} foo : int}\\
+\end{ocamlindent}%
+\ocamlcodefragment{\ocamltag{keyword}{end}}\\
+\subsection{Signature\label{signature}}%
+\label{module-Functor_ml-module-Foo'-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t = \hyperref[module-Functor_ml-module-Bar-type-t]{\ocamlinlinecode{Bar.\allowbreak{}t}}}\\
+
+
diff --git a/test/generators/latex/Functor_ml.tex b/test/generators/latex/Functor_ml.tex
@@ -0,0 +1,8 @@
+\section{Module \ocamlinlinecode{Functor\_\allowbreak{}ml}}\label{module-Functor_ml}%
+\label{module-Functor_ml-module-Foo}\ocamlcodefragment{\ocamltag{keyword}{module} Foo (\hyperref[module-Functor_ml-module-Foo-argument-1-X]{\ocamlinlinecode{X}} : \ocamltag{keyword}{sig} .\allowbreak{}.\allowbreak{}.\allowbreak{} \ocamltag{keyword}{end}) : \ocamltag{keyword}{module} \ocamltag{keyword}{type} \ocamltag{keyword}{of} \hyperref[xref-unresolved]{\ocamlinlinecode{Stdlib}}.\allowbreak{}String}\\
+\label{module-Functor_ml-module-Bar}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Functor_ml-module-Bar]{\ocamlinlinecode{Bar}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Functor_ml-module-Bar-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t}\\
+\end{ocamlindent}%
+\ocamlcodefragment{\ocamltag{keyword}{end}}\\
+\label{module-Functor_ml-module-Foo'}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Functor_ml-module-Foo']{\ocamlinlinecode{Foo'}}}\ocamlcodefragment{ (\hyperref[module-Functor_ml-module-Foo'-argument-1-X]{\ocamlinlinecode{X}} : \ocamltag{keyword}{sig} .\allowbreak{}.\allowbreak{}.\allowbreak{} \ocamltag{keyword}{end}) : \ocamltag{keyword}{sig} .\allowbreak{}.\allowbreak{}.\allowbreak{} \ocamltag{keyword}{end}}\\
+
+\input{Functor_ml.Foo'.tex}
diff --git a/test/generators/latex/functor_ml.targets b/test/generators/latex/functor_ml.targets
@@ -0,0 +1,2 @@
+Functor_ml.tex
+Functor_ml.Foo'.tex
diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc
@@ -166,6 +166,21 @@
  (action
   (run odoc link -o %{target} %{dep:functor2.odoc})))
 
+(rule
+ (target functor_ml.cmt)
+ (action
+  (run ocamlc -c -bin-annot -o %{target} %{dep:cases/functor_ml.ml})))
+
+(rule
+ (target functor_ml.odoc)
+ (action
+  (run odoc compile -o %{target} %{dep:functor_ml.cmt})))
+
+(rule
+ (target functor_ml.odocl)
+ (action
+  (run odoc link -o %{target} %{dep:functor_ml.odoc})))
+
 (rule
  (target include.cmti)
  (action
@@ -1780,6 +1795,121 @@
   (action
    (diff functor2.targets functor2.targets.gen))))
 
+(subdir
+ html
+ (rule
+  (targets
+   Functor_ml.html.gen
+   Functor_ml-Bar.html.gen
+   Functor_ml-Foo'.html.gen
+   Functor_ml-Foo'-argument-1-X.html.gen)
+  (action
+   (run
+    odoc
+    html-generate
+    --indent
+    --flat
+    --extra-suffix
+    gen
+    -o
+    .
+    %{dep:../functor_ml.odocl})))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.html Functor_ml.html.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml-Bar.html Functor_ml-Bar.html.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml-Foo'.html Functor_ml-Foo'.html.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff
+    Functor_ml-Foo'-argument-1-X.html
+    Functor_ml-Foo'-argument-1-X.html.gen))))
+
+(subdir
+ html
+ (rule
+  (action
+   (with-outputs-to
+    functor_ml.targets.gen
+    (run odoc html-targets -o . %{dep:../functor_ml.odocl} --flat))))
+ (rule
+  (alias runtest)
+  (action
+   (diff functor_ml.targets functor_ml.targets.gen))))
+
+(subdir
+ latex
+ (rule
+  (targets Functor_ml.tex.gen Functor_ml.Foo'.tex.gen)
+  (action
+   (run
+    odoc
+    latex-generate
+    -o
+    .
+    --extra-suffix
+    gen
+    %{dep:../functor_ml.odocl})))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.tex Functor_ml.tex.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.Foo'.tex Functor_ml.Foo'.tex.gen))))
+
+(subdir
+ latex
+ (rule
+  (action
+   (with-outputs-to
+    functor_ml.targets.gen
+    (run odoc latex-targets -o . %{dep:../functor_ml.odocl}))))
+ (rule
+  (alias runtest)
+  (action
+   (diff functor_ml.targets functor_ml.targets.gen))))
+
+(subdir
+ man
+ (rule
+  (targets Functor_ml.3o.gen Functor_ml.Bar.3o.gen Functor_ml.Foo'.3o.gen)
+  (action
+   (run odoc man-generate -o . --extra-suffix gen %{dep:../functor_ml.odocl})))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.3o Functor_ml.3o.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.Bar.3o Functor_ml.Bar.3o.gen)))
+ (rule
+  (alias runtest)
+  (action
+   (diff Functor_ml.Foo'.3o Functor_ml.Foo'.3o.gen))))
+
+(subdir
+ man
+ (rule
+  (action
+   (with-outputs-to
+    functor_ml.targets.gen
+    (run odoc man-targets -o . %{dep:../functor_ml.odocl}))))
+ (rule
+  (alias runtest)
+  (action
+   (diff functor_ml.targets functor_ml.targets.gen))))
+
 (subdir
  html
  (rule

diff --git a/test/generators/man/Functor_ml.3o b/test/generators/man/Functor_ml.3o
@@ -0,0 +1,18 @@
+
+.TH Functor_ml 3 "" "Odoc" "OCaml Library"
+.SH Name
+Functor_ml
+.SH Synopsis
+.sp 
+.in 2
+\fBModule Functor_ml\fR
+.in 
+.sp 
+.SH Documentation
+.sp 
+.nf 
+\f[CB]module\fR Foo (X : \f[CB]sig\fR \.\.\. \f[CB]end\fR) : \f[CB]module\fR \f[CB]type\fR \f[CB]of\fR Stdlib\.String
+.sp 
+\f[CB]module\fR Bar : \f[CB]sig\fR \.\.\. \f[CB]end\fR
+.sp 
+\f[CB]module\fR Foo' (X : \f[CB]sig\fR \.\.\. \f[CB]end\fR) : \f[CB]sig\fR \.\.\. \f[CB]end\fR
diff --git a/test/generators/man/Functor_ml.Bar.3o b/test/generators/man/Functor_ml.Bar.3o
@@ -0,0 +1,14 @@
+
+.TH Bar 3 "" "Odoc" "OCaml Library"
+.SH Name
+Functor_ml\.Bar
+.SH Synopsis
+.sp 
+.in 2
+\fBModule Functor_ml\.Bar\fR
+.in 
+.sp 
+.SH Documentation
+.sp 
+.nf 
+\f[CB]type\fR t