From 79b82661243b016ffe8529af2dc85505d8f2ec6c Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Mon, 3 Apr 2023 12:00:39 +0200 Subject: [PATCH 1/8] WIP: Add hidden attribute --- src/loader/doc_attr.ml | 8 ++++++-- src/loader/doc_attr.mli | 2 ++ src/loader/ident_env.cppo.ml | 29 ++++++++++++++++------------- 3 files changed, 24 insertions(+), 15 deletions(-) diff --git a/src/loader/doc_attr.ml b/src/loader/doc_attr.ml index dcbc1cea16..8139534013 100644 --- a/src/loader/doc_attr.ml +++ b/src/loader/doc_attr.ml @@ -79,6 +79,7 @@ type parsed_attribute = | `Doc of payload (* Attached comment. *) | `Stop of Location.t (* [(**/**)]. *) | `Alert of string * payload option * Location.t + | `Hidden of Location.t (* [`Alert (name, payload, loc)] is for [\[@@alert name "payload"\]] attributes. *) ] (** Recognize an attribute. *) @@ -108,6 +109,9 @@ let parse_attribute : Parsetree.attribute -> parsed_attribute option = let is_stop_comment attr = match parse_attribute attr with Some (`Stop _) -> true | _ -> false +let is_hidden attr = + match parse_attribute attr with Some (`Hidden _) -> true | _ -> false + let pad_loc loc = { loc.Location.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 } @@ -135,7 +139,7 @@ let attached internal_tags parent attrs = | Some (`Alert (name, p, loc)) -> let elt = mk_alert_payload ~loc name p in loop acc_docs (elt :: acc_alerts) rest - | Some (`Text _ | `Stop _) | None -> loop acc_docs acc_alerts rest) + | Some (`Text _ | `Stop _ | `Hidden _) | None -> loop acc_docs acc_alerts rest) | [] -> (List.rev acc_docs, List.rev acc_alerts) in let ast_docs, alerts = loop [] [] attrs in @@ -212,7 +216,7 @@ let extract_top_comment internal_tags ~classify parent items = let p = match p with Some (p, _) -> Some p | None -> None in let attr_loc = read_location attr_loc in `Alert (Location_.at attr_loc (`Tag (`Alert (name, p)))) - | Some (`Stop _) -> `Return (* Stop at stop-comments. *) + | Some (`Stop _) | Some (`Hidden _) -> `Return (* Stop at stop-comments and hidden attrs. *) | None -> `Skip (* Skip unrecognized attributes. *)) | Some `Open -> `Skip (* Skip open statements *) | None -> `Return diff --git a/src/loader/doc_attr.mli b/src/loader/doc_attr.mli index 643cb581f5..45fa3af974 100644 --- a/src/loader/doc_attr.mli +++ b/src/loader/doc_attr.mli @@ -21,6 +21,8 @@ val empty : Odoc_model.Comment.docs val is_stop_comment : Parsetree.attribute -> bool +val is_hidden : Parsetree.attribute -> bool + val attached : 'tags Semantics.handle_internal_tags -> Paths.Identifier.LabelParent.t -> diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index dfda3f1b8e..935f13f19a 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -164,6 +164,8 @@ let filter_map f x = let rec extract_signature_tree_items hide_item items = let open Typedtree in + let is_hidden (attrs: attribute list) = + hide_item || List.exists Doc_attr.is_hidden attrs in match items with #if OCAML_VERSION < (4,3,0) | { sig_desc = Tsig_type decls; _} :: rest -> @@ -177,32 +179,33 @@ let rec extract_signature_tree_items hide_item items = decls @ extract_signature_tree_items hide_item rest #if OCAML_VERSION >= (4,10,0) - | { sig_desc = Tsig_module { md_id = Some id; _ }; _} :: rest -> - [`Module (id, hide_item)] @ extract_signature_tree_items hide_item rest - | { sig_desc = Tsig_module _; _ } :: rest -> - extract_signature_tree_items hide_item rest + | { sig_desc = Tsig_module { md_id = Some id; md_attributes; _ }; _} :: rest -> + [`Module (id, is_hidden md_attributes)] @ extract_signature_tree_items hide_item rest + | { sig_desc = Tsig_module { md_attributes; _ }; _ } :: rest -> + extract_signature_tree_items (is_hidden md_attributes) rest | { sig_desc = Tsig_recmodule mds; _} :: rest -> List.fold_right ( fun md items -> match md.md_id with - | Some id -> `Module (id, hide_item) :: items + | Some id -> `Module (id, is_hidden md.md_attributes) :: items | None -> items) mds [] @ extract_signature_tree_items hide_item rest #else - | { sig_desc = Tsig_module{ md_id; _}; _} :: rest -> - [`Module (md_id, hide_item)] @ extract_signature_tree_items hide_item rest + | { sig_desc = Tsig_module{ md_id; md_attributes; _}; _} :: rest -> + [`Module (md_id, is_hidden md_attributes)] @ extract_signature_tree_items hide_item rest | { sig_desc = Tsig_recmodule mds; _ } :: rest -> - List.map (fun md -> `Module (md.md_id, hide_item)) + List.map (fun md -> `Module (md.md_id, is_hidden mds.md_attributes)) mds @ extract_signature_tree_items hide_item rest #endif - | { sig_desc = Tsig_value {val_id; _}; _ } :: rest-> - [`Value (val_id, hide_item)] @ extract_signature_tree_items hide_item rest + | { sig_desc = Tsig_value {val_id; val_attributes; _}; _ } :: rest-> + [`Value (val_id, is_hidden val_attributes)] @ extract_signature_tree_items hide_item rest | { sig_desc = Tsig_modtype mtd; _} :: rest -> - [`ModuleType (mtd.mtd_id, hide_item)] @ extract_signature_tree_items hide_item rest + [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_signature_tree_items hide_item rest | {sig_desc = Tsig_include incl; _ } :: rest -> - [`Include (extract_signature_type_items (Compat.signature incl.incl_type))] @ extract_signature_tree_items hide_item rest + [`Include (extract_signature_type_items (Compat.signature incl.incl_type))] + @ extract_signature_tree_items (is_hidden incl.incl_attributes) rest | {sig_desc = Tsig_attribute attr; _ } :: rest -> - let hide_item = if Doc_attr.is_stop_comment attr then not hide_item else hide_item in + let hide_item = if Doc_attr.is_stop_comment attr || Doc_attr.is_hidden attr then not hide_item else hide_item in extract_signature_tree_items hide_item rest | {sig_desc = Tsig_class cls; _} :: rest -> List.map From 3b2ca83e1896b254b993b36bced88ee90edf4cca Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Mon, 3 Apr 2023 12:10:59 +0200 Subject: [PATCH 2/8] Parse hidden attribute --- src/loader/doc_attr.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/loader/doc_attr.ml b/src/loader/doc_attr.ml index 8139534013..444c229a48 100644 --- a/src/loader/doc_attr.ml +++ b/src/loader/doc_attr.ml @@ -78,8 +78,8 @@ type parsed_attribute = [ `Text of payload (* Standalone comment. *) | `Doc of payload (* Attached comment. *) | `Stop of Location.t (* [(**/**)]. *) - | `Alert of string * payload option * Location.t | `Hidden of Location.t + | `Alert of string * payload option * Location.t (* [`Alert (name, payload, loc)] is for [\[@@alert name "payload"\]] attributes. *) ] (** Recognize an attribute. *) @@ -97,6 +97,7 @@ let parse_attribute : Parsetree.attribute -> parsed_attribute option = match load_payload attr_payload with | Some p -> Some (`Doc p) | None -> None) + | "hidden" | "ocaml.hidden" -> Some (`Hidden attr_loc) | "deprecated" | "ocaml.deprecated" -> Some (`Alert ("deprecated", (load_payload attr_payload), attr_loc)) | "alert" | "ocaml.alert" -> From d2aed8f8767906d56a31fb27578f10e59c8e641c Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Wed, 5 Apr 2023 09:52:13 +0200 Subject: [PATCH 3/8] Add some basic tests --- test/generators/cases/hidden.mli | 22 ++++++ test/generators/html/Hidden-N.html | 25 +++++++ test/generators/html/Hidden.html | 35 ++++++++++ test/generators/html/hidden.targets | 2 + test/generators/latex/Hidden.tex | 10 +++ test/generators/latex/hidden.targets | 1 + test/generators/link.dune.inc | 101 +++++++++++++++++++++++++++ test/generators/man/Hidden.3o | 24 +++++++ test/generators/man/Hidden.N.3o | 14 ++++ test/generators/man/hidden.targets | 2 + 10 files changed, 236 insertions(+) create mode 100644 test/generators/cases/hidden.mli create mode 100644 test/generators/html/Hidden-N.html create mode 100644 test/generators/html/Hidden.html create mode 100644 test/generators/html/hidden.targets create mode 100644 test/generators/latex/Hidden.tex create mode 100644 test/generators/latex/hidden.targets create mode 100644 test/generators/man/Hidden.3o create mode 100644 test/generators/man/Hidden.N.3o create mode 100644 test/generators/man/hidden.targets diff --git a/test/generators/cases/hidden.mli b/test/generators/cases/hidden.mli new file mode 100644 index 0000000000..472dca0369 --- /dev/null +++ b/test/generators/cases/hidden.mli @@ -0,0 +1,22 @@ +(** This test cases exercise hidden attribute. *) + +val foo : int +(** This is normal commented text. *) + +val bar : int [@@hidden] +(** OMG! *) + +module M : +sig + val baz : int + +end [@@hidden] + +module N : +sig + val quux : int + + [@@@hidden] + + val omg : int +end diff --git a/test/generators/html/Hidden-N.html b/test/generators/html/Hidden-N.html new file mode 100644 index 0000000000..9411092f90 --- /dev/null +++ b/test/generators/html/Hidden-N.html @@ -0,0 +1,25 @@ + + + N (Hidden.N) + + + + + + + +
+

Module Hidden.N

+
+
+
+
+ + val quux : int +
+
+
+ + \ No newline at end of file diff --git a/test/generators/html/Hidden.html b/test/generators/html/Hidden.html new file mode 100644 index 0000000000..1257caa720 --- /dev/null +++ b/test/generators/html/Hidden.html @@ -0,0 +1,35 @@ + + + Hidden (Hidden) + + + + + + +
+

Module Hidden

+

This test cases exercise hidden attribute.

+
+
+
+
+ + val foo : int +

This is normal commented text.

+
+
+
+ + + module N + + : sig ... + end + + +
+
+
+ + \ No newline at end of file diff --git a/test/generators/html/hidden.targets b/test/generators/html/hidden.targets new file mode 100644 index 0000000000..0c837b265f --- /dev/null +++ b/test/generators/html/hidden.targets @@ -0,0 +1,2 @@ +Hidden.html +Hidden-N.html diff --git a/test/generators/latex/Hidden.tex b/test/generators/latex/Hidden.tex new file mode 100644 index 0000000000..509df039c9 --- /dev/null +++ b/test/generators/latex/Hidden.tex @@ -0,0 +1,10 @@ +\section{Module \ocamlinlinecode{Hidden}}\label{module-Hidden}% +This test cases exercise hidden attribute. + +\label{module-Hidden-val-foo}\ocamlcodefragment{\ocamltag{keyword}{val} foo : int}\begin{ocamlindent}This is normal commented text.\end{ocamlindent}% +\medbreak +\label{module-Hidden-module-N}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Hidden-module-N]{\ocamlinlinecode{N}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Hidden-module-N-val-quux}\ocamlcodefragment{\ocamltag{keyword}{val} quux : int}\\ +\end{ocamlindent}% +\ocamlcodefragment{\ocamltag{keyword}{end}}\\ + + diff --git a/test/generators/latex/hidden.targets b/test/generators/latex/hidden.targets new file mode 100644 index 0000000000..2b9e3ddfb3 --- /dev/null +++ b/test/generators/latex/hidden.targets @@ -0,0 +1 @@ +Hidden.tex diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc index 7966602f32..dec0a9ec80 100644 --- 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 hidden.cmti) + (action + (run ocamlc -c -bin-annot -o %{target} %{dep:cases/hidden.mli}))) + +(rule + (target hidden.odoc) + (action + (run odoc compile -o %{target} %{dep:hidden.cmti}))) + +(rule + (target hidden.odocl) + (action + (run odoc link -o %{target} %{dep:hidden.odoc}))) + (rule (target include.cmti) (action @@ -1780,6 +1795,92 @@ (action (diff functor2.targets functor2.targets.gen)))) +(subdir + html + (rule + (targets Hidden.html.gen Hidden-N.html.gen) + (action + (run + odoc + html-generate + --indent + --flat + --extra-suffix + gen + -o + . + %{dep:../hidden.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden.html Hidden.html.gen))) + (rule + (alias runtest) + (action + (diff Hidden-N.html Hidden-N.html.gen)))) + +(subdir + html + (rule + (action + (with-outputs-to + hidden.targets.gen + (run odoc html-targets -o . %{dep:../hidden.odocl} --flat)))) + (rule + (alias runtest) + (action + (diff hidden.targets hidden.targets.gen)))) + +(subdir + latex + (rule + (targets Hidden.tex.gen) + (action + (run odoc latex-generate -o . --extra-suffix gen %{dep:../hidden.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden.tex Hidden.tex.gen)))) + +(subdir + latex + (rule + (action + (with-outputs-to + hidden.targets.gen + (run odoc latex-targets -o . %{dep:../hidden.odocl})))) + (rule + (alias runtest) + (action + (diff hidden.targets hidden.targets.gen)))) + +(subdir + man + (rule + (targets Hidden.3o.gen Hidden.N.3o.gen) + (action + (run odoc man-generate -o . --extra-suffix gen %{dep:../hidden.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden.3o Hidden.3o.gen))) + (rule + (alias runtest) + (action + (diff Hidden.N.3o Hidden.N.3o.gen)))) + +(subdir + man + (rule + (action + (with-outputs-to + hidden.targets.gen + (run odoc man-targets -o . %{dep:../hidden.odocl})))) + (rule + (alias runtest) + (action + (diff hidden.targets hidden.targets.gen)))) + (subdir html (rule diff --git a/test/generators/man/Hidden.3o b/test/generators/man/Hidden.3o new file mode 100644 index 0000000000..6bdde6d2b6 --- /dev/null +++ b/test/generators/man/Hidden.3o @@ -0,0 +1,24 @@ + +.TH Hidden 3 "" "Odoc" "OCaml Library" +.SH Name +Hidden +.SH Synopsis +.sp +.in 2 +\fBModule Hidden\fR +.in +.sp +.fi +This test cases exercise hidden attribute\. +.nf +.SH Documentation +.sp +.nf +\f[CB]val\fR foo : int +.fi +.br +.ti +2 +This is normal commented text\. +.nf +.sp +\f[CB]module\fR N : \f[CB]sig\fR \.\.\. \f[CB]end\fR diff --git a/test/generators/man/Hidden.N.3o b/test/generators/man/Hidden.N.3o new file mode 100644 index 0000000000..eef0c6aa32 --- /dev/null +++ b/test/generators/man/Hidden.N.3o @@ -0,0 +1,14 @@ + +.TH N 3 "" "Odoc" "OCaml Library" +.SH Name +Hidden\.N +.SH Synopsis +.sp +.in 2 +\fBModule Hidden\.N\fR +.in +.sp +.SH Documentation +.sp +.nf +\f[CB]val\fR quux : int diff --git a/test/generators/man/hidden.targets b/test/generators/man/hidden.targets new file mode 100644 index 0000000000..8ff5dca413 --- /dev/null +++ b/test/generators/man/hidden.targets @@ -0,0 +1,2 @@ +Hidden.3o +Hidden.N.3o From dedf22e7c3848127a09d8a30e2e847ea3043ad44 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Wed, 5 Apr 2023 12:14:00 +0200 Subject: [PATCH 4/8] Fix build for OCAML_VERSION < 4.10 --- src/loader/ident_env.cppo.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index 935f13f19a..4feda7de2b 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -194,7 +194,7 @@ let rec extract_signature_tree_items hide_item items = | { sig_desc = Tsig_module{ md_id; md_attributes; _}; _} :: rest -> [`Module (md_id, is_hidden md_attributes)] @ extract_signature_tree_items hide_item rest | { sig_desc = Tsig_recmodule mds; _ } :: rest -> - List.map (fun md -> `Module (md.md_id, is_hidden mds.md_attributes)) + List.map (fun md -> `Module (md.md_id, is_hidden md.md_attributes)) mds @ extract_signature_tree_items hide_item rest #endif | { sig_desc = Tsig_value {val_id; val_attributes; _}; _ } :: rest-> From 5d59a96ffa2ca93660353bc191921acbb3efab2c Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Thu, 6 Apr 2023 08:23:27 +0200 Subject: [PATCH 5/8] Fill missing cases --- src/loader/ident_env.cppo.ml | 38 ++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index 4feda7de2b..a0230a5398 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -217,7 +217,7 @@ let rec extract_signature_tree_items hide_item items = cld.ci_id_typehash #endif in - `Class (cld.ci_id_class, cld.ci_id_class_type, cld.ci_id_object, typehash, hide_item)) + `Class (cld.ci_id_class, cld.ci_id_class_type, cld.ci_id_object, typehash, is_hidden cld.ci_attributes)) cls @ extract_signature_tree_items hide_item rest | { sig_desc = Tsig_class_type cltyps; _ } :: rest -> List.map @@ -230,18 +230,18 @@ let rec extract_signature_tree_items hide_item items = #endif in - `ClassType (clty.ci_id_class_type, clty.ci_id_object, typehash, hide_item)) + `ClassType (clty.ci_id_class_type, clty.ci_id_object, typehash, is_hidden clty.ci_attributes)) cltyps @ extract_signature_tree_items hide_item rest #if OCAML_VERSION >= (4,8,0) | { sig_desc = Tsig_modsubst ms; _} :: rest -> - [`Module (ms.ms_id, hide_item)] @ extract_signature_tree_items hide_item rest + [`Module (ms.ms_id, is_hidden ms.ms_attributes)] @ extract_signature_tree_items hide_item rest | { sig_desc = Tsig_typesubst ts; _} :: rest -> - List.map (fun decl -> `Type (decl.typ_id, hide_item)) + List.map (fun decl -> `Type (decl.typ_id, is_hidden decl.typ_attributes)) ts @ extract_signature_tree_items hide_item rest #endif #if OCAML_VERSION >= (4,13,0) | { sig_desc = Tsig_modtypesubst mtd; _ } :: rest -> - [`ModuleType (mtd.mtd_id, hide_item)] @ extract_signature_tree_items hide_item rest + [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_signature_tree_items hide_item rest #endif | { sig_desc = Tsig_typext _; _} :: rest | { sig_desc = Tsig_exception _; _} :: rest @@ -250,6 +250,8 @@ let rec extract_signature_tree_items hide_item items = let rec read_pattern hide_item pat = let open Typedtree in + let hide_item = + hide_item || List.exists Doc_attr.is_hidden pat.pat_attributes in match pat.pat_desc with | Tpat_var(id, _) -> [`Value(id, hide_item)] | Tpat_alias(pat, id, _) -> `Value(id, hide_item) :: read_pattern hide_item pat @@ -272,13 +274,15 @@ let rec read_pattern hide_item pat = let rec extract_structure_tree_items hide_item items = let open Typedtree in + let is_hidden (attrs: attribute list) = + hide_item || List.exists Doc_attr.is_hidden attrs in match items with #if OCAML_VERSION < (4,3,0) | { str_desc = Tstr_type decls; _ } :: rest -> #else | { str_desc = Tstr_type (_, decls); _ } :: rest -> (* TODO: handle rec_flag *) #endif - List.map (fun decl -> `Type (decl.typ_id, hide_item)) + List.map (fun decl -> `Type (decl.typ_id, is_hidden decl.typ_attributes)) decls @ extract_structure_tree_items hide_item rest @@ -287,32 +291,32 @@ let rec extract_structure_tree_items hide_item items = #else | { str_desc = Tstr_value (_, vbs); _ } :: rest -> (*TODO: handle rec_flag *) #endif - ( List.map (fun vb -> read_pattern hide_item vb.vb_pat) vbs + ( List.map (fun vb -> read_pattern (is_hidden vb.vb_attributes) vb.vb_pat) vbs |> List.flatten) @ extract_structure_tree_items hide_item rest #if OCAML_VERSION >= (4,10,0) - | { str_desc = Tstr_module { mb_id = Some id; _}; _} :: rest -> - [`Module (id, hide_item)] @ extract_structure_tree_items hide_item rest + | { str_desc = Tstr_module { mb_id = Some id; mb_attributes; _}; _} :: rest -> + [`Module (id, (is_hidden mb_attributes))] @ extract_structure_tree_items hide_item rest | { str_desc = Tstr_module _; _} :: rest -> extract_structure_tree_items hide_item rest | { str_desc = Tstr_recmodule mbs; _ } :: rest -> List.fold_right (fun mb items -> match mb.mb_id with - | Some id -> `Module (id, hide_item) :: items + | Some id -> `Module (id, is_hidden mb.mb_attributes) :: items | None -> items) mbs [] @ extract_structure_tree_items hide_item rest #else - | { str_desc = Tstr_module { mb_id; _}; _} :: rest -> - [`Module (mb_id, hide_item)] @ extract_structure_tree_items hide_item rest + | { str_desc = Tstr_module { mb_id; mb_attributes; _}; _} :: rest -> + [`Module (mb_id, is_hidden mb_attributes)] @ extract_structure_tree_items hide_item rest | { str_desc = Tstr_recmodule mbs; _} :: rest -> - List.map (fun mb -> `Module (mb.mb_id, hide_item)) + List.map (fun mb -> `Module (mb.mb_id, is_hidden mbs.mb_attributes)) mbs @ extract_structure_tree_items hide_item rest #endif | { str_desc = Tstr_modtype mtd; _ } :: rest -> - [`ModuleType (mtd.mtd_id, hide_item)] @ extract_structure_tree_items hide_item rest + [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_structure_tree_items hide_item rest | { str_desc = Tstr_include incl; _ } :: rest -> [`Include (extract_signature_type_items (Compat.signature incl.incl_type))] @ extract_structure_tree_items hide_item rest | { str_desc = Tstr_attribute attr; _} :: rest -> - let hide_item = if Doc_attr.is_stop_comment attr then not hide_item else hide_item in + let hide_item = if Doc_attr.is_stop_comment attr || Doc_attr.is_hidden attr then not hide_item else hide_item in extract_structure_tree_items hide_item rest | { str_desc = Tstr_class cls; _ } :: rest -> List.map @@ -328,7 +332,7 @@ let rec extract_structure_tree_items hide_item items = #else cld.ci_id_typehash, #endif - hide_item + is_hidden cld.ci_attributes )) cls @ extract_structure_tree_items hide_item rest | {str_desc = Tstr_class_type cltyps; _ } :: rest -> List.map @@ -340,7 +344,7 @@ let rec extract_structure_tree_items hide_item items = #else clty.ci_id_typehash, #endif - hide_item + is_hidden clty.ci_attributes )) cltyps @ extract_structure_tree_items hide_item rest #if OCAML_VERSION < (4,8,0) | { str_desc = Tstr_open _; _} :: rest -> extract_structure_tree_items hide_item rest From f57d846e60bfbf6ecdba6495aa8ad7cf2ab85729 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Thu, 6 Apr 2023 08:32:36 +0200 Subject: [PATCH 6/8] Add dead link test for hidden attribute --- test/generators/cases/hidden.mli | 1 - .../generators/cases/hidden_dead_link_doc.mli | 25 ++++ .../html/Hidden_dead_link_doc-Foo.html | 27 ++++ .../generators/html/Hidden_dead_link_doc.html | 139 ++++++++++++++++++ .../html/hidden_dead_link_doc.targets | 2 + .../generators/latex/Hidden_dead_link_doc.tex | 28 ++++ .../latex/hidden_dead_link_doc.targets | 1 + test/generators/link.dune.inc | 121 +++++++++++++++ test/generators/man/Hidden_dead_link_doc.3o | 52 +++++++ .../man/Hidden_dead_link_doc.Foo.3o | 14 ++ .../man/hidden_dead_link_doc.targets | 2 + 11 files changed, 411 insertions(+), 1 deletion(-) create mode 100644 test/generators/cases/hidden_dead_link_doc.mli create mode 100644 test/generators/html/Hidden_dead_link_doc-Foo.html create mode 100644 test/generators/html/Hidden_dead_link_doc.html create mode 100644 test/generators/html/hidden_dead_link_doc.targets create mode 100644 test/generators/latex/Hidden_dead_link_doc.tex create mode 100644 test/generators/latex/hidden_dead_link_doc.targets create mode 100644 test/generators/man/Hidden_dead_link_doc.3o create mode 100644 test/generators/man/Hidden_dead_link_doc.Foo.3o create mode 100644 test/generators/man/hidden_dead_link_doc.targets diff --git a/test/generators/cases/hidden.mli b/test/generators/cases/hidden.mli index 472dca0369..4d4cc51ab9 100644 --- a/test/generators/cases/hidden.mli +++ b/test/generators/cases/hidden.mli @@ -4,7 +4,6 @@ val foo : int (** This is normal commented text. *) val bar : int [@@hidden] -(** OMG! *) module M : sig diff --git a/test/generators/cases/hidden_dead_link_doc.mli b/test/generators/cases/hidden_dead_link_doc.mli new file mode 100644 index 0000000000..27052de46c --- /dev/null +++ b/test/generators/cases/hidden_dead_link_doc.mli @@ -0,0 +1,25 @@ +(* This tests that references to hidden items (items in no documentation mode) don't get rendered *) + +module Foo : sig + type t +end + +type foo = | Bar of Foo.t + +type bar = | Bar of { field : Foo.t } + +type foo_ = Bar_ of (int * Foo.t) * int +type bar_ = Bar__ of Foo.t option + +module Another_Foo : sig + type t +end [@@hidden] + +(* this should be rendered as `type another_foo` because it contains a reference to a hidden module*) +type another_foo = | Bar of Another_Foo.t + +(* this should be rendered as `type another_bar` because it contains a reference to a hidden module*) +type another_bar = | Bar of { field : Another_Foo.t } + +type another_foo_ = Bar_ of (int * Another_Foo.t) * int +type another_bar_ = Bar__ of Another_Foo.t option diff --git a/test/generators/html/Hidden_dead_link_doc-Foo.html b/test/generators/html/Hidden_dead_link_doc-Foo.html new file mode 100644 index 0000000000..2ef031708e --- /dev/null +++ b/test/generators/html/Hidden_dead_link_doc-Foo.html @@ -0,0 +1,27 @@ + + + Foo (Hidden_dead_link_doc.Foo) + + + + + + + + +
+

