From 4a99066c9117466965cae8a097b23e20cc6cc531 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 6 Feb 2025 18:30:15 +0000 Subject: [PATCH] Fix suppress_warnings parameter It wasn't being propagated to all of the doc strings --- src/loader/cmi.ml | 16 ++++++++-------- src/loader/cmt.ml | 2 +- src/loader/cmti.ml | 2 +- src/loader/doc_attr.ml | 10 +++++----- src/loader/doc_attr.mli | 3 ++- 5 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/loader/cmi.ml b/src/loader/cmi.ml index 2136b612ea..89da888d8f 100644 --- a/src/loader/cmi.ml +++ b/src/loader/cmi.ml @@ -31,7 +31,7 @@ type env = { suppress_warnings : bool; (** suppress warnings *) } -let empty_doc = { Odoc_model.Comment.elements = []; suppress_warnings = false } +let empty_doc env = { Odoc_model.Comment.elements = []; suppress_warnings = env.suppress_warnings } module Compat = struct #if OCAML_VERSION >= (4, 14, 0) @@ -547,7 +547,7 @@ and read_row env _px row = let elements = List.map (fun (name, f) -> - let doc = empty_doc in + let doc = empty_doc env in match Compat.row_field_repr f with | Rpresent None -> Constructor {name; constant = true; arguments = []; doc} @@ -748,7 +748,7 @@ let read_class_constraints env params = let open ClassSignature in read_type_constraints env params |> List.map (fun (left, right) -> - Constraint { Constraint.left; right; doc = empty_doc }) + Constraint { Constraint.left; right; doc = empty_doc env }) let read_type_declaration env parent id decl = let open TypeDecl in @@ -806,7 +806,7 @@ let read_extension_constructor env parent id ext = let read_type_extension env parent id ext rest = let open Extension in let type_path = Env.Path.read_type env.ident_env ext.ext_type_path in - let doc = Doc_attr.empty in + let doc = Doc_attr.empty env.suppress_warnings in let type_params = mark_type_extension' ext rest in let first = read_extension_constructor env parent id ext in let rest = @@ -840,7 +840,7 @@ let read_exception env parent id ext = let read_method env parent concrete (name, kind, typ) = let open Method in let id = Identifier.Mk.method_(parent, Odoc_model.Names.MethodName.make_std name) in - let doc = Doc_attr.empty in + let doc = Doc_attr.empty env.suppress_warnings in let private_ = (Compat.field_kind_repr kind) <> Compat.field_public in let virtual_ = not (Compat.concr_mem name concrete) in let type_ = read_type_expr env typ in @@ -849,7 +849,7 @@ let read_method env parent concrete (name, kind, typ) = let read_instance_variable env parent (name, mutable_, virtual_, typ) = let open InstanceVariable in let id = Identifier.Mk.instance_variable(parent, Odoc_model.Names.InstanceVariableName.make_std name) in - let doc = Doc_attr.empty in + let doc = Doc_attr.empty env.suppress_warnings in let mutable_ = (mutable_ = Mutable) in let virtual_ = (virtual_ = Virtual) in let type_ = read_type_expr env typ in @@ -894,7 +894,7 @@ let rec read_class_signature env parent params = List.map (read_method env parent (Compat.csig_concr csig)) methods in let items = constraints @ instance_variables @ methods in - Signature {self; items; doc = empty_doc} + Signature {self; items; doc = empty_doc env} | Cty_arrow _ -> assert false let rec read_virtual = function @@ -1167,7 +1167,7 @@ and read_signature_noenv env parent (items : Odoc_model.Compat.signature) = | Sig_class_type _ :: _ | Sig_class _ :: _ -> assert false - | [] -> ({items = List.rev acc; compiled=false; removed = []; doc = empty_doc }, shadowed) + | [] -> ({items = List.rev acc; compiled=false; removed = []; doc = empty_doc env }, shadowed) in loop ([],{s_modules=[]; s_module_types=[]; s_values=[];s_types=[]; s_classes=[]; s_class_types=[]}) items diff --git a/src/loader/cmt.ml b/src/loader/cmt.ml index 943dff835b..79d2600774 100644 --- a/src/loader/cmt.ml +++ b/src/loader/cmt.ml @@ -601,7 +601,7 @@ and read_structure : | Tstr_attribute attr -> Some (`Attribute attr) | _ -> None in - Doc_attr.extract_top_comment internal_tags ~classify parent str.str_items + Doc_attr.extract_top_comment internal_tags ~suppress_warnings:env.suppress_warnings ~classify parent str.str_items in let items = List.fold_left diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml index c2b7995fa3..9f7bb2317c 100644 --- a/src/loader/cmti.ml +++ b/src/loader/cmti.ml @@ -800,7 +800,7 @@ and read_signature : | Tsig_open _ -> Some `Open | _ -> None in - Doc_attr.extract_top_comment internal_tags ~classify parent sg.sig_items + Doc_attr.extract_top_comment internal_tags ~suppress_warnings:env.suppress_warnings ~classify parent sg.sig_items in let items = List.fold_left diff --git a/src/loader/doc_attr.ml b/src/loader/doc_attr.ml index efa50ee5bc..99abd34845 100644 --- a/src/loader/doc_attr.ml +++ b/src/loader/doc_attr.ml @@ -29,9 +29,9 @@ let read_location { Location.loc_start; loc_end; _ } = end_ = point_of_pos loc_end; } -let empty_body = { Comment.elements = []; suppress_warnings = false } +let empty_body suppress_warnings = { Comment.elements = []; suppress_warnings } -let empty : Odoc_model.Comment.docs = empty_body +let empty suppress_warnings : Odoc_model.Comment.docs = empty_body suppress_warnings let load_constant_string = function | {Parsetree.pexp_desc = @@ -202,7 +202,7 @@ let split_docs docs = in inner [] docs -let extract_top_comment internal_tags ~classify parent items = +let extract_top_comment internal_tags ~suppress_warnings ~classify parent items = let classify x = match classify x with | Some (`Attribute attr) -> ( @@ -255,8 +255,8 @@ let extract_top_comment internal_tags ~classify parent items = in let d1, d2 = split_docs docs in ( items, - ( { Comment.elements = d1; suppress_warnings = false }, - { Comment.elements = d2; suppress_warnings = false } ), + ( { Comment.elements = d1; suppress_warnings }, + { Comment.elements = d2; suppress_warnings } ), tags ) let extract_top_comment_class items = diff --git a/src/loader/doc_attr.mli b/src/loader/doc_attr.mli index dba8e386b4..454fb5a5c5 100644 --- a/src/loader/doc_attr.mli +++ b/src/loader/doc_attr.mli @@ -17,7 +17,7 @@ open Odoc_model module Paths = Odoc_model.Paths -val empty : Odoc_model.Comment.docs +val empty : bool -> Odoc_model.Comment.docs val is_stop_comment : Parsetree.attribute -> bool @@ -61,6 +61,7 @@ val standalone_multiple : val extract_top_comment : 'tags Semantics.handle_internal_tags -> + suppress_warnings:bool -> classify:('item -> [ `Attribute of Parsetree.attribute | `Open ] option) -> Paths.Identifier.Signature.t -> 'item list ->