From 2d98e61f9864c793cd99890a60df6abbfd8e8bc2 Mon Sep 17 00:00:00 2001 From: Luke Maurer Date: Thu, 30 Jan 2025 19:01:34 +0000 Subject: [PATCH] Add tests Signed-off-by: Luke Maurer --- tests/test-dirs/parameters.t/basic.ml | 6 + tests/test-dirs/parameters.t/basic.mli | 15 + tests/test-dirs/parameters.t/fancy.ml | 5 + tests/test-dirs/parameters.t/fancy.mli | 6 + tests/test-dirs/parameters.t/p.mli | 13 + tests/test-dirs/parameters.t/p_int.ml | 5 + tests/test-dirs/parameters.t/p_int.mli | 5 + tests/test-dirs/parameters.t/reexport.ml | 6 + tests/test-dirs/parameters.t/reexport.mli | 8 + tests/test-dirs/parameters.t/run.t | 363 ++++++++++++++++++ tests/test-dirs/parameters.t/use_basic_int.ml | 3 + tests/test-dirs/parameters.t/use_fancy_int.ml | 7 + .../test-dirs/parameters.t/use_reexported.ml | 8 + .../test-dirs/parameters.t/use_reexported.mli | 4 + .../parameters.t/use_reexported_int.ml | 4 + 15 files changed, 458 insertions(+) create mode 100644 tests/test-dirs/parameters.t/basic.ml create mode 100644 tests/test-dirs/parameters.t/basic.mli create mode 100644 tests/test-dirs/parameters.t/fancy.ml create mode 100644 tests/test-dirs/parameters.t/fancy.mli create mode 100644 tests/test-dirs/parameters.t/p.mli create mode 100644 tests/test-dirs/parameters.t/p_int.ml create mode 100644 tests/test-dirs/parameters.t/p_int.mli create mode 100644 tests/test-dirs/parameters.t/reexport.ml create mode 100644 tests/test-dirs/parameters.t/reexport.mli create mode 100644 tests/test-dirs/parameters.t/run.t create mode 100644 tests/test-dirs/parameters.t/use_basic_int.ml create mode 100644 tests/test-dirs/parameters.t/use_fancy_int.ml create mode 100644 tests/test-dirs/parameters.t/use_reexported.ml create mode 100644 tests/test-dirs/parameters.t/use_reexported.mli create mode 100644 tests/test-dirs/parameters.t/use_reexported_int.ml diff --git a/tests/test-dirs/parameters.t/basic.ml b/tests/test-dirs/parameters.t/basic.ml new file mode 100644 index 000000000..4057681d9 --- /dev/null +++ b/tests/test-dirs/parameters.t/basic.ml @@ -0,0 +1,6 @@ +type t = P.t + +let create = P.create +let wrap t = t +let p t = t +let to_string t = "Basic(" ^ P.to_string t ^ ")" diff --git a/tests/test-dirs/parameters.t/basic.mli b/tests/test-dirs/parameters.t/basic.mli new file mode 100644 index 000000000..95b194980 --- /dev/null +++ b/tests/test-dirs/parameters.t/basic.mli @@ -0,0 +1,15 @@ +(** Basic functionality implemented over the [P] parameter. *) + +(** A [P.t] with minor enhancements. *) +type t + +(** Make a [t] from scratch. *) +val create : unit -> t + +(** Make a [t] from a [P.t]. *) +val wrap : P.t -> t + +val p : t -> P.t + +(** Convert [t] to string. *) +val to_string : t -> string diff --git a/tests/test-dirs/parameters.t/fancy.ml b/tests/test-dirs/parameters.t/fancy.ml new file mode 100644 index 000000000..3e784db63 --- /dev/null +++ b/tests/test-dirs/parameters.t/fancy.ml @@ -0,0 +1,5 @@ +type t = Basic.t + +let create t = t +let wrap t = Basic.wrap t +let to_string t = "Fancy(" ^ Basic.to_string t ^ ")" diff --git a/tests/test-dirs/parameters.t/fancy.mli b/tests/test-dirs/parameters.t/fancy.mli new file mode 100644 index 000000000..a5fbc9e95 --- /dev/null +++ b/tests/test-dirs/parameters.t/fancy.mli @@ -0,0 +1,6 @@ +type t + +(** Make something fancy out of something basic. *) +val create : Basic.t -> t +val wrap : P.t -> t +val to_string : t -> string diff --git a/tests/test-dirs/parameters.t/p.mli b/tests/test-dirs/parameters.t/p.mli new file mode 100644 index 000000000..609329213 --- /dev/null +++ b/tests/test-dirs/parameters.t/p.mli @@ -0,0 +1,13 @@ +(** A parameter module. *) + +(** A thing. *) +type t + +(** Make a thing. *) +val create : unit -> t + +(** Frobnicate the thing. *) +val frob : t -> t + +(** Show the thing. *) +val to_string : t -> string diff --git a/tests/test-dirs/parameters.t/p_int.ml b/tests/test-dirs/parameters.t/p_int.ml new file mode 100644 index 000000000..efc265089 --- /dev/null +++ b/tests/test-dirs/parameters.t/p_int.ml @@ -0,0 +1,5 @@ +type t = int + +let create () = 0 +let frob = succ +let to_string = string_of_int diff --git a/tests/test-dirs/parameters.t/p_int.mli b/tests/test-dirs/parameters.t/p_int.mli new file mode 100644 index 000000000..2cc2ec002 --- /dev/null +++ b/tests/test-dirs/parameters.t/p_int.mli @@ -0,0 +1,5 @@ +type t = int + +val create : unit -> t +val frob : t -> t +val to_string : t -> string diff --git a/tests/test-dirs/parameters.t/reexport.ml b/tests/test-dirs/parameters.t/reexport.ml new file mode 100644 index 000000000..2972f9749 --- /dev/null +++ b/tests/test-dirs/parameters.t/reexport.ml @@ -0,0 +1,6 @@ +(** An alias to the parameter [P] *) +module As_alias = P + +module Included = struct + include P +end diff --git a/tests/test-dirs/parameters.t/reexport.mli b/tests/test-dirs/parameters.t/reexport.mli new file mode 100644 index 000000000..2c7778d40 --- /dev/null +++ b/tests/test-dirs/parameters.t/reexport.mli @@ -0,0 +1,8 @@ +(** An alias to the parameter [P] *) +module As_alias = P + +module Included : sig + include module type of struct + include P + end +end diff --git a/tests/test-dirs/parameters.t/run.t b/tests/test-dirs/parameters.t/run.t new file mode 100644 index 000000000..ce15df7a1 --- /dev/null +++ b/tests/test-dirs/parameters.t/run.t @@ -0,0 +1,363 @@ +Check that merlin understands the `-parameter` flag. + + $ query_file() { + > local action=$1 + > local file=$2 + > shift 2 + > $MERLIN server "$action" "$@" -verbosity 0 -filename "$file" \ + > < "$file" + > } + + $ query() { + > local action=$1 + > local file=$2 + > local pos=$3 + > shift 3 + > query_file "$action" "$file" -position "$pos" "$@" + > } + + $ j() { + > # The embedded newlines that merlin-wrapper introduces confuse jq + > tr '\n' ' ' | jq "$@" + > } + + $ query_errors() { + > query_file errors "$@" | j '.value' + > } + + $ query_type() { + > query type-enclosing "$@" | j '.value[0]?.type? // .value' + > } + + $ multi_query() { + > query_type "$@" + > query document "$@" | j '.value' + > query locate "$@" | j '.value' + > } + + $ multi_query_impl() { + > query_type "$@" + > query document "$@" | j '.value' + > query locate "$@" -look-for interface | j '.value' + > query locate "$@" -look-for implementation | j '.value' + > } + +Start by compiling P and a module that uses it: + + $ $OCAMLC -bin-annot-cms -c p.mli -as-parameter + + $ $OCAMLC -bin-annot-cms -c basic.mli basic.ml -parameter P + + $ query_errors ./basic.mli -parameter P + [] + + $ query_errors ./basic.ml -parameter P + [] + +The following test is broken. It asks about P itself: + + $ multi_query ./basic.mli 10:11 -parameter P + "sig type t val create : unit -> t val frob : t -> t val to_string : t -> string end" + "\"P\" is a builtin, no documentation is available" + "\"\" is a builtin, and it is therefore impossible to jump to its definition" + +But this one works. It asks for P.t: + + $ multi_query ./basic.mli 10:13 -parameter P + "type t" + "A thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 4, + "col": 5 + } + } + +Now check the implementation. This is P.create: + + $ multi_query ./basic.ml 3:16 -parameter P + "unit -> P.t" + "Make a thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 7, + "col": 4 + } + } + +And P.to_string: + + $ multi_query ./basic.ml 6:32 -parameter P + "P.t -> string" + "Show the thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 13, + "col": 4 + } + } + +Now let's try with a file that uses P indirectly via Basic: + + $ $OCAMLC -bin-annot-cms -c fancy.mli fancy.ml -parameter P + + $ query_errors ./fancy.mli -parameter P + [] + + $ query_errors ./fancy.ml -parameter P + [] + +This is Basic itself: + + $ multi_query fancy.mli 4:13 -parameter P + "sig type t val create : unit -> t val wrap : P.t -> t val p : t -> P.t val to_string : t -> string end" + "Basic functionality implemented over the [P] parameter." + { + "file": "$TESTCASE_ROOT/basic.mli", + "pos": { + "line": 1, + "col": 0 + } + } + +And Basic.t: + + $ multi_query fancy.mli 4:19 -parameter P + "type t" + "A [P.t] with minor enhancements." + { + "file": "$TESTCASE_ROOT/basic.mli", + "pos": { + "line": 4, + "col": 5 + } + } + +Also check the implementation. This is Basic.to_string: + + $ multi_query_impl fancy.ml 5:37 -parameter P + "Basic.t -> string" + "Convert [t] to string." + { + "file": "$TESTCASE_ROOT/basic.mli", + "pos": { + "line": 15, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/basic.ml", + "pos": { + "line": 6, + "col": 4 + } + } + +And Basic.wrap, whose type involves the parameter P: + + $ multi_query_impl fancy.ml 4:21 -parameter P + "P.t -> Basic.t" + "Make a [t] from a [P.t]." + { + "file": "$TESTCASE_ROOT/basic.mli", + "pos": { + "line": 10, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/basic.ml", + "pos": { + "line": 4, + "col": 4 + } + } + +Now let's see what happens with aliases and includes: + + $ $OCAMLC -bin-annot-cms -c reexport.mli reexport.ml -parameter P + +First check this file without -parameter P to make sure it breaks. This means +we're correctly tracking parameters separately per file, even in server mode. + + $ query_errors reexport.mli + [ + { + "start": { + "line": 6, + "col": 12 + }, + "end": { + "line": 6, + "col": 13 + }, + "type": "typer", + "sub": [], + "valid": true, + "message": "The file $TESTCASE_ROOT/p.cmi contains the interface of a parameter. P is not declared as a parameter for the current unit. Hint: Compile the current unit with -parameter P." + } + ] + +Now check that it works with the flag. + + $ query_errors reexport.mli -parameter P + [] + + $ query_errors reexport.ml -parameter P + [] + +Do we understand the type of [As_alias]? + + $ query_type reexport.ml 4:10 -parameter P + "sig type t = P.t val create : unit -> t val frob : t -> t val to_string : t -> string end" + +This only compiles if the various ways of getting at [P.t] are equivalent: + + $ $OCAMLC -bin-annot-cms -c use_reexported.mli use_reexported.ml -parameter P + +This is the function [check_that_types_are_the_same]: + + $ query_type use_reexported.ml 1:5 -parameter P + "Reexport.As_alias.t -> Reexport.Included.t -> P.t" + +This is a reference to [Reexport.As_alias.create]: + + $ multi_query use_reexported.ml 6:30 -parameter P + "unit -> Reexport.As_alias.t" + "Make a thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 7, + "col": 4 + } + } + +And this goes to [Reexport.Included.create]: + + $ multi_query use_reexported.ml 7:30 -parameter P + "unit -> Reexport.Included.t" + "Make a thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 7, + "col": 4 + } + } + +Now let's try instantiating things. + + $ $OCAMLC -bin-annot-cms -c p_int.mli p_int.ml -as-argument-for P + +Suppress some warnings that are only there due to compiler bugs: + + $ instance_warnings="-w -53" + +Compile a file that uses things from an instance of [Basic]: + + $ $OCAMLC -bin-annot-cms -c use_basic_int.ml $instance_warnings + + $ query_errors use_basic_int.ml $instance_warnings + [] + +Check that we understand everything about [Basic[P:P_int].create]: + + $ multi_query_impl use_basic_int.ml 3:28 + "unit -> Basic_int.t" + "Make a [t] from scratch." + { + "file": "$TESTCASE_ROOT/basic.mli", + "pos": { + "line": 7, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/basic.ml", + "pos": { + "line": 3, + "col": 4 + } + } + +Do the same with [Fancy]: + + $ $OCAMLC -bin-annot-cms -c use_fancy_int.ml $instance_warnings + + $ query_errors use_fancy_int.ml $instance_warnings + [] + +The type of [Fancy_p_int.create] is something that isn't currently valid OCaml +syntax, so this output isn't ideal: + + $ multi_query_impl use_fancy_int.ml 5:28 + "Basic[P:P_int].t -> Fancy_int.t" + "Make something fancy out of something basic." + { + "file": "$TESTCASE_ROOT/fancy.mli", + "pos": { + "line": 4, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/fancy.ml", + "pos": { + "line": 3, + "col": 4 + } + } + +Now let's see how instances work with aliases and includes: + + $ $OCAMLC -bin-annot-cms -c use_reexported_int.ml $instance_warnings + + $ query_errors use_reexported_int.ml $instance_warnings + [] + +Do we see where [Reexport_int.As_alias.create] comes from? (Note: It would be +nice to delegate to [p.mli] here when there's no documentation for the +implementing .mli.) + + $ multi_query_impl use_reexported_int.ml 3:37 $instance_warnings + "unit -> Reexport_int.As_alias.t" + "No documentation available" + { + "file": "$TESTCASE_ROOT/p_int.mli", + "pos": { + "line": 3, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/p_int.ml", + "pos": { + "line": 3, + "col": 4 + } + } + +Can we follow an include? (FIXME: Currently no. It should go to [p_int.ml] +rather than [p.mli].) + + $ multi_query_impl use_reexported_int.ml 4:37 $instance_warnings + "unit -> Reexport_int.Included.t" + "Make a thing." + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 7, + "col": 4 + } + } + { + "file": "$TESTCASE_ROOT/p.mli", + "pos": { + "line": 7, + "col": 4 + } + } diff --git a/tests/test-dirs/parameters.t/use_basic_int.ml b/tests/test-dirs/parameters.t/use_basic_int.ml new file mode 100644 index 000000000..702d1100a --- /dev/null +++ b/tests/test-dirs/parameters.t/use_basic_int.ml @@ -0,0 +1,3 @@ +module Basic_int = (Basic (P)) (P_int) [@jane.non_erasable.instances] + +let basic = Basic_int.create () diff --git a/tests/test-dirs/parameters.t/use_fancy_int.ml b/tests/test-dirs/parameters.t/use_fancy_int.ml new file mode 100644 index 000000000..d368b0dd2 --- /dev/null +++ b/tests/test-dirs/parameters.t/use_fancy_int.ml @@ -0,0 +1,7 @@ +module Basic_int = (Basic (P)) (P_int) [@jane.non_erasable.instances] +module Fancy_int = (Fancy (P)) (P_int) [@jane.non_erasable.instances] + +let basic = Basic_int.create () +let fancy = Fancy_int.create basic +let out () = + print_endline (Fancy_int.to_string fancy) diff --git a/tests/test-dirs/parameters.t/use_reexported.ml b/tests/test-dirs/parameters.t/use_reexported.ml new file mode 100644 index 000000000..332eec39a --- /dev/null +++ b/tests/test-dirs/parameters.t/use_reexported.ml @@ -0,0 +1,8 @@ +let check_that_types_are_the_same (aliased_t : Reexport.As_alias.t) + (included_t : Reexport.Included.t) : P.t = + if true then aliased_t else included_t + +let check_that_we_can_locate_things () = + let _ = Reexport.As_alias.create () in + let _ = Reexport.Included.create () in + () diff --git a/tests/test-dirs/parameters.t/use_reexported.mli b/tests/test-dirs/parameters.t/use_reexported.mli new file mode 100644 index 000000000..3a9dc48a6 --- /dev/null +++ b/tests/test-dirs/parameters.t/use_reexported.mli @@ -0,0 +1,4 @@ +val check_that_types_are_the_same : + Reexport.As_alias.t -> Reexport.Included.t -> P.t + +val check_that_we_can_locate_things : unit -> unit diff --git a/tests/test-dirs/parameters.t/use_reexported_int.ml b/tests/test-dirs/parameters.t/use_reexported_int.ml new file mode 100644 index 000000000..7eb6d3dd8 --- /dev/null +++ b/tests/test-dirs/parameters.t/use_reexported_int.ml @@ -0,0 +1,4 @@ +module Reexport_int = Reexport(P)(P_int) [@jane.non_erasable.instances] + +let p1 : int = Reexport_int.As_alias.create () +let p2 : int = Reexport_int.Included.create ()