diff --git a/Makefile b/Makefile index 7a147e7800..81ca556406 100644 --- a/Makefile +++ b/Makefile @@ -159,3 +159,9 @@ uutf/dune-project : uutf .PHONY : distclean distclean : rm -rf $(DUNIVERSE_DEPS) dune-local + +.PHONY : promote-html +promote-html: + EXPECTED=`cat _build/default/test/html/_scratch/expected`; \ + ACTUAL=`cat _build/default/test/html/_scratch/actual`; \ + mkdir -p "`dirname "$$EXPECTED"`" && cp "$$ACTUAL" "$$EXPECTED" diff --git a/src/xref2/compile.ml b/src/xref2/compile.ml index 6644a8a84d..bd55315bef 100644 --- a/src/xref2/compile.ml +++ b/src/xref2/compile.ml @@ -308,11 +308,6 @@ and module_type : Env.t -> ModuleType.t -> ModuleType.t = and include_ : Env.t -> Include.t -> Include.t = fun env i -> let open Include in - let remove_top_doc_from_signature s = - let open Signature in - let items = match s.items with Comment (`Docs _) :: xs -> xs | xs -> xs in - { s with items } - in let decl = Component.Of_Lang.(include_decl empty i.decl) in let get_expansion () = match @@ -339,8 +334,7 @@ and include_ : Env.t -> Include.t -> Include.t = in { shadowed = i.expansion.shadowed; - content = - remove_top_doc_from_signature (signature env i.parent expansion_sg); + content = signature env i.parent expansion_sg; } in let expansion = diff --git a/src/xref2/link.ml b/src/xref2/link.ml index 5710ce29bb..c0575f7638 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -34,6 +34,11 @@ let synopsis_from_comment docs = | _ -> None) docs +let remove_top_doc_from_signature s = + let open Signature in + let items = match s.items with Comment (`Docs _) :: xs -> xs | xs -> xs in + { s with items } + exception Loop let rec is_forward : Paths.Path.Module.t -> bool = function @@ -417,14 +422,12 @@ and module_ : Env.t -> Module.t -> Module.t = Alias (`Resolved p, Some (simple_expansion env sg_id le)) | Error _ -> Alias (`Resolved p, e) else Alias (`Resolved p, e) - | Alias _ -> type_ - | ModuleType mty -> ModuleType mty + | Alias _ | ModuleType _ -> type_ in let doc, type_ = match m.doc with [] -> extract_doc type_ | _ -> (m.doc, type_) in - let result = { m with doc = comment_docs env doc; type_ } in - result + { m with doc = comment_docs env doc; type_ } and module_decl : Env.t -> Id.Signature.t -> Module.decl -> Module.decl = fun env id decl -> @@ -470,17 +473,15 @@ and include_ : Env.t -> Include.t -> Include.t = let is_inline_tag element = element.Location_.value = `Tag `Inline in List.exists is_inline_tag doc in - { - i with - decl; - expansion = - { - shadowed = i.expansion.shadowed; - content = signature env i.parent i.expansion.content; - }; - inline = should_be_inlined; - doc; - } + let expansion = + let content = signature env i.parent i.expansion.content in + let content = + if should_be_inlined then content + else remove_top_doc_from_signature content + in + { i.expansion with content } + in + { i with decl; expansion; inline = should_be_inlined; doc } and functor_parameter_parameter : Env.t -> FunctorParameter.parameter -> FunctorParameter.parameter = diff --git a/test/cases/toplevel_comments.mli b/test/cases/toplevel_comments.mli new file mode 100644 index 0000000000..06a7244273 --- /dev/null +++ b/test/cases/toplevel_comments.mli @@ -0,0 +1,37 @@ +(** A doc comment at the beginning of a module is considered to be that + module's doc. *) + +(** Doc of [T], part 1. *) +module type T = sig + (** Doc of [T], part 2. *) + + type t +end + +module Include_inline : sig + include T + (** @inline *) +end + +(** Doc of [Include_inline], part 1. *) +module Include_inline' : sig + (** Doc of [Include_inline], part 2. *) + + include T + (** part 3 + @inline *) +end + +module type Include_inline_T = sig + include T + (** @inline *) +end + +(** Doc of [Include_inline_T'], part 1. *) +module type Include_inline_T' = sig + (** Doc of [Include_inline_T'], part 2. *) + + include T + (** part 3 + @inline *) +end diff --git a/test/html/expect/test_package+ml/Toplevel_comments/Include_inline'/index.html b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline'/index.html new file mode 100644 index 0000000000..8cf0b71dad --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline'/index.html @@ -0,0 +1,51 @@ + + + + + Include_inline' (test_package+ml.Toplevel_comments.Include_inline') + + + + + + + + + + +
+

+ Module Toplevel_comments.Include_inline' +

+

+ Doc of Include_inline, part 1. +

+
+
+

+ Doc of Include_inline, part 2. +

+
+
+
+

+ part 3 +

+

+ Doc of T, part 2. +

+
+
+ type t +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html new file mode 100644 index 0000000000..ad0207a154 --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/Include_inline/index.html @@ -0,0 +1,42 @@ + + + + + Include_inline (test_package+ml.Toplevel_comments.Include_inline) + + + + + + + + + + +
+

+ Module Toplevel_comments.Include_inline +

+
+
+
+
+
+

+ Doc of T, part 2. +

+
+
+ type t +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+ml/Toplevel_comments/index.html b/test/html/expect/test_package+ml/Toplevel_comments/index.html new file mode 100644 index 0000000000..6f28f56c0f --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/index.html @@ -0,0 +1,71 @@ + + + + + Toplevel_comments (test_package+ml.Toplevel_comments) + + + + + + + + + + +
+

+ Module Toplevel_comments +

+

+ A doc comment at the beginning of a module is considered to be that module's doc. +

+
+
+
+
+ module type T = sig ... end +
+
+

+ Doc of T, part 1. +

+
+
+
+
+ module Include_inline : sig ... end +
+
+
+
+ module Include_inline' : sig ... end +
+
+

+ Doc of Include_inline, part 1. +

+
+
+
+
+ module type Include_inline_T = sig ... end +
+
+
+
+ module type Include_inline_T' = sig ... end +
+
+

+ Doc of Include_inline_T', part 1. +

+
+
+
+ + diff --git a/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T'/index.html b/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T'/index.html new file mode 100644 index 0000000000..f1ffbba82c --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T'/index.html @@ -0,0 +1,51 @@ + + + + + Include_inline_T' (test_package+ml.Toplevel_comments.Include_inline_T') + + + + + + + + + + +
+

+ Module type Toplevel_comments.Include_inline_T' +

+

+ Doc of Include_inline_T', part 1. +

+
+
+

+ Doc of Include_inline_T', part 2. +

+
+
+
+

+ part 3 +

+

+ Doc of T, part 2. +

+
+
+ type t +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T/index.html b/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T/index.html new file mode 100644 index 0000000000..ca76e42f4e --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/module-type-Include_inline_T/index.html @@ -0,0 +1,42 @@ + + + + + Include_inline_T (test_package+ml.Toplevel_comments.Include_inline_T) + + + + + + + + + + +
+

+ Module type Toplevel_comments.Include_inline_T +

+
+
+
+
+
+

+ Doc of T, part 2. +

+
+
+ type t +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+ml/Toplevel_comments/module-type-T/index.html b/test/html/expect/test_package+ml/Toplevel_comments/module-type-T/index.html new file mode 100644 index 0000000000..aa8910f0e4 --- /dev/null +++ b/test/html/expect/test_package+ml/Toplevel_comments/module-type-T/index.html @@ -0,0 +1,39 @@ + + + + + T (test_package+ml.Toplevel_comments.T) + + + + + + + + + + +
+

+ Module type Toplevel_comments.T +

+

+ Doc of T, part 1. +

+
+
+

+ Doc of T, part 2. +

+
+
+ type t +
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/Include_inline'/index.html b/test/html/expect/test_package+re/Toplevel_comments/Include_inline'/index.html new file mode 100644 index 0000000000..650ddb1733 --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/Include_inline'/index.html @@ -0,0 +1,51 @@ + + + + + Include_inline' (test_package+re.Toplevel_comments.Include_inline') + + + + + + + + + + +
+

+ Module Toplevel_comments.Include_inline' +

+

+ Doc of Include_inline, part 1. +

+
+
+

+ Doc of Include_inline, part 2. +

+
+
+
+

+ part 3 +

+

+ Doc of T, part 2. +

+
+
+ type t; +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/Include_inline/index.html b/test/html/expect/test_package+re/Toplevel_comments/Include_inline/index.html new file mode 100644 index 0000000000..fc0653636a --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/Include_inline/index.html @@ -0,0 +1,42 @@ + + + + + Include_inline (test_package+re.Toplevel_comments.Include_inline) + + + + + + + + + + +
+

+ Module Toplevel_comments.Include_inline +

+
+
+
+
+
+

+ Doc of T, part 2. +

+
+
+ type t; +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/index.html b/test/html/expect/test_package+re/Toplevel_comments/index.html new file mode 100644 index 0000000000..73cb62c1ac --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/index.html @@ -0,0 +1,71 @@ + + + + + Toplevel_comments (test_package+re.Toplevel_comments) + + + + + + + + + + +
+

+ Module Toplevel_comments +

+

+ A doc comment at the beginning of a module is considered to be that module's doc. +

+
+
+
+
+ module type T = { ... }; +
+
+

+ Doc of T, part 1. +

+
+
+
+
+ module Include_inline: { ... }; +
+
+
+
+ module Include_inline': { ... }; +
+
+

+ Doc of Include_inline, part 1. +

+
+
+
+
+ module type Include_inline_T = { ... }; +
+
+
+
+ module type Include_inline_T' = { ... }; +
+
+

+ Doc of Include_inline_T', part 1. +

+
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T'/index.html b/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T'/index.html new file mode 100644 index 0000000000..278be81b33 --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T'/index.html @@ -0,0 +1,51 @@ + + + + + Include_inline_T' (test_package+re.Toplevel_comments.Include_inline_T') + + + + + + + + + + +
+

+ Module type Toplevel_comments.Include_inline_T' +

+

+ Doc of Include_inline_T', part 1. +

+
+
+

+ Doc of Include_inline_T', part 2. +

+
+
+
+

+ part 3 +

+

+ Doc of T, part 2. +

+
+
+ type t; +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T/index.html b/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T/index.html new file mode 100644 index 0000000000..f4bb0138db --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/module-type-Include_inline_T/index.html @@ -0,0 +1,42 @@ + + + + + Include_inline_T (test_package+re.Toplevel_comments.Include_inline_T) + + + + + + + + + + +
+

+ Module type Toplevel_comments.Include_inline_T +

+
+
+
+
+
+

+ Doc of T, part 2. +

+
+
+ type t; +
+
+
+
+
+
+ + diff --git a/test/html/expect/test_package+re/Toplevel_comments/module-type-T/index.html b/test/html/expect/test_package+re/Toplevel_comments/module-type-T/index.html new file mode 100644 index 0000000000..4da60d5e15 --- /dev/null +++ b/test/html/expect/test_package+re/Toplevel_comments/module-type-T/index.html @@ -0,0 +1,39 @@ + + + + + T (test_package+re.Toplevel_comments.T) + + + + + + + + + + +
+

+ Module type Toplevel_comments.T +

+

+ Doc of T, part 1. +

+
+
+

+ Doc of T, part 2. +

+
+
+ type t; +
+
+
+ + diff --git a/test/html/test.ml b/test/html/test.ml index 6269a448a0..3127951a81 100644 --- a/test/html/test.ml +++ b/test/html/test.ml @@ -176,7 +176,7 @@ let diff = fun output -> let actual_file = Env.path `scratch // output in let expected_file = Env.path `expect // output in - let cmd = sprintf "diff -u -b %s %s" expected_file actual_file in + let cmd = sprintf "diff -N -u -b %S %S" expected_file actual_file in match Sys.command cmd with | 0 -> () | 1 when !already_failed -> @@ -198,9 +198,7 @@ let diff = write_file Env.(path `scratch // "expected") root_expected_file; prerr_endline "\nTo promote the actual output to expected, run:"; - Printf.eprintf "cp `cat %s` `cat %s` && make test\n\n" - Env.(path ~from_root:true `scratch // "actual") - Env.(path ~from_root:true `scratch // "expected"); + prerr_endline "make promote-html && make test\n"; already_failed := true; Alcotest.fail "generated HTML should match expected" @@ -225,15 +223,16 @@ let make_test_case ?theme_uri ?syntax case = (fun output -> let actual_file = Env.path `scratch // output in - (* Pretty-print output HTML for better diffing. *) - pretty_print_html_in_place actual_file; + if Sys.file_exists actual_file then ( + (* Pretty-print output HTML for better diffing. *) + pretty_print_html_in_place actual_file; - (* Run HTML validation on output files. *) - ( if Tidy.is_present_in_path then - let issues = Tidy.validate actual_file in - if issues <> [] then ( - List.iter prerr_endline issues; - Alcotest.fail "Tidy validation error" ) ); + (* Run HTML validation on output files. *) + if Tidy.is_present_in_path then + let issues = Tidy.validate actual_file in + if issues <> [] then ( + List.iter prerr_endline issues; + Alcotest.fail "Tidy validation error" ) ); (* Diff the actual outputs with the expected outputs. *) diff output) @@ -241,6 +240,11 @@ let make_test_case ?theme_uri ?syntax case = in (Case.name case, `Slow, run) +let make_input file sub_modules = + let base = String.capitalize_ascii (Filename.chop_extension file) in + let index p = String.concat Filename.dir_sep (p @ [ "index.html" ]) in + (file, index [ base ] :: List.map (fun m -> index [ base; m ]) sub_modules) + let source_files_all = [ ("val.mli", [ "Val/index.html" ]); @@ -275,6 +279,14 @@ let source_files_all = ("stop.mli", [ "Stop/index.html" ]); ("bugs.ml", [ "Bugs/index.html" ]); ("alias.ml", [ "Alias/index.html"; "Alias/X/index.html" ]); + make_input "toplevel_comments.mli" + [ + "module-type-T"; + "Include_inline"; + "Include_inline'"; + "module-type-Include_inline_T"; + "module-type-Include_inline_T'"; + ]; ] let source_files_post406 = diff --git a/test/html/tidy.ml b/test/html/tidy.ml index bd7df65bec..875d9b5e97 100644 --- a/test/html/tidy.ml +++ b/test/html/tidy.ml @@ -30,7 +30,7 @@ let validate file = "-ashtml"; ] in - let cmd = Printf.sprintf "tidy %s %s" options file in + let cmd = Printf.sprintf "tidy %s %S" options file in let ((_, _, stderr) as proc) = Unix.open_process_full cmd [||] in let errors_and_warnings =