Skip to content

Add a few more tests in anticipation of fixes #1079

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 7 commits into from
Mar 7, 2024
Merged

Add a few more tests in anticipation of fixes #1079

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
2f35c71
Add a test for the size of `module type of` expressions
jonludlam Nov 21, 2023
ecdc4a6
Add module-type-of generator test
jonludlam Nov 22, 2023
19e2472
Changes to Component.Fmt
jonludlam Feb 7, 2024
a78d442
Add a bunch of tests for testing `module type of` and `include`
jonludlam Dec 8, 2023
e3d4e36
Limit some tests to specific ocaml versions
jonludlam Feb 5, 2024
63ef560
Add doc comment for Component.Fmt helper functions
jonludlam Mar 6, 2024
574425c
Update test/xref2/module_type_of_size.t/run.t
jonludlam Mar 7, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1,282 changes: 710 additions & 572 deletions src/xref2/component.ml
View file
Open in desktop

Large diffs are not rendered by default.

133 changes: 78 additions & 55 deletions src/xref2/component.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -514,129 +514,152 @@ end

(** Formatting functions for components *)
module Fmt : sig
val signature : Format.formatter -> Signature.t -> unit
type config = {
short_paths : bool;
show_canonical : bool;
show_removed : bool;
show_expansions : bool;
show_include_expansions : bool;
}

val default : config

val signature : config -> Format.formatter -> Signature.t -> unit

val removed_item : Format.formatter -> Signature.removed_item -> unit
val removed_item :
config -> Format.formatter -> Signature.removed_item -> unit

val removed_item_list :
Format.formatter -> Signature.removed_item list -> unit
config -> Format.formatter -> Signature.removed_item list -> unit

val class_ : Format.formatter -> Class.t -> unit
val class_ : config -> Format.formatter -> Class.t -> unit

val class_type : Format.formatter -> ClassType.t -> unit
val class_type : config -> Format.formatter -> ClassType.t -> unit

val include_ : Format.formatter -> Include.t -> unit
val include_ : config -> Format.formatter -> Include.t -> unit

val value : Format.formatter -> Value.t -> unit
val value : config -> Format.formatter -> Value.t -> unit

val module_decl : Format.formatter -> Module.decl -> unit
val module_decl : config -> Format.formatter -> Module.decl -> unit

val include_decl : Format.formatter -> Include.decl -> unit
val include_decl : config -> Format.formatter -> Include.decl -> unit

val module_ : Format.formatter -> Module.t -> unit
val module_ : config -> Format.formatter -> Module.t -> unit

val module_type : Format.formatter -> ModuleType.t -> unit
val module_type : config -> Format.formatter -> ModuleType.t -> unit

val simple_expansion : Format.formatter -> ModuleType.simple_expansion -> unit
val simple_expansion :
config -> bool -> Format.formatter -> ModuleType.simple_expansion -> unit

val module_type_type_of_desc :
Format.formatter -> ModuleType.type_of_desc -> unit
config -> Format.formatter -> ModuleType.type_of_desc -> unit

val u_module_type_expr : Format.formatter -> ModuleType.U.expr -> unit
val u_module_type_expr :
config -> Format.formatter -> ModuleType.U.expr -> unit

val module_type_expr : Format.formatter -> ModuleType.expr -> unit
val module_type_expr : config -> Format.formatter -> ModuleType.expr -> unit

val functor_parameter : Format.formatter -> FunctorParameter.t -> unit
val functor_parameter :
config -> Format.formatter -> FunctorParameter.t -> unit

val functor_parameter_parameter :
Format.formatter -> FunctorParameter.parameter -> unit
config -> Format.formatter -> FunctorParameter.parameter -> unit

val type_decl : Format.formatter -> TypeDecl.t -> unit
val type_decl : config -> Format.formatter -> TypeDecl.t -> unit

val type_equation : Format.formatter -> TypeDecl.Equation.t -> unit
val type_equation : config -> Format.formatter -> TypeDecl.Equation.t -> unit

val exception_ : Format.formatter -> Exception.t -> unit
val exception_ : config -> Format.formatter -> Exception.t -> unit

val extension : Format.formatter -> Extension.t -> unit
val extension : config -> Format.formatter -> Extension.t -> unit

val substitution : Format.formatter -> ModuleType.substitution -> unit
val substitution :
config -> Format.formatter -> ModuleType.substitution -> unit