Module Hidden_dead_link_doc.Foo

+
+
+
+
+ + type t +
+
+
+ + \ No newline at end of file diff --git a/test/generators/html/Hidden_dead_link_doc.html b/test/generators/html/Hidden_dead_link_doc.html new file mode 100644 index 0000000000..82d941a7af --- /dev/null +++ b/test/generators/html/Hidden_dead_link_doc.html @@ -0,0 +1,139 @@ + + + Hidden_dead_link_doc (Hidden_dead_link_doc) + + + + + + + +
+

Module Hidden_dead_link_doc

+
+
+
+
+ + + module + Foo + + : sig ... + end + + +
+
+
+
+ + type foo = + +
    +
  1. + + | + Bar + of + Foo.t + + +
    2. +
+
+
+
+
+ + type bar = + +
    +
  1. + + | + Bar + of + { + +
      +
    1. + + + field : + Foo.t; + + +
      2. +
    } +
    2. +
+
+
+
+
+ + type foo_ + = + +
    +
  1. + + | + Bar_ + of int * + Foo.t * int + + +
    2. +
+
+
+
+
+ + type bar_ + = + +
    +
  1. + + | + Bar__ + of + Foo.t + option + + + +
    2. +
+
+
+
+
+ + type another_foo +
+
+
+
+ + type another_bar +
+
+
+
+ + type another_foo_ +
+
+
+
+ + type another_bar_ +
+
+
+ + \ No newline at end of file diff --git a/test/generators/html/hidden_dead_link_doc.targets b/test/generators/html/hidden_dead_link_doc.targets new file mode 100644 index 0000000000..bdb3fd8687 --- /dev/null +++ b/test/generators/html/hidden_dead_link_doc.targets @@ -0,0 +1,2 @@ +Hidden_dead_link_doc.html +Hidden_dead_link_doc-Foo.html diff --git a/test/generators/latex/Hidden_dead_link_doc.tex b/test/generators/latex/Hidden_dead_link_doc.tex new file mode 100644 index 0000000000..aa10a0f65d --- /dev/null +++ b/test/generators/latex/Hidden_dead_link_doc.tex @@ -0,0 +1,28 @@ +\section{Module \ocamlinlinecode{Hidden\_\allowbreak{}dead\_\allowbreak{}link\_\allowbreak{}doc}}\label{module-Hidden_dead_link_doc}% +\label{module-Hidden_dead_link_doc-module-Foo}\ocamlcodefragment{\ocamltag{keyword}{module} \hyperref[module-Hidden_dead_link_doc-module-Foo]{\ocamlinlinecode{Foo}}}\ocamlcodefragment{ : \ocamltag{keyword}{sig}}\begin{ocamlindent}\label{module-Hidden_dead_link_doc-module-Foo-type-t}\ocamlcodefragment{\ocamltag{keyword}{type} t}\\ +\end{ocamlindent}% +\ocamlcodefragment{\ocamltag{keyword}{end}}\\ +\label{module-Hidden_dead_link_doc-type-foo}\ocamlcodefragment{\ocamltag{keyword}{type} foo = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar} \ocamltag{keyword}{of} \hyperref[module-Hidden_dead_link_doc-module-Foo-type-t]{\ocamlinlinecode{Foo.\allowbreak{}t}}}\label{module-Hidden_dead_link_doc-type-foo.Bar}\\ +\end{ocamltabular}% +\\ +\label{module-Hidden_dead_link_doc-type-bar}\ocamlcodefragment{\ocamltag{keyword}{type} bar = }\begin{ocamlindent}\ocamlcodefragment{| \ocamltag{constructor}{Bar} \ocamltag{keyword}{of} \{}\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlinlinecode{field : \hyperref[module-Hidden_dead_link_doc-module-Foo-type-t]{\ocamlinlinecode{Foo.\allowbreak{}t}};\allowbreak{}}\label{module-Hidden_dead_link_doc-type-bar.field}\\ +\end{ocamltabular}% +\\ +\ocamlcodefragment{\}}\label{module-Hidden_dead_link_doc-type-bar.Bar}\\ +\end{ocamlindent}% +\label{module-Hidden_dead_link_doc-type-foo_}\ocamlcodefragment{\ocamltag{keyword}{type} foo\_\allowbreak{} = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar\_\allowbreak{}} \ocamltag{keyword}{of} int * \hyperref[module-Hidden_dead_link_doc-module-Foo-type-t]{\ocamlinlinecode{Foo.\allowbreak{}t}} * int}\label{module-Hidden_dead_link_doc-type-foo_.Bar_}\\ +\end{ocamltabular}% +\\ +\label{module-Hidden_dead_link_doc-type-bar_}\ocamlcodefragment{\ocamltag{keyword}{type} bar\_\allowbreak{} = }\\ +\begin{ocamltabular}{p{1.000\textwidth}}\ocamlcodefragment{| \ocamltag{constructor}{Bar\_\allowbreak{}\_\allowbreak{}} \ocamltag{keyword}{of} \hyperref[module-Hidden_dead_link_doc-module-Foo-type-t]{\ocamlinlinecode{Foo.\allowbreak{}t}} option}\label{module-Hidden_dead_link_doc-type-bar_.Bar__}\\ +\end{ocamltabular}% +\\ +\label{module-Hidden_dead_link_doc-type-another_foo}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo}\\ +\label{module-Hidden_dead_link_doc-type-another_bar}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar}\\ +\label{module-Hidden_dead_link_doc-type-another_foo_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}foo\_\allowbreak{}}\\ +\label{module-Hidden_dead_link_doc-type-another_bar_}\ocamlcodefragment{\ocamltag{keyword}{type} another\_\allowbreak{}bar\_\allowbreak{}}\\ + + diff --git a/test/generators/latex/hidden_dead_link_doc.targets b/test/generators/latex/hidden_dead_link_doc.targets new file mode 100644 index 0000000000..73f9f702ee --- /dev/null +++ b/test/generators/latex/hidden_dead_link_doc.targets @@ -0,0 +1 @@ +Hidden_dead_link_doc.tex diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc index dec0a9ec80..d2eda58bf3 100644 --- a/test/generators/link.dune.inc +++ b/test/generators/link.dune.inc @@ -181,6 +181,27 @@ (action (run odoc link -o %{target} %{dep:hidden.odoc}))) +(rule + (target hidden_dead_link_doc.cmti) + (action + (run + ocamlc + -c + -bin-annot + -o + %{target} + %{dep:cases/hidden_dead_link_doc.mli}))) + +(rule + (target hidden_dead_link_doc.odoc) + (action + (run odoc compile -o %{target} %{dep:hidden_dead_link_doc.cmti}))) + +(rule + (target hidden_dead_link_doc.odocl) + (action + (run odoc link -o %{target} %{dep:hidden_dead_link_doc.odoc}))) + (rule (target include.cmti) (action @@ -1881,6 +1902,106 @@ (action (diff hidden.targets hidden.targets.gen)))) +(subdir + html + (rule + (targets Hidden_dead_link_doc.html.gen Hidden_dead_link_doc-Foo.html.gen) + (action + (run + odoc + html-generate + --indent + --flat + --extra-suffix + gen + -o + . + %{dep:../hidden_dead_link_doc.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden_dead_link_doc.html Hidden_dead_link_doc.html.gen))) + (rule + (alias runtest) + (action + (diff Hidden_dead_link_doc-Foo.html Hidden_dead_link_doc-Foo.html.gen)))) + +(subdir + html + (rule + (action + (with-outputs-to + hidden_dead_link_doc.targets.gen + (run odoc html-targets -o . %{dep:../hidden_dead_link_doc.odocl} --flat)))) + (rule + (alias runtest) + (action + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + +(subdir + latex + (rule + (targets Hidden_dead_link_doc.tex.gen) + (action + (run + odoc + latex-generate + -o + . + --extra-suffix + gen + %{dep:../hidden_dead_link_doc.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden_dead_link_doc.tex Hidden_dead_link_doc.tex.gen)))) + +(subdir + latex + (rule + (action + (with-outputs-to + hidden_dead_link_doc.targets.gen + (run odoc latex-targets -o . %{dep:../hidden_dead_link_doc.odocl})))) + (rule + (alias runtest) + (action + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + +(subdir + man + (rule + (targets Hidden_dead_link_doc.3o.gen Hidden_dead_link_doc.Foo.3o.gen) + (action + (run + odoc + man-generate + -o + . + --extra-suffix + gen + %{dep:../hidden_dead_link_doc.odocl}))) + (rule + (alias runtest) + (action + (diff Hidden_dead_link_doc.3o Hidden_dead_link_doc.3o.gen))) + (rule + (alias runtest) + (action + (diff Hidden_dead_link_doc.Foo.3o Hidden_dead_link_doc.Foo.3o.gen)))) + +(subdir + man + (rule + (action + (with-outputs-to + hidden_dead_link_doc.targets.gen + (run odoc man-targets -o . %{dep:../hidden_dead_link_doc.odocl})))) + (rule + (alias runtest) + (action + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + (subdir html (rule diff --git a/test/generators/man/Hidden_dead_link_doc.3o b/test/generators/man/Hidden_dead_link_doc.3o new file mode 100644 index 0000000000..94e46c1107 --- /dev/null +++ b/test/generators/man/Hidden_dead_link_doc.3o @@ -0,0 +1,52 @@ + +.TH Hidden_dead_link_doc 3 "" "Odoc" "OCaml Library" +.SH Name +Hidden_dead_link_doc +.SH Synopsis +.sp +.in 2 +\fBModule Hidden_dead_link_doc\fR +.in +.sp +.SH Documentation +.sp +.nf +\f[CB]module\fR Foo : \f[CB]sig\fR \.\.\. \f[CB]end\fR +.sp +\f[CB]type\fR foo = +.br +.ti +2 +| \f[CB]Bar\fR \f[CB]of\fR Foo\.t +.br +.sp +\f[CB]type\fR bar = +.br +.ti +2 +| \f[CB]Bar\fR \f[CB]of\fR { +.br +.ti +6 +field : Foo\.t; +.br +.ti +4 +} +.br +.sp +\f[CB]type\fR foo_ = +.br +.ti +2 +| \f[CB]Bar_\fR \f[CB]of\fR int * Foo\.t * int +.br +.sp +\f[CB]type\fR bar_ = +.br +.ti +2 +| \f[CB]Bar__\fR \f[CB]of\fR Foo\.t option +.br +.sp +\f[CB]type\fR another_foo +.sp +\f[CB]type\fR another_bar +.sp +\f[CB]type\fR another_foo_ +.sp +\f[CB]type\fR another_bar_ diff --git a/test/generators/man/Hidden_dead_link_doc.Foo.3o b/test/generators/man/Hidden_dead_link_doc.Foo.3o new file mode 100644 index 0000000000..a656833f93 --- /dev/null +++ b/test/generators/man/Hidden_dead_link_doc.Foo.3o @@ -0,0 +1,14 @@ + +.TH Foo 3 "" "Odoc" "OCaml Library" +.SH Name +Hidden_dead_link_doc\.Foo +.SH Synopsis +.sp +.in 2 +\fBModule Hidden_dead_link_doc\.Foo\fR +.in +.sp +.SH Documentation +.sp +.nf +\f[CB]type\fR t diff --git a/test/generators/man/hidden_dead_link_doc.targets b/test/generators/man/hidden_dead_link_doc.targets new file mode 100644 index 0000000000..3c370ffed7 --- /dev/null +++ b/test/generators/man/hidden_dead_link_doc.targets @@ -0,0 +1,2 @@ +Hidden_dead_link_doc.3o +Hidden_dead_link_doc.Foo.3o From a234da022581840fd60f8255919618cb4850088c Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Thu, 6 Apr 2023 08:40:39 +0200 Subject: [PATCH 7/8] Fix build --- src/loader/ident_env.cppo.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/loader/ident_env.cppo.ml b/src/loader/ident_env.cppo.ml index a0230a5398..78d2053e66 100644 --- a/src/loader/ident_env.cppo.ml +++ b/src/loader/ident_env.cppo.ml @@ -308,7 +308,7 @@ let rec extract_structure_tree_items hide_item items = | { str_desc = Tstr_module { mb_id; mb_attributes; _}; _} :: rest -> [`Module (mb_id, is_hidden mb_attributes)] @ extract_structure_tree_items hide_item rest | { str_desc = Tstr_recmodule mbs; _} :: rest -> - List.map (fun mb -> `Module (mb.mb_id, is_hidden mbs.mb_attributes)) + List.map (fun mb -> `Module (mb.mb_id, is_hidden mb.mb_attributes)) mbs @ extract_structure_tree_items hide_item rest #endif | { str_desc = Tstr_modtype mtd; _ } :: rest -> From f7fe7d4028f8212f087e3b8f76cfdec6db95c7bd Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Thu, 6 Apr 2023 09:03:39 +0200 Subject: [PATCH 8/8] Add constraint to hidden_dead_link_doc test --- test/generators/gen_rules/gen_rules.ml | 1 + test/generators/link.dune.inc | 68 +++++++++++++++++++------- 2 files changed, 52 insertions(+), 17 deletions(-) diff --git a/test/generators/gen_rules/gen_rules.ml b/test/generators/gen_rules/gen_rules.ml index f5e7974e22..1cd7755de2 100644 --- a/test/generators/gen_rules/gen_rules.ml +++ b/test/generators/gen_rules/gen_rules.ml @@ -47,6 +47,7 @@ let constraints = let open Gen_rules_lib in [ ("stop_dead_link_doc.mli", Min "4.04"); + ("hidden_dead_link_doc.mli", Min "4.04"); ("bugs_post_406.mli", Min "4.06"); ("ocamlary.mli", Min "4.07"); ("recent.mli", Min "4.09"); diff --git a/test/generators/link.dune.inc b/test/generators/link.dune.inc index d2eda58bf3..68cb94b20b 100644 --- a/test/generators/link.dune.inc +++ b/test/generators/link.dune.inc @@ -190,17 +190,23 @@ -bin-annot -o %{target} - %{dep:cases/hidden_dead_link_doc.mli}))) + %{dep:cases/hidden_dead_link_doc.mli})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (target hidden_dead_link_doc.odoc) (action - (run odoc compile -o %{target} %{dep:hidden_dead_link_doc.cmti}))) + (run odoc compile -o %{target} %{dep:hidden_dead_link_doc.cmti})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (target hidden_dead_link_doc.odocl) (action - (run odoc link -o %{target} %{dep:hidden_dead_link_doc.odoc}))) + (run odoc link -o %{target} %{dep:hidden_dead_link_doc.odoc})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (target include.cmti) @@ -1916,15 +1922,21 @@ gen -o . - %{dep:../hidden_dead_link_doc.odocl}))) + %{dep:../hidden_dead_link_doc.odocl})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff Hidden_dead_link_doc.html Hidden_dead_link_doc.html.gen))) + (diff Hidden_dead_link_doc.html Hidden_dead_link_doc.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff Hidden_dead_link_doc-Foo.html Hidden_dead_link_doc-Foo.html.gen)))) + (diff Hidden_dead_link_doc-Foo.html Hidden_dead_link_doc-Foo.html.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir html @@ -1932,11 +1944,15 @@ (action (with-outputs-to hidden_dead_link_doc.targets.gen - (run odoc html-targets -o . %{dep:../hidden_dead_link_doc.odocl} --flat)))) + (run odoc html-targets -o . %{dep:../hidden_dead_link_doc.odocl} --flat))) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir latex @@ -1950,11 +1966,15 @@ . --extra-suffix gen - %{dep:../hidden_dead_link_doc.odocl}))) + %{dep:../hidden_dead_link_doc.odocl})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff Hidden_dead_link_doc.tex Hidden_dead_link_doc.tex.gen)))) + (diff Hidden_dead_link_doc.tex Hidden_dead_link_doc.tex.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir latex @@ -1962,11 +1982,15 @@ (action (with-outputs-to hidden_dead_link_doc.targets.gen - (run odoc latex-targets -o . %{dep:../hidden_dead_link_doc.odocl})))) + (run odoc latex-targets -o . %{dep:../hidden_dead_link_doc.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir man @@ -1980,15 +2004,21 @@ . --extra-suffix gen - %{dep:../hidden_dead_link_doc.odocl}))) + %{dep:../hidden_dead_link_doc.odocl})) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff Hidden_dead_link_doc.3o Hidden_dead_link_doc.3o.gen))) + (diff Hidden_dead_link_doc.3o Hidden_dead_link_doc.3o.gen)) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff Hidden_dead_link_doc.Foo.3o Hidden_dead_link_doc.Foo.3o.gen)))) + (diff Hidden_dead_link_doc.Foo.3o Hidden_dead_link_doc.Foo.3o.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir man @@ -1996,11 +2026,15 @@ (action (with-outputs-to hidden_dead_link_doc.targets.gen - (run odoc man-targets -o . %{dep:../hidden_dead_link_doc.odocl})))) + (run odoc man-targets -o . %{dep:../hidden_dead_link_doc.odocl}))) + (enabled_if + (>= %{ocaml_version} 4.04))) (rule (alias runtest) (action - (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)))) + (diff hidden_dead_link_doc.targets hidden_dead_link_doc.targets.gen)) + (enabled_if + (>= %{ocaml_version} 4.04)))) (subdir html