From 18240f7b30d968228d27035a22f11561731c5537 Mon Sep 17 00:00:00 2001 From: Jerry James Date: Sat, 1 Feb 2020 08:16:44 -0700 Subject: [PATCH] Add 3 patches for OCaml 4.10 compatibility. --- ...efore-identifier-in-alias-type-exprs.patch | 54 + ...ndle-generalized-open-statements-393.patch | 914 ++++++++++++++ 0003-4.10-compatibility-408.patch | 1115 +++++++++++++++++ ocaml-odoc.spec | 14 +- 4 files changed, 2096 insertions(+), 1 deletion(-) create mode 100644 0001-Emit-quote-before-identifier-in-alias-type-exprs.patch create mode 100644 0002-Handle-generalized-open-statements-393.patch create mode 100644 0003-4.10-compatibility-408.patch diff --git a/0001-Emit-quote-before-identifier-in-alias-type-exprs.patch b/0001-Emit-quote-before-identifier-in-alias-type-exprs.patch new file mode 100644 index 0000000..46d82f9 --- /dev/null +++ b/0001-Emit-quote-before-identifier-in-alias-type-exprs.patch @@ -0,0 +1,54 @@ +From acf7732ec95332b4589eea397409d02cfb8867d3 Mon Sep 17 00:00:00 2001 +From: Anton Bachin +Date: Wed, 6 Nov 2019 13:04:58 +0300 +Subject: [PATCH] Emit quote before identifier in alias type exprs + +Fixes #391. +--- + src/html/generator.ml | 2 +- + test/html/expect/test_package+ml/Type/index.html | 2 +- + test/html/expect/test_package+re/Type/index.html | 2 +- + 3 files changed, 3 insertions(+), 3 deletions(-) + +diff --git a/src/html/generator.ml b/src/html/generator.ml +index 8ff697a..fd96630 100644 +--- a/src/html/generator.ml ++++ b/src/html/generator.ml +@@ -179,7 +179,7 @@ struct + | Any -> [type_var Syntax.Type.any] + | Alias (te, alias) -> + type_expr ~needs_parentheses:true te @ +- Html.txt " " :: keyword "as" :: Html.txt " " :: [ Html.txt alias ] ++ Html.txt " " :: keyword "as" :: Html.txt " '" :: [ Html.txt alias ] + | Arrow (None, src, dst) -> + let res = + type_expr ~needs_parentheses:true src @ +diff --git a/test/html/expect/test_package+ml/Type/index.html b/test/html/expect/test_package+ml/Type/index.html +index 048b04d..882898e 100644 +--- a/test/html/expect/test_package+ml/Type/index.html ++++ b/test/html/expect/test_package+ml/Type/index.html +@@ -367,7 +367,7 @@ + type ('a, 'b) double_constrained = 'a * 'b constraint 'a = int constraint 'b = unit + +
+- type as_ = int as a * 'a ++ type as_ = int as 'a * 'a +
+
+ type extensible = .. +diff --git a/test/html/expect/test_package+re/Type/index.html b/test/html/expect/test_package+re/Type/index.html +index 783db65..ee630e3 100644 +--- a/test/html/expect/test_package+re/Type/index.html ++++ b/test/html/expect/test_package+re/Type/index.html +@@ -371,7 +371,7 @@ + type double_constrained('a, 'b) = ('a, 'b) constraint 'a = int constraint 'b = unit; +
+
+- type as_ = (int as a, 'a); ++ type as_ = (int as 'a, 'a); +
+
+ type extensible = ..; +-- +2.24.1 + diff --git a/0002-Handle-generalized-open-statements-393.patch b/0002-Handle-generalized-open-statements-393.patch new file mode 100644 index 0000000..fe58e95 --- /dev/null +++ b/0002-Handle-generalized-open-statements-393.patch @@ -0,0 +1,914 @@ +From 152481881b26873d6890519a8e8c15b35f6819bf Mon Sep 17 00:00:00 2001 +From: Jon Ludlam +Date: Mon, 11 Nov 2019 15:01:06 +0000 +Subject: [PATCH] Handle generalized open statements (#393) + +We do this by introducing an artificial module at the point the `open` +occurs. For example: + +```ocaml +open (Foo : module type of Foo with module A := Foo.A) +``` + +becomes effectively: + +```ocaml +(**/**) +module Open___ : module type of Foo with module A := Foo.A +(**/**) +``` + +and we 'open' this by putting all of the identifiers into the environment. +All of these `Ident.t` values are associated with 'Internal' names that +are always hidden, and hence the resolution step ends up resolving them to +the non-hidden identifiers. + +Signed-off-by: Jon Ludlam +--- + src/loader/cmi.ml | 3 +- + src/loader/cmt.ml | 28 +++- + src/loader/cmti.ml | 23 +++- + src/model/dune | 5 + + src/model/ident_env.cppo.ml | 129 +++++++++++++----- + .../{ident_env.mli => ident_env.cppo.mli} | 18 ++- + src/model/names.ml | 81 +++++++++-- + src/model/names.mli | 68 +++++++-- + src/xref/expand.ml | 4 +- + test/html/cases/functor2.mli | 15 ++ + test/html/cases/recent_impl.ml | 29 ++++ + .../test_package+ml/Recent_impl/index.html | 44 ++++++ + .../test_package+re/Recent_impl/index.html | 44 ++++++ + test/html/test.ml | 4 +- + 14 files changed, 425 insertions(+), 70 deletions(-) + rename src/model/{ident_env.mli => ident_env.cppo.mli} (80%) + create mode 100644 test/html/cases/functor2.mli + create mode 100644 test/html/cases/recent_impl.ml + create mode 100644 test/html/expect/test_package+ml/Recent_impl/index.html + create mode 100644 test/html/expect/test_package+re/Recent_impl/index.html + +diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml +index f70714a..05f24eb 100644 +--- a/src/loader/cmi.ml ++++ b/src/loader/cmi.ml +@@ -21,6 +21,7 @@ module OCamlPath = Path + + open Odoc_model.Paths + open Odoc_model.Lang ++open Odoc_model.Names + + module Env = Odoc_model.Ident_env + module Paths = Odoc_model.Paths +@@ -851,7 +852,7 @@ let rec read_module_type env parent pos (mty : Odoc_model.Compat.module_type) = + in + Some { FunctorArgument. id; expr = arg; expansion } + in +- let env = Env.add_argument parent pos id env in ++ let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in + let res = read_module_type env parent (pos + 1) res in + Functor(arg, res) + | Mty_alias _ -> assert false +diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml +index 57b74c5..892959a 100644 +--- a/src/loader/cmt.ml ++++ b/src/loader/cmt.ml +@@ -372,7 +372,7 @@ let rec read_module_expr env parent label_parent pos mexpr = + in + Some { FunctorArgument. id; expr = arg; expansion } + in +- let env = Env.add_argument parent pos id env in ++ let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in + let res = read_module_expr env parent label_parent (pos + 1) res in + Functor(arg, res) + | Tmod_apply _ -> +@@ -434,6 +434,25 @@ and read_module_bindings env parent mbs = + |> fst + |> List.rev + ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++and module_of_extended_open env parent o = ++ let open Module in ++ let id = `Module (parent, Odoc_model.Names.ModuleName.internal_of_string (Env.module_name_of_open o)) in ++ let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in ++ let type_ = ++ match unwrap_module_expr_desc o.open_expr.mod_desc with ++ | Tmod_ident(p, _) -> Alias (Env.Path.read_module env p) ++ | _ -> ModuleType (read_module_expr env id container 1 o.open_expr) ++ in ++ { id ++ ; doc = [] ++ ; type_ ++ ; canonical = None ++ ; hidden = true ++ ; display_type = None ++ ; expansion = None } ++#endif ++ + and read_structure_item env parent item = + let open Signature in + match item.str_desc with +@@ -471,7 +490,12 @@ and read_structure_item env parent item = + read_module_bindings env parent mbs + | Tstr_modtype mtd -> + [ModuleType (Cmti.read_module_type_declaration env parent mtd)] +- | Tstr_open _ -> [] ++ | Tstr_open o -> ++#if OCAML_MAJOR = 4 && OCAML_MINOR < 08 ++ ignore(o); [] ++#else ++ [Comment `Stop; Module (Ordinary, module_of_extended_open env parent o); Comment `Stop] ++#endif + | Tstr_include incl -> + [Include (read_include env parent incl)] + | Tstr_class cls -> +diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml +index 8156e8e..13afb84 100644 +--- a/src/loader/cmti.ml ++++ b/src/loader/cmti.ml +@@ -21,6 +21,7 @@ module OCamlPath = Path + + open Odoc_model.Paths + open Odoc_model.Lang ++open Odoc_model.Names + + module Env = Odoc_model.Ident_env + module Paths = Odoc_model.Paths +@@ -491,7 +492,7 @@ and read_module_type env parent label_parent pos mty = + in + Some { FunctorArgument. id; expr = arg; expansion } + in +- let env = Env.add_argument parent pos id env in ++ let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in + let res = read_module_type env parent label_parent (pos + 1) res in + Functor(arg, res) + | Tmty_with(body, subs) -> +@@ -573,6 +574,21 @@ and read_module_equation env p = + let open Module in + Alias (Env.Path.read_module env p) + ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++and module_of_extended_open env parent o = ++ let open Module in ++ let id = `Module (parent, Odoc_model.Names.ModuleName.internal_of_string (Env.module_name_of_open o)) in ++ let (p,_) = o.Typedtree.open_expr in ++ let type_ = Alias (Env.Path.read_module env p) in ++ { id ++ ; doc = [] ++ ; type_ ++ ; canonical = None ++ ; hidden = true ++ ; display_type = None ++ ; expansion = None } ++#endif ++ + and read_signature_item env parent item = + let open Signature in + match item.sig_desc with +@@ -604,7 +620,12 @@ and read_signature_item env parent item = + read_module_declarations env parent mds + | Tsig_modtype mtd -> + [ModuleType (read_module_type_declaration env parent mtd)] ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++ | Tsig_open o -> ++ [Comment `Stop; Module (Ordinary, module_of_extended_open env parent o); Comment `Stop] ++#else + | Tsig_open _ -> [] ++#endif + | Tsig_include incl -> + [Include (read_include env parent incl)] + | Tsig_class cls -> +diff --git a/src/model/dune b/src/model/dune +index 3ae7f24..092efdd 100644 +--- a/src/model/dune ++++ b/src/model/dune +@@ -14,6 +14,11 @@ let () = + (deps (:x ident_env.cppo.ml)) + (action (chdir %{workspace_root} (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) + ++(rule ++ (targets ident_env.mli) ++ (deps (:x ident_env.cppo.mli)) ++ (action (chdir %{workspace_root} (run %{bin:cppo} -V OCAML:%{ocaml_version} %{x} -o %{targets})))) ++ + (rule + (targets compat.ml) + (deps (:x compat.cppo.ml)) +diff --git a/src/model/ident_env.cppo.ml b/src/model/ident_env.cppo.ml +index d6101c9..1534ecf 100644 +--- a/src/model/ident_env.cppo.ml ++++ b/src/model/ident_env.cppo.ml +@@ -38,37 +38,36 @@ let empty = + + let builtin_idents = List.map snd Predef.builtin_idents + +-let should_be_hidden = Root.contains_double_underscore ++#if OCAML_MAJOR=4 && OCAML_MINOR >= 08 ++let module_name_of_open o = ++ let loc_start = o.Typedtree.open_loc.Location.loc_start in ++ Printf.sprintf "Open__%d_%d" loc_start.Lexing.pos_lnum loc_start.pos_cnum ++#endif + +-let add_module parent id env = +- let name = Ident.name id in +- let ident = `Identifier (`Module(parent, ModuleName.of_string name)) in +- let module_ = if should_be_hidden name then `Hidden ident else ident in ++let add_module parent id name env = ++ let ident = `Identifier (`Module(parent, name)) in ++ let module_ = if ModuleName.is_hidden name then `Hidden ident else ident in + let modules = Ident.add id module_ env.modules in + { env with modules } + +-let add_argument parent arg id env = +- let name = Ident.name id in +- let ident = `Identifier (`Argument(parent, arg, ArgumentName.of_string name)) in +- let module_ = if should_be_hidden name then `Hidden ident else ident in ++let add_argument parent arg id name env = ++ let ident = `Identifier (`Argument(parent, arg, name)) in ++ let module_ = if ArgumentName.is_hidden name then `Hidden ident else ident in + let modules = Ident.add id module_ env.modules in + { env with modules } + +-let add_module_type parent id env = +- let name = Ident.name id in +- let identifier = `ModuleType(parent, ModuleTypeName.of_string name) in ++let add_module_type parent id name env = ++ let identifier = `ModuleType(parent, name) in + let module_types = Ident.add id identifier env.module_types in + { env with module_types } + +-let add_type parent id env = +- let name = Ident.name id in +- let identifier = `Type(parent, TypeName.of_string name) in ++let add_type parent id name env = ++ let identifier = `Type(parent, name) in + let types = Ident.add id identifier env.types in + { env with types } + +-let add_class parent id ty_id obj_id cl_id env = +- let name = Ident.name id in +- let identifier = `Class(parent, ClassName.of_string name) in ++let add_class parent id ty_id obj_id cl_id name env = ++ let identifier = `Class(parent, name) in + let add_idents tbl = + Ident.add id identifier + (Ident.add ty_id identifier +@@ -79,9 +78,8 @@ let add_class parent id ty_id obj_id cl_id env = + let class_types = add_idents env.class_types in + { env with types; class_types } + +-let add_class_type parent id obj_id cl_id env = +- let name = Ident.name id in +- let identifier = `ClassType(parent, ClassTypeName.of_string name) in ++let add_class_type parent id obj_id cl_id name env = ++ let identifier = `ClassType(parent, name) in + let add_idents tbl = + Ident.add id identifier + (Ident.add obj_id identifier +@@ -91,27 +89,28 @@ let add_class_type parent id obj_id cl_id env = + let class_types = add_idents env.class_types in + { env with types; class_types } + ++ + let rec add_signature_type_items parent items env = + let open Compat in + match items with + | Sig_type(id, _, _, Exported) :: rest -> + let env = add_signature_type_items parent rest env in + if Btype.is_row_name (Ident.name id) then env +- else add_type parent id env ++ else add_type parent id (TypeName.of_ident id) env + | Sig_module(id, _, _, _, Exported) :: rest -> + let env = add_signature_type_items parent rest env in +- add_module parent id env ++ add_module parent id (ModuleName.of_ident id) env + | Sig_modtype(id, _, Exported) :: rest -> + let env = add_signature_type_items parent rest env in +- add_module_type parent id env ++ add_module_type parent id (ModuleTypeName.of_ident id) env + | Sig_class(id, _, _, Exported) :: Sig_class_type(ty_id, _, _, _) + :: Sig_type(obj_id, _, _, _) :: Sig_type(cl_id, _, _, _) :: rest -> + let env = add_signature_type_items parent rest env in +- add_class parent id ty_id obj_id cl_id env ++ add_class parent id ty_id obj_id cl_id (ClassName.of_ident id) env + | Sig_class_type(id, _, _, Exported) :: Sig_type(obj_id, _, _, _) + :: Sig_type(cl_id, _, _, _) :: rest -> + let env = add_signature_type_items parent rest env in +- add_class_type parent id obj_id cl_id env ++ add_class_type parent id obj_id cl_id (ClassTypeName.of_ident id) env + | (Sig_value _ | Sig_typext _) :: rest -> + add_signature_type_items parent rest env + +@@ -129,6 +128,52 @@ let rec add_signature_type_items parent items env = + + | [] -> env + ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++ ++let rec unwrap_module_expr_desc = function ++ | Typedtree.Tmod_constraint(mexpr, _, Tmodtype_implicit, _) -> ++ unwrap_module_expr_desc mexpr.mod_desc ++ | desc -> desc ++ ++let rec add_extended_open_items parent items env = ++ let open Types in ++ match items with ++ | Sig_type(id, _, _, _) :: rest -> ++ let env = add_extended_open_items parent rest env in ++ if Btype.is_row_name (Ident.name id) then env ++ else add_type parent id (TypeName.internal_of_ident id) env ++ | Sig_module(id, _, _, _, _) :: rest -> ++ let env = add_extended_open_items parent rest env in ++ add_module parent id (ModuleName.internal_of_ident id) env ++ | Sig_modtype(id, _, _) :: rest -> ++ let env = add_extended_open_items parent rest env in ++ add_module_type parent id (ModuleTypeName.internal_of_ident id) env ++ | Sig_class(id, _, _, _) :: Sig_class_type(ty_id, _, _, _) ++ :: Sig_type(obj_id, _, _, _) :: Sig_type(cl_id, _, _, _) :: rest -> ++ let env = add_extended_open_items parent rest env in ++ add_class parent id ty_id obj_id cl_id (ClassName.internal_of_ident id) env ++ | Sig_class_type(id, _, _, _) :: Sig_type(obj_id, _, _, _) ++ :: Sig_type(cl_id, _, _, _) :: rest -> ++ let env = add_extended_open_items parent rest env in ++ add_class_type parent id obj_id cl_id (ClassTypeName.internal_of_ident id) env ++ | (Sig_value _ | Sig_typext _) :: rest -> ++ add_extended_open_items parent rest env ++ ++ | Sig_class _ :: _ ++ | Sig_class_type _ :: _ -> assert false ++ ++ | [] -> env ++ ++let add_extended_open parent o env = ++ let open Typedtree in ++ match unwrap_module_expr_desc o.open_expr.mod_desc with ++ | Tmod_ident(_, _) -> env ++ | _ -> ++ let parent = `Module (parent, ModuleName.internal_of_string (module_name_of_open o)) in ++ add_extended_open_items parent o.open_bound_items env ++#endif ++ ++ + let add_signature_tree_item parent item env = + let open Typedtree in + match item.sig_desc with +@@ -138,16 +183,16 @@ let add_signature_tree_item parent item env = + | Tsig_type (_rec_flag, decls) -> (* TODO: handle rec_flag *) + #endif + List.fold_right +- (fun decl env -> add_type parent decl.typ_id env) ++ (fun decl env -> add_type parent decl.typ_id (TypeName.of_ident decl.typ_id) env) + decls env + | Tsig_module md -> +- add_module parent md.md_id env ++ add_module parent md.md_id (ModuleName.of_ident md.md_id) env + | Tsig_recmodule mds -> + List.fold_right +- (fun md env -> add_module parent md.md_id env) ++ (fun md env -> add_module parent md.md_id (ModuleName.of_ident md.md_id) env) + mds env + | Tsig_modtype mtd -> +- add_module_type parent mtd.mtd_id env ++ add_module_type parent mtd.mtd_id (ModuleTypeName.of_ident mtd.mtd_id) env + | Tsig_include incl -> + add_signature_type_items parent (Compat.signature incl.incl_type) env + | Tsig_class cls -> +@@ -160,6 +205,7 @@ let add_signature_tree_item parent item env = + #else + cld.ci_id_typehash + #endif ++ (ClassName.of_ident cld.ci_id_class) + env) + cls env + | Tsig_class_type cltyps -> +@@ -172,14 +218,15 @@ let add_signature_tree_item parent item env = + #else + clty.ci_id_typehash + #endif ++ (ClassTypeName.of_ident clty.ci_id_class_type) + env) + cltyps env + #if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 + | Tsig_modsubst ms -> +- add_module parent ms.ms_id env ++ add_module parent ms.ms_id (ModuleName.of_ident ms.ms_id) env + | Tsig_typesubst ts -> + List.fold_right +- (fun decl env -> add_type parent decl.typ_id env) ++ (fun decl env -> add_type parent decl.typ_id (TypeName.of_ident decl.typ_id) env) + ts env + #endif + | Tsig_value _ | Tsig_typext _ +@@ -201,15 +248,15 @@ let add_structure_tree_item parent item env = + | Tstr_type (_rec_flag, decls) -> (* TODO: handle rec_flag *) + #endif + List.fold_right +- (fun decl env -> add_type parent decl.typ_id env) ++ (fun decl env -> add_type parent decl.typ_id (TypeName.of_ident decl.typ_id) env) + decls env +- | Tstr_module mb -> add_module parent mb.mb_id env ++ | Tstr_module mb -> add_module parent mb.mb_id (ModuleName.of_ident mb.mb_id) env + | Tstr_recmodule mbs -> + List.fold_right +- (fun mb env -> add_module parent mb.mb_id env) ++ (fun mb env -> add_module parent mb.mb_id (ModuleName.of_ident mb.mb_id) env) + mbs env + | Tstr_modtype mtd -> +- add_module_type parent mtd.mtd_id env ++ add_module_type parent mtd.mtd_id (ModuleTypeName.of_ident mtd.mtd_id) env + | Tstr_include incl -> + add_signature_type_items parent (Compat.signature incl.incl_type) env + | Tstr_class cls -> +@@ -226,6 +273,7 @@ let add_structure_tree_item parent item env = + #else + cld.ci_id_typehash + #endif ++ (ClassName.of_ident cld.ci_id_class) + env) + cls env + | Tstr_class_type cltyps -> +@@ -238,11 +286,18 @@ let add_structure_tree_item parent item env = + #else + clty.ci_id_typehash + #endif ++ (ClassTypeName.of_ident clty.ci_id_class_type) + env) + cltyps env ++#if OCAML_MAJOR = 4 && OCAML_MINOR < 08 ++ | Tstr_open _ -> env ++#else ++ | Tstr_open o -> ++ add_extended_open parent o env ++#endif + | Tstr_eval _ | Tstr_value _ + | Tstr_primitive _ | Tstr_typext _ +- | Tstr_exception _ | Tstr_open _ ++ | Tstr_exception _ + | Tstr_attribute _ -> env + + let add_structure_tree_items parent str env = +diff --git a/src/model/ident_env.mli b/src/model/ident_env.cppo.mli +similarity index 80% +rename from src/model/ident_env.mli +rename to src/model/ident_env.cppo.mli +index c41c29f..0fe0e93 100644 +--- a/src/model/ident_env.mli ++++ b/src/model/ident_env.cppo.mli +@@ -14,21 +14,27 @@ + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + *) + ++open Names ++ + type t + + val empty : t + +-val add_module : Paths.Identifier.Signature.t -> Ident.t -> t -> t ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++val module_name_of_open : 'a Typedtree.open_infos -> string ++#endif ++ ++val add_module : Paths.Identifier.Signature.t -> Ident.t -> ModuleName.t -> t -> t + +-val add_argument : Paths.Identifier.Signature.t -> int -> Ident.t -> t -> t ++val add_argument : Paths.Identifier.Signature.t -> int -> Ident.t -> ArgumentName.t -> t -> t + +-val add_module_type : Paths.Identifier.Signature.t -> Ident.t -> t -> t ++val add_module_type : Paths.Identifier.Signature.t -> Ident.t -> ModuleTypeName.t -> t -> t + +-val add_type : Paths.Identifier.Signature.t -> Ident.t -> t -> t ++val add_type : Paths.Identifier.Signature.t -> Ident.t -> TypeName.t -> t -> t + +-val add_class : Paths.Identifier.Signature.t -> Ident.t -> Ident.t -> Ident.t -> Ident.t -> t -> t ++val add_class : Paths.Identifier.Signature.t -> Ident.t -> Ident.t -> Ident.t -> Ident.t -> ClassName.t -> t -> t + +-val add_class_type : Paths.Identifier.Signature.t -> Ident.t -> Ident.t -> Ident.t -> t -> t ++val add_class_type : Paths.Identifier.Signature.t -> Ident.t -> Ident.t -> Ident.t -> ClassTypeName.t -> t -> t + + val add_signature_type_items : Paths.Identifier.Signature.t -> Compat.signature -> t -> t + +diff --git a/src/model/names.ml b/src/model/names.ml +index cad32c4..550bb80 100644 +--- a/src/model/names.ml ++++ b/src/model/names.ml +@@ -4,10 +4,18 @@ module type Name = sig + + val to_string : t -> string + ++ val to_string_unsafe : t -> string ++ + val of_string : string -> t + + val of_ident : Ident.t -> t + ++ val internal_of_string : string -> t ++ ++ val internal_of_ident : Ident.t -> t ++ ++ val is_internal : t -> bool ++ + val equal : t -> t -> bool + + val is_hidden : t -> bool +@@ -16,6 +24,59 @@ end + + module Name : Name = struct + ++ type t = ++ | Internal of string ++ | Std of string ++ ++ let to_string = function ++ | Std s -> s ++ | Internal s -> Printf.sprintf "$%s" s ++ ++ let to_string_unsafe = function ++ | Std s -> s ++ | Internal s -> s ++ ++ let of_string s = Std s ++ ++ let of_ident id = of_string (Ident.name id) ++ ++ let internal_of_string id = Internal id ++ ++ let internal_of_ident id = internal_of_string (Ident.name id) ++ ++ let is_internal = function | Std _ -> false | Internal _ -> true ++ ++ let equal (x : t) (y : t) = x = y ++ ++ let is_hidden = function ++ | Std s -> ++ let len = String.length s in ++ let rec aux i = ++ if i > len - 2 then false else ++ if s.[i] = '_' && s.[i + 1] = '_' then true ++ else aux (i + 1) ++ in aux 0 ++ | Internal _ -> true ++end ++ ++module type SimpleName = sig ++ ++ type t ++ ++ val to_string : t -> string ++ ++ val of_string : string -> t ++ ++ val of_ident : Ident.t -> t ++ ++ val equal : t -> t -> bool ++ ++ val is_hidden : t -> bool ++ ++end ++ ++module SimpleName : SimpleName = struct ++ + type t = string + + let to_string s = s +@@ -43,28 +104,28 @@ module ModuleTypeName = Name + + module TypeName = Name + +-module ConstructorName = Name ++module ConstructorName = SimpleName + +-module FieldName = Name ++module FieldName = SimpleName + +-module ExtensionName = Name ++module ExtensionName = SimpleName + +-module ExceptionName = Name ++module ExceptionName = SimpleName + +-module ValueName = Name ++module ValueName = SimpleName + + module ClassName = Name + + module ClassTypeName = Name + +-module MethodName = Name ++module MethodName = SimpleName + +-module InstanceVariableName = Name ++module InstanceVariableName = SimpleName + +-module UnitName = Name ++module UnitName = SimpleName + +-module LabelName = Name ++module LabelName = SimpleName + +-module PageName = Name ++module PageName = SimpleName + + +diff --git a/src/model/names.mli b/src/model/names.mli +index 01999a1..d1f3ebc 100644 +--- a/src/model/names.mli ++++ b/src/model/names.mli +@@ -1,18 +1,66 @@ ++(** Typed names for paths, identifiers, references and fragments. ++ ++ This module contains a module per type of named object in our internal ++ representation of the langage, each containing an opaque type [t]. ++ This allows us to ensure that, for example, we never mistake a module ++ name for a module type name. ++*) ++ ++(** Name is the signature for names that could possibly be internal. Internal ++ names occur when we generate items that don't have a path that will be ++ exposed in the generated HTML, for example, when we are doing generalised ++ opens. The compiler makes sure these new types are removed from the ++ signature, so they should never be externally visible, and an attempt to ++ turn an internal name into a string will result in an exception being thrown. ++ ++ Note that it is tricky currently to remove references to internal names, ++ and hence the 'safe' [to_string] will not currently raise an exception. When ++ the model is updated to handle this the exception will be reinstated. *) + module type Name = sig + + type t + + val to_string : t -> string + ++ (** [to_string_unsafe] will allow even internal names to be turned into ++ strings. Use with caution. *) ++ val to_string_unsafe : t -> string ++ + val of_string : string -> t + + val of_ident : Ident.t -> t + ++ val internal_of_string : string -> t ++ ++ val internal_of_ident : Ident.t -> t ++ ++ val is_internal : t -> bool ++ + val equal : t -> t -> bool + ++ (** Hidden names are those that contain a double underscore, e.g. ++ [Hidden__module] *) + val is_hidden : t -> bool + end + ++(** Some named objects can't have internal names, so they have this simpler ++ module. *) ++module type SimpleName = sig ++ ++ type t ++ ++ val to_string : t -> string ++ ++ val of_string : string -> t ++ ++ val of_ident : Ident.t -> t ++ ++ val equal : t -> t -> bool ++ ++ val is_hidden : t -> bool ++ ++end ++ + module ModuleName : Name + + module ArgumentName : Name +@@ -21,26 +69,26 @@ module ModuleTypeName : Name + + module TypeName : Name + +-module ConstructorName : Name ++module ConstructorName : SimpleName + +-module FieldName : Name ++module FieldName : SimpleName + +-module ExtensionName : Name ++module ExtensionName : SimpleName + +-module ExceptionName : Name ++module ExceptionName : SimpleName + +-module ValueName : Name ++module ValueName : SimpleName + + module ClassName : Name + + module ClassTypeName : Name + +-module MethodName : Name ++module MethodName : SimpleName + +-module InstanceVariableName : Name ++module InstanceVariableName : SimpleName + +-module UnitName : Name ++module UnitName : SimpleName + +-module LabelName : Name ++module LabelName : SimpleName + +-module PageName : Name ++module PageName : SimpleName +diff --git a/src/xref/expand.ml b/src/xref/expand.ml +index 836b9c0..db45fd1 100644 +--- a/src/xref/expand.ml ++++ b/src/xref/expand.ml +@@ -458,7 +458,7 @@ let expand_signature_identifier' t root (id : Identifier.Signature.t) = + ex + | `Module(parent, name) -> + let ex = t.expand_signature_identifier ~root parent in +- let md = find_module t root (ModuleName.to_string name) ex in ++ let md = find_module t root (ModuleName.to_string_unsafe name) ex in + expand_module t root md + | `Argument(parent, pos, _name) -> + let ex = t.expand_signature_identifier ~root parent in +@@ -475,7 +475,7 @@ and expand_module_identifier' t root (id : Identifier.Module.t) = + | `Module(parent, name) -> + let open Module in + let ex = t.expand_signature_identifier ~root parent in +- let md = find_module t root (ModuleName.to_string name) ex in ++ let md = find_module t root (ModuleName.to_string_unsafe name) ex in + md.id, md.doc, md.canonical, expand_module t root md, [] + | `Argument(parent, pos, _name) -> + let ex = t.expand_signature_identifier ~root parent in +diff --git a/test/html/cases/functor2.mli b/test/html/cases/functor2.mli +new file mode 100644 +index 0000000..404e467 +--- /dev/null ++++ b/test/html/cases/functor2.mli +@@ -0,0 +1,15 @@ ++(* test *) ++ ++module type S = sig type t end ++ ++module X : functor (Y:S) -> functor (Z:S) -> sig ++ type y_t = Y.t ++ type z_t = Z.t ++ type x_t = y_t ++end ++ ++module type XF = functor (Y:S) -> functor (Z:S) -> sig ++ type y_t = Y.t ++ type z_t = Z.t ++ type x_t = y_t ++end +diff --git a/test/html/cases/recent_impl.ml b/test/html/cases/recent_impl.ml +new file mode 100644 +index 0000000..7aa10c9 +--- /dev/null ++++ b/test/html/cases/recent_impl.ml +@@ -0,0 +1,29 @@ ++module Foo = struct ++ module A = struct ++ type t = A ++ end ++ module B = struct ++ type t = B ++ end ++end ++ ++open (Foo : module type of Foo with module A := Foo.A) ++ ++module B = B ++ ++open Set.Make(struct type t = Foo.A.t let compare = compare end) ++ ++type u = t ++ ++module type S = sig ++ module F: sig end -> sig type t end ++ module X: sig end ++ open F(X) ++ val f: t ++end ++ ++open Foo ++ ++(* Check that regular open still works as expected *) ++module B' = B ++ +diff --git a/test/html/expect/test_package+ml/Recent_impl/index.html b/test/html/expect/test_package+ml/Recent_impl/index.html +new file mode 100644 +index 0000000..9359a0a +--- /dev/null ++++ b/test/html/expect/test_package+ml/Recent_impl/index.html +@@ -0,0 +1,44 @@ ++ ++ ++ ++ Recent_impl (test_package+ml.Recent_impl) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++
++
++ ++

++ Module Recent_impl ++

++
++
++ module Foo : sig ... end ++
++
++ module B = $B ++
++
++
++ type u = $t ++
++
++
++ module type S = sig ... end ++
++
++ module B' = Foo.B ++
++
++ ++ +diff --git a/test/html/expect/test_package+re/Recent_impl/index.html b/test/html/expect/test_package+re/Recent_impl/index.html +new file mode 100644 +index 0000000..25fc729 +--- /dev/null ++++ b/test/html/expect/test_package+re/Recent_impl/index.html +@@ -0,0 +1,44 @@ ++ ++ ++ ++ Recent_impl (test_package+re.Recent_impl) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++
++
++ ++

++ Module Recent_impl ++

++
++
++ module Foo: { ... }; ++
++
++ module B = $B; ++
++
++
++ type u = $t; ++
++
++
++ module type S = { ... }; ++
++
++ module B' = Foo.B; ++
++
++ ++ +diff --git a/test/html/test.ml b/test/html/test.ml +index 168e884..0d24097 100644 +--- a/test/html/test.ml ++++ b/test/html/test.ml +@@ -285,7 +285,9 @@ let source_files = [ + let source_files = + let latest_supported = "4.08." in + match String.sub (Sys.ocaml_version) 0 (String.length latest_supported) with +- | s when s = latest_supported -> source_files @ [("recent.mli", ["Recent/index.html"; "Recent/X/index.html"])] ++ | s when s = latest_supported -> source_files @ ++ [ ("recent.mli", ["Recent/index.html"; "Recent/X/index.html"]) ++ ; ("recent_impl.ml", ["Recent_impl/index.html"])] + | _ -> source_files + | exception _ -> source_files + +-- +2.24.1 + diff --git a/0003-4.10-compatibility-408.patch b/0003-4.10-compatibility-408.patch new file mode 100644 index 0000000..6e63c29 --- /dev/null +++ b/0003-4.10-compatibility-408.patch @@ -0,0 +1,1115 @@ +From 35f5619a021944cda5ef495096651a70f49fdedc Mon Sep 17 00:00:00 2001 +From: Jon Ludlam +Date: Fri, 31 Jan 2020 17:02:01 +0000 +Subject: [PATCH] 4.10 compatibility (#408) + +* OCaml 4.10 compatibility + +Signed-off-by: Jon Ludlam +--- + src/html/generator.ml | 16 ++-- + src/html/targets.ml | 8 +- + src/loader/cmi.ml | 22 +++--- + src/loader/cmt.ml | 74 +++++++++++++++---- + src/loader/cmti.ml | 66 ++++++++++++++--- + src/model/compat.cppo.ml | 67 +++++++++++++++-- + src/model/ident_env.cppo.ml | 35 ++++++++- + src/model/lang.ml | 14 ++-- + src/model/maps.ml | 16 ++-- + src/model/maps.mli | 8 +- + src/xref/component_table.ml | 6 +- + src/xref/expand.ml | 37 +++++----- + src/xref/name_env.ml | 4 +- + src/xref/resolve.ml | 12 +-- + test/html/cases/bugs.ml | 5 -- + test/html/cases/bugs_pre_410.ml | 6 ++ + .../expect/test_package+ml/Bugs/index.html | 15 ---- + .../test_package+ml/Bugs_pre_410/index.html | 42 +++++++++++ + .../expect/test_package+re/Bugs/index.html | 15 ---- + .../test_package+re/Bugs_pre_410/index.html | 42 +++++++++++ + test/html/test.ml | 28 ++++--- + 21 files changed, 389 insertions(+), 149 deletions(-) + create mode 100644 test/html/cases/bugs_pre_410.ml + create mode 100644 test/html/expect/test_package+ml/Bugs_pre_410/index.html + create mode 100644 test/html/expect/test_package+re/Bugs_pre_410/index.html + +diff --git a/src/html/generator.ml b/src/html/generator.ml +index fd96630..b8b6606 100644 +--- a/src/html/generator.ml ++++ b/src/html/generator.ml +@@ -25,7 +25,7 @@ open Utils + + let a_href = Tree.Relative_link.to_sub_element + +-let functor_arg_pos { Odoc_model.Lang.FunctorArgument.id ; _ } = ++let functor_arg_pos { Odoc_model.Lang.FunctorParameter.id ; _ } = + match id with + | `Argument (_, nb, _) -> nb + | _ -> +@@ -1462,10 +1462,10 @@ struct + tagged_items + + and functor_argument +- : 'row. ?theme_uri:Tree.uri -> Odoc_model.Lang.FunctorArgument.t ++ : 'row. ?theme_uri:Tree.uri -> Odoc_model.Lang.FunctorParameter.parameter + -> Html_types.div_content Html.elt list * Tree.t list + = fun ?theme_uri arg -> +- let open Odoc_model.Lang.FunctorArgument in ++ let open Odoc_model.Lang.FunctorParameter in + let name = Paths.Identifier.name arg.id in + let nb = functor_arg_pos arg in + let link_name = Printf.sprintf "%d-%s" nb name in +@@ -1515,8 +1515,8 @@ struct + let params, params_subpages = + List.fold_left (fun (args, subpages as acc) arg -> + match arg with +- | None -> acc +- | Some arg -> ++ | Odoc_model.Lang.FunctorParameter.Unit -> acc ++ | Named arg -> + let arg, arg_subpages = functor_argument ?theme_uri arg in + let arg = Html.li arg in + (args @ [arg], subpages @ arg_subpages) +@@ -1666,13 +1666,13 @@ struct + Html.txt " ... "; + Syntax.Mod.close_tag; + ] +- | Functor (None, expr) -> ++ | Functor (Unit, expr) -> + (if Syntax.Mod.functor_keyword then [keyword "functor"] else []) @ + Html.txt " () " :: + mty base expr +- | Functor (Some arg, expr) -> ++ | Functor (Named arg, expr) -> + let name = +- let open Odoc_model.Lang.FunctorArgument in ++ let open Odoc_model.Lang.FunctorParameter in + let to_print = Html.txt @@ Paths.Identifier.name arg.id in + match + Tree.Relative_link.Id.href +diff --git a/src/html/targets.ml b/src/html/targets.ml +index c7f333c..26d90f4 100644 +--- a/src/html/targets.ml ++++ b/src/html/targets.ml +@@ -17,7 +17,7 @@ + open StdLabels + open Odoc_model.Paths + +-let functor_arg_pos { Odoc_model.Lang.FunctorArgument.id ; _ } = ++let functor_arg_pos { Odoc_model.Lang.FunctorParameter.id ; _ } = + match id with + | `Argument (_, nb, _) -> nb + | _ -> +@@ -63,7 +63,7 @@ and signature ~prefix (t : Odoc_model.Lang.Signature.t) = + add_items ~don't:false [] t + + and functor_argument ~prefix arg = +- let open Odoc_model.Lang.FunctorArgument in ++ let open Odoc_model.Lang.FunctorParameter in + match arg.expansion with + | None -> [] + | Some expansion -> +@@ -82,8 +82,8 @@ and module_expansion ~prefix (t : Odoc_model.Lang.Module.expansion) = + let subpages = signature ~prefix sg in + List.fold_left args ~init:subpages ~f:(fun subpages arg -> + match arg with +- | None -> subpages +- | Some arg -> ++ | Odoc_model.Lang.FunctorParameter.Unit -> subpages ++ | Named arg -> + let arg_subpages = functor_argument ~prefix arg in + arg_subpages @ subpages + ) +diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml +index 05f24eb..21059ba 100644 +--- a/src/loader/cmi.ml ++++ b/src/loader/cmi.ml +@@ -837,12 +837,15 @@ let rec read_module_type env parent pos (mty : Odoc_model.Compat.module_type) = + match mty with + | Mty_ident p -> Path (Env.Path.read_module_type env p) + | Mty_signature sg -> Signature (read_signature env parent sg) +- | Mty_functor(id, arg, res) -> +- let arg = +- match arg with +- | None -> None +- | Some arg -> +- let name = parenthesise (Ident.name id) in ++ | Mty_functor(parameter, res) -> ++ let parameter, env = ++ match parameter with ++ | Unit -> Odoc_model.Lang.FunctorParameter.Unit, env ++ | Named (id_opt, arg) -> ++ let name, env = match id_opt with ++ | Some id -> parenthesise (Ident.name id), Env.add_argument parent pos id (ArgumentName.of_ident id) env ++ | None -> "_", env ++ in + let id = `Argument(parent, pos, Odoc_model.Names.ArgumentName.of_string name) in + let arg = read_module_type env id 1 arg in + let expansion = +@@ -850,11 +853,10 @@ let rec read_module_type env parent pos (mty : Odoc_model.Compat.module_type) = + | Signature _ -> Some Module.AlreadyASig + | _ -> None + in +- Some { FunctorArgument. id; expr = arg; expansion } ++ Odoc_model.Lang.FunctorParameter.Named ({ FunctorParameter. id; expr = arg; expansion }), env + in +- let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in +- let res = read_module_type env parent (pos + 1) res in +- Functor(arg, res) ++ let res = read_module_type env parent (pos+1) res in ++ Functor(parameter, res) + | Mty_alias _ -> assert false + + and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_declaration) = +diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml +index 892959a..34cfb16 100644 +--- a/src/loader/cmt.ml ++++ b/src/loader/cmt.ml +@@ -357,24 +357,48 @@ let rec read_module_expr env parent label_parent pos mexpr = + | Tmod_ident _ -> + Cmi.read_module_type env parent pos (Odoc_model.Compat.module_type mexpr.mod_type) + | Tmod_structure str -> Signature (read_structure env parent str) ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ | Tmod_functor(parameter, res) -> ++ let parameter, env = ++ match parameter with ++ | Unit -> FunctorParameter.Unit, env ++ | Named (id_opt, _, arg) -> ++ let name, env = ++ match id_opt with ++ | Some id -> parenthesise (Ident.name id), Env.add_argument parent pos id (ArgumentName.of_ident id) env ++ | None -> "_", env ++ in ++ let id = `Argument(parent, pos, Odoc_model.Names.ArgumentName.of_string name) in ++ let arg = Cmti.read_module_type env id label_parent 1 arg in ++ let expansion = ++ match arg with ++ | Signature _ -> Some Module.AlreadyASig ++ | _ -> None ++ in ++ Named { id; expr=arg; expansion}, env ++ in ++ let res = read_module_expr env parent label_parent (pos + 1) res in ++ Functor(parameter, res) ++#else + | Tmod_functor(id, _, arg, res) -> + let arg = + match arg with +- | None -> None ++ | None -> FunctorParameter.Unit + | Some arg -> + let name = parenthesise (Ident.name id) in + let id = `Argument(parent, pos, ArgumentName.of_string name) in + let arg = Cmti.read_module_type env id label_parent 1 arg in +- let expansion = +- match arg with +- | Signature _ -> Some Module.AlreadyASig +- | _ -> None +- in +- Some { FunctorArgument. id; expr = arg; expansion } ++ let expansion = ++ match arg with ++ | Signature _ -> Some Module.AlreadyASig ++ | _ -> None ++ in ++ Named { FunctorParameter. id; expr = arg; expansion } + in + let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in + let res = read_module_expr env parent label_parent (pos + 1) res in + Functor(arg, res) ++#endif + | Tmod_apply _ -> + Cmi.read_module_type env parent pos (Odoc_model.Compat.module_type mexpr.mod_type) + | Tmod_constraint(_, _, Tmodtype_explicit mty, _) -> +@@ -392,8 +416,16 @@ and unwrap_module_expr_desc = function + and read_module_binding env parent mb = + let open Module in + let open Odoc_model.Names in +- let name = parenthesise (Ident.name mb.mb_id) in +- let id = `Module(parent, ModuleName.of_string name) in ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ match mb.mb_id with ++ | None -> None ++ | Some id -> ++ let name = parenthesise (Ident.name id) in ++ let id = `Module(parent, ModuleName.of_string name) in ++#else ++ let name = parenthesise (Ident.name mb.mb_id) in ++ let id = `Module(parent, ModuleName.of_string name) in ++#endif + let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in + let doc = Doc_attr.attached container mb.mb_attributes in + let canonical = +@@ -409,16 +441,22 @@ and read_module_binding env parent mb = + | _ -> ModuleType (read_module_expr env id container 1 mb.mb_expr) + in + let hidden = ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ match canonical, mb.mb_id with ++ | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id) ++ | _, _ -> false ++#else + match canonical with +- | Some _ -> false + | None -> Odoc_model.Root.contains_double_underscore (Ident.name mb.mb_id) ++ | _ -> false ++#endif + in + let expansion = + match type_ with + | ModuleType (ModuleType.Signature _) -> Some AlreadyASig + | _ -> None + in +- {id; doc; type_; expansion; canonical; hidden; display_type = None} ++ Some {id; doc; type_; expansion; canonical; hidden; display_type = None} + + and read_module_bindings env parent mbs = + let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) +@@ -428,8 +466,10 @@ and read_module_bindings env parent mbs = + (fun (acc, recursive) mb -> + let comments = Doc_attr.standalone_multiple container mb.mb_attributes in + let comments = List.map (fun com -> Comment com) comments in +- let mb = read_module_binding env parent mb in +- ((Module (recursive, mb))::(List.rev_append comments acc), And)) ++ match read_module_binding env parent mb with ++ | Some mb -> ++ ((Module (recursive, mb))::(List.rev_append comments acc), And) ++ | None -> (acc, recursive)) + ([], Rec) mbs + |> fst + |> List.rev +@@ -484,8 +524,12 @@ and read_structure_item env parent item = + #endif + in + [Exception ext] +- | Tstr_module mb -> +- [Module (Ordinary, read_module_binding env parent mb)] ++ | Tstr_module mb -> begin ++ match read_module_binding env parent mb with ++ | Some mb -> ++ [Module (Ordinary, mb)] ++ | None -> [] ++ end + | Tstr_recmodule mbs -> + read_module_bindings env parent mbs + | Tstr_modtype mtd -> +diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml +index 13afb84..85ae9c2 100644 +--- a/src/loader/cmti.ml ++++ b/src/loader/cmti.ml +@@ -477,24 +477,49 @@ and read_module_type env parent label_parent pos mty = + match mty.mty_desc with + | Tmty_ident(p, _) -> Path (Env.Path.read_module_type env p) + | Tmty_signature sg -> Signature (read_signature env parent sg) ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ | Tmty_functor(parameter, res) -> ++ let parameter, env = ++ match parameter with ++ | Unit -> FunctorParameter.Unit, env ++ | Named (id_opt, _, arg) -> ++ let name, env = ++ match id_opt with ++ | Some id -> ++ parenthesise (Ident.name id), Env.add_argument parent pos id (ArgumentName.of_ident id) env ++ | None -> "_", env ++ in ++ let id = `Argument(parent, pos, ArgumentName.of_string name) in ++ let arg = read_module_type env id label_parent 1 arg in ++ let expansion = ++ match arg with ++ | Signature _ -> Some Module.AlreadyASig ++ | _ -> None ++ in ++ Named { id; expr = arg; expansion }, env ++ in ++ let res = read_module_type env parent label_parent (pos + 1) res in ++ Functor(parameter, res) ++#else + | Tmty_functor(id, _, arg, res) -> + let arg = + match arg with +- | None -> None ++ | None -> Odoc_model.Lang.FunctorParameter.Unit + | Some arg -> + let name = parenthesise (Ident.name id) in + let id = `Argument(parent, pos, Odoc_model.Names.ArgumentName.of_string name) in +- let arg = read_module_type env id label_parent 1 arg in ++ let arg = read_module_type env id label_parent 1 arg in + let expansion = + match arg with + | Signature _ -> Some Module.AlreadyASig + | _ -> None + in +- Some { FunctorArgument. id; expr = arg; expansion } ++ Named { FunctorParameter. id; expr = arg; expansion } + in + let env = Env.add_argument parent pos id (ArgumentName.of_ident id) env in +- let res = read_module_type env parent label_parent (pos + 1) res in +- Functor(arg, res) ++ let res = read_module_type env parent label_parent (pos + 1) res in ++ Functor(arg, res) ++#endif + | Tmty_with(body, subs) -> + let body = read_module_type env parent label_parent pos body in + let subs = List.map (read_with_constraint env label_parent) subs in +@@ -529,8 +554,17 @@ and read_module_type_declaration env parent mtd = + + and read_module_declaration env parent md = + let open Module in ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ match md.md_id with ++ | None -> None ++ | Some id -> ++ let name = parenthesise (Ident.name id) in ++ let id = `Module(parent, Odoc_model.Names.ModuleName.of_string name) in ++#else + let name = parenthesise (Ident.name md.md_id) in + let id = `Module(parent, Odoc_model.Names.ModuleName.of_string name) in ++#endif ++ + let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in + let doc = Doc_attr.attached container md.md_attributes in + let canonical = +@@ -546,16 +580,22 @@ and read_module_declaration env parent md = + | _ -> ModuleType (read_module_type env id container 1 md.md_type) + in + let hidden = ++#if OCAML_MAJOR=4 && OCAML_MINOR >= 10 ++ match canonical, md.md_id with ++ | None, Some id -> Odoc_model.Root.contains_double_underscore (Ident.name id) ++ | _,_ -> false ++#else + match canonical with +- | Some _ -> false + | None -> Odoc_model.Root.contains_double_underscore (Ident.name md.md_id) ++ | _ -> false ++#endif + in + let expansion = + match type_ with + | ModuleType (ModuleType.Signature _) -> Some AlreadyASig + | _ -> None + in +- {id; doc; type_; expansion; canonical; hidden; display_type = None} ++ Some {id; doc; type_; expansion; canonical; hidden; display_type = None} + + and read_module_declarations env parent mds = + let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in +@@ -564,8 +604,9 @@ and read_module_declarations env parent mds = + (fun (acc, recursive) md -> + let comments = Doc_attr.standalone_multiple container md.md_attributes in + let comments = List.map (fun com -> Comment com) comments in +- let md = read_module_declaration env parent md in +- ((Module (recursive, md))::(List.rev_append comments acc), And)) ++ match read_module_declaration env parent md with ++ | Some md -> ((Module (recursive, md))::(List.rev_append comments acc), And) ++ | None -> acc, recursive) + ([], Rec) mds + |> fst + |> List.rev +@@ -614,8 +655,11 @@ and read_signature_item env parent item = + #else + [Exception (read_exception env parent ext)] + #endif +- | Tsig_module md -> +- [Module (Ordinary, read_module_declaration env parent md)] ++ | Tsig_module md -> begin ++ match read_module_declaration env parent md with ++ | Some m -> [Module (Ordinary, m)] ++ | None -> [] ++ end + | Tsig_recmodule mds -> + read_module_declarations env parent mds + | Tsig_modtype mtd -> +diff --git a/src/model/compat.cppo.ml b/src/model/compat.cppo.ml +index 41283f8..0bf88ef 100644 +--- a/src/model/compat.cppo.ml ++++ b/src/model/compat.cppo.ml +@@ -31,9 +31,13 @@ type visibility = + type module_type = + Mty_ident of Path.t + | Mty_signature of signature +- | Mty_functor of Ident.t * module_type option * module_type ++ | Mty_functor of functor_parameter * module_type + | Mty_alias of Path.t + ++and functor_parameter = ++ | Unit ++ | Named of Ident.t option * module_type ++ + and module_presence = + | Mp_present + | Mp_absent +@@ -67,7 +71,48 @@ and modtype_declaration = + + let opt conv = function | None -> None | Some x -> Some (conv x) + +-#if OCAML_MAJOR = 4 && OCAML_MINOR >= 08 ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ ++let rec signature : Types.signature -> signature = fun x -> List.map signature_item x ++ ++and signature_item : Types.signature_item -> signature_item = function ++ | Types.Sig_value (a,b,c) -> Sig_value (a,b,visibility c) ++ | Types.Sig_type (a,b,c,d) -> Sig_type (a,b,c, visibility d) ++ | Types.Sig_typext (a,b,c,d) -> Sig_typext (a,b,c,visibility d) ++ | Types.Sig_module (a,b,c,d,e) -> Sig_module (a, module_presence b, module_declaration c, d, visibility e) ++ | Types.Sig_modtype (a,b,c) -> Sig_modtype (a, modtype_declaration b, visibility c) ++ | Types.Sig_class (a,b,c,d) -> Sig_class (a,b,c, visibility d) ++ | Types.Sig_class_type (a,b,c,d) -> Sig_class_type (a,b,c, visibility d) ++ ++and visibility : Types.visibility -> visibility = function ++ | Types.Hidden -> Hidden ++ | Types.Exported -> Exported ++ ++and module_type : Types.module_type -> module_type = function ++ | Types.Mty_ident p -> Mty_ident p ++ | Types.Mty_signature s -> Mty_signature (signature s) ++ | Types.Mty_functor (a, b) -> Mty_functor(functor_parameter a, module_type b) ++ | Types.Mty_alias p -> Mty_alias p ++ ++and functor_parameter : Types.functor_parameter -> functor_parameter = function ++ | Types.Unit -> Unit ++ | Types.Named (a,b) -> Named (a, module_type b) ++ ++and module_presence : Types.module_presence -> module_presence = function ++ | Types.Mp_present -> Mp_present ++ | Types.Mp_absent -> Mp_absent ++ ++and module_declaration : Types.module_declaration -> module_declaration = fun x -> ++ { md_type = module_type x.Types.md_type; ++ md_attributes = x.md_attributes; ++ md_loc = x.md_loc } ++ ++and modtype_declaration : Types.modtype_declaration -> modtype_declaration = fun x -> ++ { mtd_type = opt module_type x.Types.mtd_type; ++ mtd_attributes = x.Types.mtd_attributes; ++ mtd_loc = x.Types.mtd_loc } ++ ++#elif OCAML_MAJOR = 4 && OCAML_MINOR >= 08 + + let rec signature : Types.signature -> signature = fun x -> List.map signature_item x + +@@ -87,7 +132,11 @@ and visibility : Types.visibility -> visibility = function + and module_type : Types.module_type -> module_type = function + | Types.Mty_ident p -> Mty_ident p + | Types.Mty_signature s -> Mty_signature (signature s) +- | Types.Mty_functor (a, b, c) -> Mty_functor(a, opt module_type b, module_type c) ++ | Types.Mty_functor (a, b, c) -> begin ++ match b with ++ | Some m -> Mty_functor(Named(Some a,module_type m),module_type c) ++ | None -> Mty_functor(Unit,module_type c) ++ end + | Types.Mty_alias p -> Mty_alias p + + and module_presence : Types.module_presence -> module_presence = function +@@ -109,7 +158,11 @@ and modtype_declaration : Types.modtype_declaration -> modtype_declaration = fun + let rec module_type : Types.module_type -> module_type = function + | Types.Mty_ident p -> Mty_ident p + | Types.Mty_signature s -> Mty_signature (signature s) +- | Types.Mty_functor (a, b, c) -> Mty_functor(a, opt module_type b, module_type c) ++ | Types.Mty_functor (a, b, c) -> begin ++ match b with ++ | Some m -> Mty_functor(Named(Some a,module_type m),module_type c) ++ | None -> Mty_functor(Unit,module_type c) ++ end + | Types.Mty_alias (_,q) -> Mty_alias q + + and signature_item : Types.signature_item -> signature_item = function +@@ -140,7 +193,11 @@ and modtype_declaration : Types.modtype_declaration -> modtype_declaration = fun + let rec module_type : Types.module_type -> module_type = function + | Types.Mty_ident p -> Mty_ident p + | Types.Mty_signature s -> Mty_signature (signature s) +- | Types.Mty_functor (a, b, c) -> Mty_functor(a, opt module_type b, module_type c) ++ | Types.Mty_functor (a, b, c) -> begin ++ match b with ++ | Some m -> Mty_functor(Named(Some a,module_type m),module_type c) ++ | None -> Mty_functor(Unit,module_type c) ++ end + | Types.Mty_alias q -> Mty_alias q + + and signature_item : Types.signature_item -> signature_item = function +diff --git a/src/model/ident_env.cppo.ml b/src/model/ident_env.cppo.ml +index 1534ecf..0d25301 100644 +--- a/src/model/ident_env.cppo.ml ++++ b/src/model/ident_env.cppo.ml +@@ -185,12 +185,27 @@ let add_signature_tree_item parent item env = + List.fold_right + (fun decl env -> add_type parent decl.typ_id (TypeName.of_ident decl.typ_id) env) + decls env +- | Tsig_module md -> +- add_module parent md.md_id (ModuleName.of_ident md.md_id) env ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ | Tsig_module { md_id = Some id; _ } -> ++ add_module parent id (ModuleName.of_ident id) env ++ | Tsig_module _ -> ++ env + | Tsig_recmodule mds -> + List.fold_right +- (fun md env -> add_module parent md.md_id (ModuleName.of_ident md.md_id) env) ++ (fun md env -> ++ match md.md_id with ++ | Some id -> add_module parent id (ModuleName.of_ident id) env ++ | None -> env) + mds env ++#else ++ | Tsig_module { md_id; _ } -> ++ add_module parent md_id (ModuleName.of_ident md_id) env ++ | Tsig_recmodule mds -> ++ List.fold_right ++ (fun md env -> ++ add_module parent md.md_id (ModuleName.of_ident md.md_id) env) ++ mds env ++#endif + | Tsig_modtype mtd -> + add_module_type parent mtd.mtd_id (ModuleTypeName.of_ident mtd.mtd_id) env + | Tsig_include incl -> +@@ -250,11 +265,23 @@ let add_structure_tree_item parent item env = + List.fold_right + (fun decl env -> add_type parent decl.typ_id (TypeName.of_ident decl.typ_id) env) + decls env +- | Tstr_module mb -> add_module parent mb.mb_id (ModuleName.of_ident mb.mb_id) env ++#if OCAML_MAJOR = 4 && OCAML_MINOR >= 10 ++ | Tstr_module { mb_id = Some id; _} -> add_module parent id (ModuleName.of_ident id) env ++ | Tstr_module _ -> env ++ | Tstr_recmodule mbs -> ++ List.fold_right ++ (fun mb env -> ++ match mb.mb_id with ++ | Some id -> add_module parent id (ModuleName.of_ident id) env ++ | None -> env) ++ mbs env ++#else ++ | Tstr_module { mb_id; _} -> add_module parent mb_id (ModuleName.of_ident mb_id) env + | Tstr_recmodule mbs -> + List.fold_right + (fun mb env -> add_module parent mb.mb_id (ModuleName.of_ident mb.mb_id) env) + mbs env ++#endif + | Tstr_modtype mtd -> + add_module_type parent mtd.mtd_id (ModuleTypeName.of_ident mtd.mtd_id) env + | Tstr_include incl -> +diff --git a/src/model/lang.ml b/src/model/lang.ml +index 3f8b86e..914d360 100644 +--- a/src/model/lang.ml ++++ b/src/model/lang.ml +@@ -23,7 +23,7 @@ module rec Module : sig + type expansion = + | AlreadyASig + | Signature of Signature.t +- | Functor of FunctorArgument.t option list * Signature.t ++ | Functor of FunctorParameter.t list * Signature.t + + type decl = + | Alias of Path.Module.t +@@ -47,13 +47,17 @@ module rec Module : sig + + end = Module + +-and FunctorArgument : sig +- type t = { ++and FunctorParameter : sig ++ type parameter = { + id : Identifier.Module.t; + expr : ModuleType.expr; + expansion: Module.expansion option; + } +-end = FunctorArgument ++ ++ type t = ++ | Unit ++ | Named of parameter ++end = FunctorParameter + + (** {3 Modules Types} *) + +@@ -68,7 +72,7 @@ and ModuleType : sig + type expr = + | Path of Path.ModuleType.t + | Signature of Signature.t +- | Functor of FunctorArgument.t option * expr ++ | Functor of FunctorParameter.t * expr + | With of expr * substitution list + | TypeOf of Module.decl + +diff --git a/src/model/maps.ml b/src/model/maps.ml +index dac8178..0bad09c 100644 +--- a/src/model/maps.ml ++++ b/src/model/maps.ml +@@ -1119,8 +1119,8 @@ class virtual module_ = object (self) + + method virtual signature : Signature.t -> Signature.t + +- method virtual module_type_functor_arg : +- FunctorArgument.t option -> FunctorArgument.t option ++ method virtual module_type_functor_param : ++ FunctorParameter.t -> FunctorParameter.t + + method module_hidden h = h + +@@ -1133,7 +1133,7 @@ class virtual module_ = object (self) + if sg != sg' then Signature sg' + else expn + | Functor (args, sg) -> +- let args' = list_map self#module_type_functor_arg args in ++ let args' = list_map self#module_type_functor_param args in + let sg' = self#signature sg in + if args != args' || sg != sg' then Functor(args', sg') + else expn +@@ -1278,7 +1278,7 @@ class virtual module_type = object (self) + if sg != sg' then Signature sg' + else expr + | Functor(arg, res) -> +- let arg' = self#module_type_functor_arg arg in ++ let arg' = self#module_type_functor_param arg in + let res' = self#module_type_expr res in + if arg != arg' || res != res' then Functor(arg', res') + else expr +@@ -1292,15 +1292,15 @@ class virtual module_type = object (self) + if decl != decl' then TypeOf decl' + else expr + +- method module_type_functor_arg arg = ++ method module_type_functor_param arg = + match arg with +- | None -> arg +- | Some { FunctorArgument. id; expr; expansion } -> ++ | Unit -> Unit ++ | Named { FunctorParameter. id; expr; expansion } -> + let id' = self#identifier_module id in + let expr' = self#module_type_expr expr in + let expansion' = option_map self#module_expansion expansion in + if id != id' || expr != expr' || expansion != expansion' then +- Some {FunctorArgument. id = id'; expr = expr'; expansion = expansion'} ++ Named {FunctorParameter. id = id'; expr = expr'; expansion = expansion'} + else arg + + method module_type mty = +diff --git a/src/model/maps.mli b/src/model/maps.mli +index c3f8ead..afb1258 100644 +--- a/src/model/maps.mli ++++ b/src/model/maps.mli +@@ -421,8 +421,8 @@ class virtual module_ : object + + method virtual signature : Signature.t -> Signature.t + +- method virtual module_type_functor_arg : +- FunctorArgument.t option -> FunctorArgument.t option ++ method virtual module_type_functor_param : ++ FunctorParameter.t -> FunctorParameter.t + + method module_expansion : Module.expansion -> Module.expansion + +@@ -482,8 +482,8 @@ class virtual module_type : object + + method module_type_expr : ModuleType.expr -> ModuleType.expr + +- method module_type_functor_arg : +- FunctorArgument.t option -> FunctorArgument.t option ++ method module_type_functor_param : ++ FunctorParameter.t -> FunctorParameter.t + + method module_type : ModuleType.t -> ModuleType.t + +diff --git a/src/xref/component_table.ml b/src/xref/component_table.ml +index 9407bf0..1f0710f 100644 +--- a/src/xref/component_table.ml ++++ b/src/xref/component_table.ml +@@ -552,15 +552,15 @@ and signature_items local = + and module_type_expr local expr = + let open Sig in + let open ModuleType in +- let open FunctorArgument in ++ let open FunctorParameter in + match expr with + | Path p -> path (module_type_path local) p + | Signature sg -> signature (signature_items local) sg +- | Functor(Some{ id; expr = arg; _}, res) -> ++ | Functor(Named { id; expr = arg; _}, res) -> + let res = module_type_expr local res in + let arg = module_type_expr local arg in + functor_ local.t.equal local.t.hash id arg res +- | Functor(None, res) -> ++ | Functor(Unit, res) -> + let res = module_type_expr local res in + generative res + | With(body, subs) -> +diff --git a/src/xref/expand.ml b/src/xref/expand.ml +index db45fd1..672979e 100644 +--- a/src/xref/expand.ml ++++ b/src/xref/expand.ml +@@ -21,7 +21,7 @@ open Names + + type partial_expansion = + | Signature of Signature.t +- | Functor of FunctorArgument.t option * ++ | Functor of FunctorParameter.t * + Identifier.Signature.t * int * + ModuleType.expr + +@@ -30,15 +30,16 @@ let subst_signature sub = function + | Some sg -> Some (Subst.signature sub sg) + + let subst_arg sub arg = ++ let open FunctorParameter in + match arg with +- | None -> None +- | Some {FunctorArgument. id; expr; expansion} -> ++ | Unit -> Unit ++ | Named {id; expr; expansion} -> + let id' = Subst.identifier_module sub id in + let expr' = Subst.module_type_expr sub expr in + let expansion' = + Maps.option_map (Subst.module_expansion sub) expansion + in +- Some {FunctorArgument. id = id'; expr = expr'; expansion = expansion'} ++ Named {id = id'; expr = expr'; expansion = expansion'} + + let subst_expansion sub = function + | None -> None +@@ -349,7 +350,7 @@ let expand_include t root incl = + | Some (Functor _) -> To_functor (* TODO: Should be an error *) + end + +-let expand_argument_ t root {FunctorArgument. id; expr; expansion} = ++let expand_argument_ t root {FunctorParameter. id; expr; expansion} = + match expansion with + | None -> + let id = (id : Identifier.Module.t :> Identifier.Signature.t) in +@@ -416,8 +417,8 @@ let find_argument t root pos ex = + match ex with + | None -> raise Not_found + | Some (Signature _) -> raise Not_found +- | Some (Functor(None, _, _, _)) when pos = 1 -> raise Not_found +- | Some (Functor(Some arg, _, _, _)) when pos = 1 -> arg ++ | Some (Functor(Unit, _, _, _)) when pos = 1 -> raise Not_found ++ | Some (Functor(Named arg, _, _, _)) when pos = 1 -> arg + | Some (Functor(_, dest, offset, expr)) -> + loop t root (pos - 1) (expand_module_type_expr t root dest offset expr) + in +@@ -479,9 +480,9 @@ and expand_module_identifier' t root (id : Identifier.Module.t) = + md.id, md.doc, md.canonical, expand_module t root md, [] + | `Argument(parent, pos, _name) -> + let ex = t.expand_signature_identifier ~root parent in +- let {FunctorArgument. id; _} as arg = find_argument t root pos ex in ++ let {FunctorParameter. id; _} as arg = find_argument t root pos ex in + let doc = [] in +- id, doc, None, expand_argument_ t root arg, [] ++ id, doc, None, expand_argument_ t root arg, [] + + and expand_module_type_identifier' t root (id : Identifier.ModuleType.t) = + match id with +@@ -821,16 +822,16 @@ let rec force_expansion t root (ex : partial_expansion option) = + | Some (Module.Functor(args, sg)) -> + Some(Module.Functor(arg :: args, sg)) + +-and expand_argument t arg_opt = +- match arg_opt with +- | None -> arg_opt +- | Some ({FunctorArgument. id; expr; expansion} as arg) -> ++and expand_argument t arg = ++ match arg with ++ | Unit -> arg ++ | Named ({FunctorParameter. id; expr; expansion} as a) -> + match expansion with +- | Some _ -> arg_opt ++ | Some _ -> arg + | None -> + let root = Identifier.Module.root id in +- let expansion = force_expansion t root (expand_argument_ t root arg) in +- Some {FunctorArgument. id; expr; expansion} ++ let expansion = force_expansion t root (expand_argument_ t root a) in ++ Named {FunctorParameter. id; expr; expansion} + + (** We will always expand modules which are not aliases. For aliases we only + expand when the thing they point to should be hidden. *) +@@ -1006,9 +1007,9 @@ class t ?equal ?hash lookup fetch = object + let incl' = expand_include t incl in + super#include_ incl' + +- method! module_type_functor_arg arg = ++ method! module_type_functor_param arg = + let arg = expand_argument t arg in +- super#module_type_functor_arg arg ++ super#module_type_functor_param arg + + method! class_ c = + let c' = expand_class t c in +diff --git a/src/xref/name_env.ml b/src/xref/name_env.ml +index c748728..e12d1c4 100644 +--- a/src/xref/name_env.ml ++++ b/src/xref/name_env.ml +@@ -383,8 +383,8 @@ let rec add_module_type_expr_items expr env = + match expr with + | Path _ -> env + | Signature sg -> add_signature_items sg env +- | Functor(None, expr) -> add_module_type_expr_items expr env +- | Functor(Some{ FunctorArgument. id; _ }, expr) -> ++ | Functor(Unit, expr) -> add_module_type_expr_items expr env ++ | Functor(Named { FunctorParameter. id; _ }, expr) -> + add_module_ident id + (add_module_type_expr_items expr env) + | With(expr, _) -> add_module_type_expr_items expr env +diff --git a/src/xref/resolve.ml b/src/xref/resolve.ml +index 5ce721c..a647e95 100644 +--- a/src/xref/resolve.ml ++++ b/src/xref/resolve.ml +@@ -2172,11 +2172,11 @@ class resolver ?equal ?hash lookup_unit fetch_unit lookup_page fetch_page = + {parent = parent'; doc = doc'; decl = decl'; expansion = expansion'} + else incl + +- method! module_type_functor_arg arg = +- let open Lang.FunctorArgument in ++ method! module_type_functor_param arg = ++ let open Lang.FunctorParameter in + match arg with +- | None -> arg +- | Some{ id; expr; expansion } -> ++ | Unit -> arg ++ | Named { id; expr; expansion } -> + let id' = self#identifier_module id in + let sig_id = (id' :> Identifier.Signature.t) in + let expr' = self#module_type_expr_with_id sig_id expr in +@@ -2184,7 +2184,7 @@ class resolver ?equal ?hash lookup_unit fetch_unit lookup_page fetch_page = + Maps.option_map self#module_expansion expansion + in + if id != id' || expr != expr' || expansion != expansion' then +- Some {id = id'; expr = expr'; expansion = expansion'} ++ Named {id = id'; expr = expr'; expansion = expansion'} + else arg + + method module_type_expr_with_id id expr = +@@ -2223,7 +2223,7 @@ class resolver ?equal ?hash lookup_unit fetch_unit lookup_page fetch_page = + in + With(body, substs) + | Functor(arg, res) -> +- let arg' = self#module_type_functor_arg arg in ++ let arg' = self#module_type_functor_param arg in + let res' = self#module_type_expr_with_id id res in + if res != res' || arg != arg' then Functor(arg', res') + else expr +diff --git a/test/html/cases/bugs.ml b/test/html/cases/bugs.ml +index 831c69f..2c9c30b 100644 +--- a/test/html/cases/bugs.ml ++++ b/test/html/cases/bugs.ml +@@ -3,8 +3,3 @@ let foo (type a) ?(bar : a opt) () = () + (** Triggers an assertion failure when + {:https://github.com/ocaml/odoc/issues/101} is not fixed. *) + +-type 'a opt' = int option +-let foo' (type a) ?(bar : a opt') () = () +-(** Similar to the above, but the printed type of [~bar] should be [int], not +- ['a]. This probably requires fixing in the compiler. See +- {:https://github.com/ocaml/odoc/pull/230#issuecomment-433226807}. *) +diff --git a/test/html/cases/bugs_pre_410.ml b/test/html/cases/bugs_pre_410.ml +new file mode 100644 +index 0000000..0baca54 +--- /dev/null ++++ b/test/html/cases/bugs_pre_410.ml +@@ -0,0 +1,6 @@ ++type 'a opt' = int option ++let foo' (type a) ?(bar : a opt') () = () ++(** Similar to [Bugs], but the printed type of [~bar] should be [int], not ++ ['a]. This probably requires fixing in the compiler. See ++ {:https://github.com/ocaml/odoc/pull/230#issuecomment-433226807}. *) ++ +diff --git a/test/html/expect/test_package+ml/Bugs/index.html b/test/html/expect/test_package+ml/Bugs/index.html +index 6ab1ee7..1325131 100644 +--- a/test/html/expect/test_package+ml/Bugs/index.html ++++ b/test/html/expect/test_package+ml/Bugs/index.html +@@ -37,21 +37,6 @@ +

+ + +-
+-
+- type 'a opt' = int option +-
+-
+-
+-
+- val foo' : ?⁠bar:'a -> unit -> unit +-
+-
+-

+- Similar to the above, but the printed type of ~bar should be int, not 'a. This probably requires fixing in the compiler. See https://github.com/ocaml/odoc/pull/230#issuecomment-433226807. +-

+-
+-
+ + + +diff --git a/test/html/expect/test_package+ml/Bugs_pre_410/index.html b/test/html/expect/test_package+ml/Bugs_pre_410/index.html +new file mode 100644 +index 0000000..1470bcc +--- /dev/null ++++ b/test/html/expect/test_package+ml/Bugs_pre_410/index.html +@@ -0,0 +1,42 @@ ++ ++ ++ ++ Bugs_pre_410 (test_package+ml.Bugs_pre_410) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++
++
++ ++

++ Module Bugs_pre_410 ++

++
++
++
++ type 'a opt' = int option ++
++
++
++
++ val foo' : ?⁠bar:'a -> unit -> unit ++
++
++

++ Similar to Bugs, but the printed type of ~bar should be int, not 'a. This probably requires fixing in the compiler. See https://github.com/ocaml/odoc/pull/230#issuecomment-433226807. ++

++
++
++
++ ++ +diff --git a/test/html/expect/test_package+re/Bugs/index.html b/test/html/expect/test_package+re/Bugs/index.html +index ddfcabc..4b1ebbe 100644 +--- a/test/html/expect/test_package+re/Bugs/index.html ++++ b/test/html/expect/test_package+re/Bugs/index.html +@@ -37,21 +37,6 @@ +

+ + +-
+-
+- type opt'('a) = option(int); +-
+-
+-
+-
+- let foo': ?⁠bar:'a => unit => unit; +-
+-
+-

+- Similar to the above, but the printed type of ~bar should be int, not 'a. This probably requires fixing in the compiler. See https://github.com/ocaml/odoc/pull/230#issuecomment-433226807. +-

+-
+-
+ + + +diff --git a/test/html/expect/test_package+re/Bugs_pre_410/index.html b/test/html/expect/test_package+re/Bugs_pre_410/index.html +new file mode 100644 +index 0000000..7dfc7f4 +--- /dev/null ++++ b/test/html/expect/test_package+re/Bugs_pre_410/index.html +@@ -0,0 +1,42 @@ ++ ++ ++ ++ Bugs_pre_410 (test_package+re.Bugs_pre_410) ++ ++ ++ ++ ++ ++ ++ ++ ++ ++
++
++ ++

++ Module Bugs_pre_410 ++

++
++
++
++ type opt'('a) = option(int); ++
++
++
++
++ let foo': ?⁠bar:'a => unit => unit; ++
++
++

++ Similar to Bugs, but the printed type of ~bar should be int, not 'a. This probably requires fixing in the compiler. See https://github.com/ocaml/odoc/pull/230#issuecomment-433226807. ++

++
++
++
++ ++ +diff --git a/test/html/test.ml b/test/html/test.ml +index 0d24097..b7d2f4e 100644 +--- a/test/html/test.ml ++++ b/test/html/test.ml +@@ -250,8 +250,7 @@ let make_test_case ?theme_uri ?syntax case = + in + Case.name case, `Slow, run + +- +-let source_files = [ ++let source_files_all = [ + ("val.mli", ["Val/index.html"]); + ("markup.mli", ["Markup/index.html"]); + ("section.mli", ["Section/index.html"]); +@@ -279,18 +278,25 @@ let source_files = [ + ("alias.ml", [ + "Alias/index.html"; + "Alias/X/index.html"; +- ]); ++ ]) + ] + +-let source_files = +- let latest_supported = "4.08." in +- match String.sub (Sys.ocaml_version) 0 (String.length latest_supported) with +- | s when s = latest_supported -> source_files @ +- [ ("recent.mli", ["Recent/index.html"; "Recent/X/index.html"]) +- ; ("recent_impl.ml", ["Recent_impl/index.html"])] +- | _ -> source_files +- | exception _ -> source_files ++let source_files_post408 = ++ [ ("recent.mli", ["Recent/index.html"; "Recent/X/index.html"]) ++ ; ("recent_impl.ml", ["Recent_impl/index.html"]) ] + ++let source_files_pre410 = ++ [ ("bugs_pre_410.ml", ["Bugs_pre_410/index.html"]) ] ++ ++let source_files = ++ let cur = Astring.String.cuts ~sep:"." (Sys.ocaml_version) |> List.map (fun i -> try Some (int_of_string i) with _ -> None) in ++ match cur with ++ | Some major :: Some minor :: _ -> ++ List.concat ++ [ (if major=4 && minor<10 then source_files_pre410 else []) ++ ; (if major=4 && minor>8 then source_files_post408 else []) ++ ; source_files_all ] ++ | _ -> source_files_all + + let () = + Env.init (); +-- +2.24.1 + diff --git a/ocaml-odoc.spec b/ocaml-odoc.spec index 74c3331..a7cc248 100644 --- a/ocaml-odoc.spec +++ b/ocaml-odoc.spec @@ -12,6 +12,15 @@ Summary: Documentation compiler for OCaml and Reason License: MIT URL: https://github.com/ocaml/odoc Source0: %{url}/archive/%{version}/%{srcname}-%{version}.tar.gz +# Emit quote before identifier in alias type expressions +# https://github.com/ocaml/odoc/commit/acf7732ec95332b4589eea397409d02cfb8867d3 +Patch0: 0001-Emit-quote-before-identifier-in-alias-type-exprs.patch +# Handle generalized open statements +# https://github.com/ocaml/odoc/commit/152481881b26873d6890519a8e8c15b35f6819bf +Patch1: 0002-Handle-generalized-open-statements-393.patch +# Be compatible with OCaml 4.10 +# https://github.com/ocaml/odoc/commit/35f5619a021944cda5ef495096651a70f49fdedc +Patch2: 0003-4.10-compatibility-408.patch BuildRequires: ocaml >= 4.02.0 BuildRequires: ocaml-alcotest-devel >= 0.8.3 @@ -59,7 +68,7 @@ BuildArch: noarch Documentation for %{name}. %prep -%autosetup -n %{srcname}-%{version} +%autosetup -n %{srcname}-%{version} -p1 # The opam file has not been updated since the great renumbering. sed -i 's/113\.33\.00/0.13.0/' odoc.opam @@ -138,6 +147,9 @@ dune runtest %license LICENSE.md %changelog +* Sat Feb 1 2020 Jerry James - 1.4.2-3 +- Add 3 patches for OCaml 4.10 compatibility + * Wed Jan 29 2020 Fedora Release Engineering - 1.4.2-3 - Rebuilt for https://fedoraproject.org/wiki/Fedora_32_Mass_Rebuild