val substitution_list :
Format.formatter -> ModuleType.substitution list -> unit
config -> Format.formatter -> ModuleType.substitution list -> unit

val type_expr_list : Format.formatter -> TypeExpr.t list -> unit
val type_expr_list : config -> Format.formatter -> TypeExpr.t list -> unit

val type_object : Format.formatter -> TypeExpr.Object.t -> unit
val type_object : config -> Format.formatter -> TypeExpr.Object.t -> unit

val type_class :
Format.formatter -> Cpath.class_type * TypeExpr.t list -> unit
config -> Format.formatter -> Cpath.class_type * TypeExpr.t list -> unit

val type_package : Format.formatter -> TypeExpr.Package.t -> unit
val type_package : config -> Format.formatter -> TypeExpr.Package.t -> unit

val type_expr_polymorphic_variant :
Format.formatter -> TypeExpr.Polymorphic_variant.t -> unit
config -> Format.formatter -> TypeExpr.Polymorphic_variant.t -> unit

val type_expr : Format.formatter -> TypeExpr.t -> unit
val type_expr : config -> Format.formatter -> TypeExpr.t -> unit

val resolved_module_path : Format.formatter -> Cpath.Resolved.module_ -> unit
val resolved_module_path :
config -> Format.formatter -> Cpath.Resolved.module_ -> unit

val module_path : Format.formatter -> Cpath.module_ -> unit
val module_path : config -> Format.formatter -> Cpath.module_ -> unit

val resolved_module_type_path :
Format.formatter -> Cpath.Resolved.module_type -> unit
config -> Format.formatter -> Cpath.Resolved.module_type -> unit

val module_type_path : Format.formatter -> Cpath.module_type -> unit
val module_type_path : config -> Format.formatter -> Cpath.module_type -> unit

val resolved_type_path : Format.formatter -> Cpath.Resolved.type_ -> unit
val resolved_type_path :
config -> Format.formatter -> Cpath.Resolved.type_ -> unit

val resolved_value_path : Format.formatter -> Cpath.Resolved.value -> unit
val resolved_value_path :
config -> Format.formatter -> Cpath.Resolved.value -> unit

val resolved_parent_path : Format.formatter -> Cpath.Resolved.parent -> unit
val resolved_parent_path :
config -> Format.formatter -> Cpath.Resolved.parent -> unit

val type_path : Format.formatter -> Cpath.type_ -> unit
val type_path : config -> Format.formatter -> Cpath.type_ -> unit

val value_path : Format.formatter -> Cpath.value -> unit
val value_path : config -> Format.formatter -> Cpath.value -> unit

val resolved_class_type_path :
Format.formatter -> Cpath.Resolved.class_type -> unit
config -> Format.formatter -> Cpath.Resolved.class_type -> unit

val class_type_path : Format.formatter -> Cpath.class_type -> unit
val class_type_path : config -> Format.formatter -> Cpath.class_type -> unit

val model_path : Format.formatter -> Odoc_model.Paths.Path.t -> unit
val model_path : config -> Format.formatter -> Odoc_model.Paths.Path.t -> unit

val model_resolved_path :
Format.formatter -> Odoc_model.Paths.Path.Resolved.t -> unit
config -> Format.formatter -> Odoc_model.Paths.Path.Resolved.t -> unit

val model_identifier :
Format.formatter -> Odoc_model.Paths.Identifier.t -> unit
config -> Format.formatter -> Odoc_model.Paths.Identifier.t -> unit

val model_fragment : Format.formatter -> Odoc_model.Paths.Fragment.t -> unit
val model_fragment :
config -> Format.formatter -> Odoc_model.Paths.Fragment.t -> unit

val model_resolved_fragment :
Format.formatter -> Odoc_model.Paths.Fragment.Resolved.t -> unit
config -> Format.formatter -> Odoc_model.Paths.Fragment.Resolved.t -> unit

val resolved_root_fragment : Format.formatter -> Cfrag.root -> unit
val resolved_root_fragment : config -> Format.formatter -> Cfrag.root -> unit

val resolved_signature_fragment :
Format.formatter -> Cfrag.resolved_signature -> unit
config -> Format.formatter -> Cfrag.resolved_signature -> unit

val resolved_module_fragment :
Format.formatter -> Cfrag.resolved_module -> unit
config -> Format.formatter -> Cfrag.resolved_module -> unit

val resolved_type_fragment : Format.formatter -> Cfrag.resolved_type -> unit
val resolved_type_fragment :
config -> Format.formatter -> Cfrag.resolved_type -> unit

val signature_fragment : Format.formatter -> Cfrag.signature -> unit
val signature_fragment : config -> Format.formatter -> Cfrag.signature -> unit

val module_fragment : Format.formatter -> Cfrag.module_ -> unit
val module_fragment : config -> Format.formatter -> Cfrag.module_ -> unit

val module_type_fragment : Format.formatter -> Cfrag.module_type -> unit
val module_type_fragment :
config -> Format.formatter -> Cfrag.module_type -> unit

val type_fragment : Format.formatter -> Cfrag.type_ -> unit
val type_fragment : config -> Format.formatter -> Cfrag.type_ -> unit

val model_resolved_reference :
Format.formatter -> Odoc_model.Paths.Reference.Resolved.t -> unit
config -> Format.formatter -> Odoc_model.Paths.Reference.Resolved.t -> unit

val model_reference : Format.formatter -> Odoc_model.Paths.Reference.t -> unit
val model_reference :
config -> Format.formatter -> Odoc_model.Paths.Reference.t -> unit
end

module Of_Lang : sig
Expand Down
12 changes: 0 additions & 12 deletions src/xref2/dune
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,15 +52,3 @@
(progn
(run ocaml-mdx-test %{x})
(diff? %{x} %{x}.corrected))))

(rule
(alias runmdx)
(deps
(:x scratch.md)
(package odoc))
(enabled_if
(> %{ocaml_version} 4.08))
(action
(progn
(run ocaml-mdx-test %{x})
(diff? %{x} %{x}.corrected))))
10 changes: 7 additions & 3 deletions src/xref2/env.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,16 +42,20 @@ let pp_lookup_type fmt =
| Some (`Resolved digest) -> Format.fprintf fmt "Some (Resolved %s)" digest
| None -> Format.fprintf fmt "None"
in
let c = Component.Fmt.default in
function
| Module r ->
Format.fprintf fmt "Module %a" Component.Fmt.model_identifier
Format.fprintf fmt "Module %a"
(Component.Fmt.model_identifier c)
(r :> Identifier.t)
| ModuleType r ->
Format.fprintf fmt "ModuleType %a" Component.Fmt.model_identifier
Format.fprintf fmt "ModuleType %a"
(Component.Fmt.model_identifier c)
(r :> Identifier.t)
| RootModule (str, res) -> Format.fprintf fmt "RootModule %s %a" str fmtrm res
| ModuleByName (n, r) ->
Format.fprintf fmt "ModuleByName %s, %a" n Component.Fmt.model_identifier
Format.fprintf fmt "ModuleByName %s, %a" n
(Component.Fmt.model_identifier c)
(r :> Identifier.t)
| FragmentRoot i -> Format.fprintf fmt "FragmentRoot %d" i

Expand Down
54 changes: 27 additions & 27 deletions src/xref2/errors.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -132,17 +132,18 @@ module Tools_error = struct

let rec pp : Format.formatter -> any -> unit =
fun fmt err ->
let open Component.Fmt in
let c = default in
match err with
| `OpaqueModule -> Format.fprintf fmt "OpaqueModule"
| `OpaqueClass -> Format.fprintf fmt "Class is abstract"
| `UnresolvedForwardPath -> Format.fprintf fmt "Unresolved forward path"
| `UnresolvedPath (`Module (p, e)) ->
Format.fprintf fmt "Unresolved module path %a (%a)"
Component.Fmt.module_path p pp
Format.fprintf fmt "Unresolved module path %a (%a)" (module_path c) p pp
(e :> any)
| `UnresolvedPath (`ModuleType (p, e)) ->
Format.fprintf fmt "Unresolved module type path %a (%a)"
Component.Fmt.module_type_path p pp
(module_type_path c) p pp
(e :> any)
| `LocalMT (_, id) -> Format.fprintf fmt "Local id found: %a" Ident.fmt id
| `Local (_, id) -> Format.fprintf fmt "Local id found: %a" Ident.fmt id
Expand All @@ -151,29 +152,27 @@ module Tools_error = struct
Format.fprintf fmt "Local id found: %a" Ident.fmt id
| `Find_failure -> Format.fprintf fmt "Find failure"
| `Lookup_failure m ->
Format.fprintf fmt "Lookup failure (module): %a"
Component.Fmt.model_identifier
Format.fprintf fmt "Lookup failure (module): %a" (model_identifier c)
(m :> Odoc_model.Paths.Identifier.t)
| `Lookup_failure_root r ->
Format.fprintf fmt "Lookup failure (root module): %s" r
| `Lookup_failureMT m ->
Format.fprintf fmt "Lookup failure (module type): %a"
Component.Fmt.model_identifier
(model_identifier c)
(m :> Odoc_model.Paths.Identifier.t)
| `Lookup_failureT m ->
Format.fprintf fmt "Lookup failure (type): %a"
Component.Fmt.model_identifier
Format.fprintf fmt "Lookup failure (type): %a" (model_identifier c)
(m :> Odoc_model.Paths.Identifier.t)
| `Lookup_failureV m ->
Format.fprintf fmt "Lookup failure (value): %a"
Component.Fmt.model_identifier
Format.fprintf fmt "Lookup failure (value): %a" (model_identifier c)
(m :> Odoc_model.Paths.Identifier.t)
| `ApplyNotFunctor -> Format.fprintf fmt "Apply module is not a functor"
| `Class_replaced -> Format.fprintf fmt "Class replaced"
| `Parent p -> pp fmt (p :> any)
| `UnexpandedTypeOf t ->
Format.fprintf fmt "Unexpanded `module type of` expression: %a"
Component.Fmt.module_type_type_of_desc t
(module_type_type_of_desc c)
t
| `Parent_sig e -> Format.fprintf fmt "Parent_sig: %a" pp (e :> any)
| `Parent_module_type e ->
Format.fprintf fmt "Parent_module_type: %a" pp (e :> any)
Expand Down Expand Up @@ -333,35 +332,36 @@ let report ~(what : what) ?tools_error action =
Lookup_failures.report_internal "Failed to %s %s %a%a" action subject pp_a
a pp_tools_error tools_error
in
let fmt_id fmt id = model_identifier fmt (id :> Paths.Identifier.t) in
let c = default in
let fmt_id fmt id = model_identifier c fmt (id :> Paths.Identifier.t) in
match what with
| `Functor_parameter id -> r "functor parameter" fmt_id id
| `Value id -> r "value" fmt_id id
| `Class id -> r "class" fmt_id id
| `Class_type id -> r "class type" fmt_id id
| `Module id -> r "module" fmt_id id
| `Module_type id -> r "module type" fmt_id id
| `Module_path path -> r "module path" module_path path
| `Module_type_path path -> r "module type path" module_type_path path
| `Module_type_U expr -> r "module type expr" u_module_type_expr expr
| `Include decl -> r "include" include_decl decl
| `Module_path path -> r "module path" (module_path c) path
| `Module_type_path path -> r "module type path" (module_type_path c) path
| `Module_type_U expr -> r "module type expr" (u_module_type_expr c) expr
| `Include decl -> r "include" (include_decl c) decl
| `Package path ->
r "module package" module_type_path (path :> Cpath.module_type)
| `Type cfrag -> r "type" type_fragment cfrag
| `Type_path path -> r "type" type_path path
| `Value_path path -> r "value" value_path path
| `Class_type_path path -> r "class_type" class_type_path path
| `With_module frag -> r "module substitution" module_fragment frag
r "module package" (module_type_path c) (path :> Cpath.module_type)
| `Type cfrag -> r "type" (type_fragment c) cfrag
| `Type_path path -> r "type" (type_path c) path
| `Value_path path -> r "value" (value_path c) path
| `Class_type_path path -> r "class_type" (class_type_path c) path
| `With_module frag -> r "module substitution" (module_fragment c) frag
| `With_module_type frag ->
r "module type substitution" module_type_fragment frag
| `With_type frag -> r "type substitution" type_fragment frag
r "module type substitution" (module_type_fragment c) frag
| `With_type frag -> r "type substitution" (type_fragment c) frag
| `Module_type_expr cexpr ->
r "module type expression" module_type_expr cexpr
r "module type expression" (module_type_expr c) cexpr
| `Module_type_u_expr cexpr ->
r "module type u expression" u_module_type_expr cexpr
r "module type u expression" (u_module_type_expr c) cexpr
| `Child_module rf -> r "child module" Astring.String.pp rf
| `Child_page rf -> r "child page" Astring.String.pp rf
| `Reference ref -> r "reference" model_reference ref
| `Reference ref -> r "reference" (model_reference c) ref
in
match kind_of_error ~what tools_error with
| Some (`Root name) -> Lookup_failures.report_root ~name
Expand Down
Loading