diff --git a/doc/changes/10422.md b/doc/changes/10422.md new file mode 100644 index 00000000000..b298dd1a8b8 --- /dev/null +++ b/doc/changes/10422.md @@ -0,0 +1,7 @@ +- `dune ocaml-merlin`: communicate additional directives `SOURCE_ROOT`, + `UNIT_NAME` (the actual name with wrapping) and `INDEX` with the paths to the + index(es). (#10422, @voodoos) + +- Add a new alias `@ocaml-index` that uses the `ocaml-index` binary to generate + indexes that can be read by tools such as Merlin to provide project-wide + references search. (#10422, @voodoos) diff --git a/doc/reference/aliases.rst b/doc/reference/aliases.rst index 098b32a1418..504e4499611 100644 --- a/doc/reference/aliases.rst +++ b/doc/reference/aliases.rst @@ -76,6 +76,7 @@ Some aliases are defined and managed by Dune itself: :caption: Checks aliases/check + aliases/ocaml-index aliases/runtest aliases/fmt aliases/lint diff --git a/doc/reference/aliases/check.rst b/doc/reference/aliases/check.rst index f27baa8c17c..1e2c8de8305 100644 --- a/doc/reference/aliases/check.rst +++ b/doc/reference/aliases/check.rst @@ -6,3 +6,6 @@ work correctly. For example, it will build ``*.cmi``, ``*.cmt``, and ``*.cmti`` files so that Merlin and ``ocaml-lsp-server`` can be used in the project. It is also useful in the development loop because it will catch compilation errors without executing expensive operations such as linking executables. + +.. seealso:: :doc:`ocaml-index` for a fast feedback loop that + also indexes the project. diff --git a/doc/reference/aliases/ocaml-index.rst b/doc/reference/aliases/ocaml-index.rst new file mode 100644 index 00000000000..a68c5fbc47e --- /dev/null +++ b/doc/reference/aliases/ocaml-index.rst @@ -0,0 +1,9 @@ +@ocaml-index +============ + +This alias corresponds to the set of targets necessary for development tools to +provide project-wide queries such as "get all references of this value". These +targets are indexes built using the required `ocaml-index` binary. Since this +alias also incudes the ``*.cmi``, ``*.cmt``, and ``*.cmti`` files usually built +by ``check``, it can be used in most projects as a replacement to get a fast +feedback loop while maintaining the indexes up-to-date. diff --git a/src/dune_rules/alias0.ml b/src/dune_rules/alias0.ml index 5b61ee6e8ba..f93c313dd33 100644 --- a/src/dune_rules/alias0.ml +++ b/src/dune_rules/alias0.ml @@ -14,5 +14,6 @@ let doc_json = standard "doc-json" let doc_new = standard "doc-new" let check = standard "check" let install = standard "install" +let ocaml_index = standard "ocaml-index" let runtest = standard "runtest" let all = standard "all" diff --git a/src/dune_rules/alias0.mli b/src/dune_rules/alias0.mli index 95635594d35..ed42b67ec10 100644 --- a/src/dune_rules/alias0.mli +++ b/src/dune_rules/alias0.mli @@ -11,6 +11,7 @@ val lint : Name.t val private_doc : Name.t val doc_new : Name.t val check : Name.t +val ocaml_index : Name.t val install : Name.t val runtest : Name.t val all : Name.t diff --git a/src/dune_rules/exe.ml b/src/dune_rules/exe.ml index c29612cc599..368529a84fe 100644 --- a/src/dune_rules/exe.ml +++ b/src/dune_rules/exe.ml @@ -363,6 +363,10 @@ let build_and_link_many = let open Memo.O in let* () = Module_compilation.build_all cctx in + let* () = + Memo.when_ (Compilation_context.bin_annot cctx) (fun () -> + Ocaml_index.cctx_rules cctx) + in link_many ?link_args ?o_files diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index 536ee728ab9..cfd1eebb403 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -182,6 +182,7 @@ let executables_rules let lib_config = ocaml.lib_config in let stdlib_dir = lib_config.stdlib_dir in let* requires_compile = Compilation_context.requires_compile cctx in + let* requires_link = Compilation_context.requires_link cctx in let* dep_graphs = (* Building an archive for foreign stubs, we link the corresponding object files directly to improve perf. *) @@ -265,7 +266,7 @@ let executables_rules in ( cctx , Merlin.make - ~requires:requires_compile + ~requires:requires_link ~stdlib_dir ~flags ~modules diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml index 4ddf3d06f29..6259c12ecc6 100644 --- a/src/dune_rules/gen_rules.ml +++ b/src/dune_rules/gen_rules.ml @@ -353,6 +353,7 @@ let gen_project_rules = let+ () = Install_rules.gen_project_rules sctx project and+ () = Odoc.gen_project_rules sctx project and+ () = Odoc_new.gen_project_rules sctx project + and+ () = Ocaml_index.project_rule sctx project and+ () = let version = 2, 8 in match Dune_project.allow_approximate_merlin project with diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 82f729dd807..1c5fcb9caf4 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -579,6 +579,7 @@ let library_rules let scope = Compilation_context.scope cctx in let* requires_compile = Compilation_context.requires_compile cctx in let ocaml = Compilation_context.ocaml cctx in + let* requires_link = Compilation_context.requires_link cctx in let stdlib_dir = ocaml.lib_config.stdlib_dir in let top_sorted_modules = let impl_only = Modules.With_vlib.impl_only modules in @@ -607,6 +608,9 @@ let library_rules info in let+ () = + Memo.when_ (Compilation_context.bin_annot cctx) (fun () -> + Ocaml_index.cctx_rules cctx) + and+ () = Memo.when_ (not (Library.is_virtual lib)) (fun () -> setup_build_archives lib ~lib_info ~top_sorted_modules ~cctx ~expander) @@ -631,7 +635,7 @@ let library_rules in ( cctx , Merlin.make - ~requires:requires_compile + ~requires:requires_link ~stdlib_dir ~flags ~modules diff --git a/src/dune_rules/merlin/merlin.ml b/src/dune_rules/merlin/merlin.ml index fa70393ae8e..900ef0bd483 100644 --- a/src/dune_rules/merlin/merlin.ml +++ b/src/dune_rules/merlin/merlin.ml @@ -48,20 +48,26 @@ module Processed = struct (* Most of the configuration is shared across a same lib/exe... *) type config = { stdlib_dir : Path.t option + ; source_root : Path.t ; obj_dirs : Path.Set.t ; src_dirs : Path.Set.t ; flags : string list ; extensions : string option Ml_kind.Dict.t list + ; indexes : Path.t list } - let dyn_of_config { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = + let dyn_of_config + { stdlib_dir; source_root; obj_dirs; src_dirs; flags; extensions; indexes } + = let open Dyn in record [ "stdlib_dir", option Path.to_dyn stdlib_dir + ; "source_root", Path.to_dyn source_root ; "obj_dirs", Path.Set.to_dyn obj_dirs ; "src_dirs", Path.Set.to_dyn src_dirs ; "flags", list string flags ; "extensions", list (Ml_kind.Dict.to_dyn (Dyn.option string)) extensions + ; "indexes", list Path.to_dyn indexes ] ;; @@ -100,16 +106,18 @@ module Processed = struct type nonrec t = t let name = "merlin-conf" - let version = 4 + let version = 5 let to_dyn _ = Dyn.String "Use [dune ocaml dump-dot-merlin] instead" let test_example () = { config = { stdlib_dir = None + ; source_root = Path.Source.root |> Path.source ; obj_dirs = Path.Set.empty ; src_dirs = Path.Set.empty ; flags = [ "-x" ] ; extensions = [ { Ml_kind.Dict.intf = None; impl = Some "ext" } ] + ; indexes = [] } ; per_file_config = Path.Build.Map.empty ; pp_config = @@ -149,16 +157,24 @@ module Processed = struct | None, None -> None ;; - let to_sexp ~opens ~pp ~reader { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = + let to_sexp + ~unit_name + ~opens + ~pp + ~reader + { stdlib_dir; source_root; obj_dirs; src_dirs; flags; extensions; indexes } + = let make_directive tag value = Sexp.List [ Atom tag; value ] in let make_directive_of_path tag path = make_directive tag (Sexp.Atom (serialize_path path)) in + let index_files = List.map indexes ~f:(fun p -> make_directive_of_path "INDEX" p) in let stdlib_dir = match stdlib_dir with | None -> [] | Some stdlib_dir -> [ make_directive_of_path "STDLIB" stdlib_dir ] in + let source_root = [ make_directive_of_path "SOURCE_ROOT" source_root ] in let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in let obj_dirs = Path.Set.to_list_map obj_dirs ~f:(make_directive_of_path "B") in let src_dirs = Path.Set.to_list_map src_dirs ~f:(make_directive_of_path "S") in @@ -184,6 +200,7 @@ module Processed = struct (Sexp.List (Ocaml_flags.open_flags opens |> List.map ~f:(fun x -> Sexp.Atom x))) :: flags in + let unit_name = [ make_directive "UNIT_NAME" (Sexp.Atom unit_name) ] in let suffixes = List.filter_map extensions ~f:(fun x -> let open Option.O in @@ -199,7 +216,17 @@ module Processed = struct in Sexp.List (List.concat - [ stdlib_dir; exclude_query_dir; obj_dirs; src_dirs; flags; suffixes; reader ]) + [ index_files + ; stdlib_dir + ; source_root + ; exclude_query_dir + ; obj_dirs + ; src_dirs + ; flags + ; unit_name + ; suffixes + ; reader + ]) ;; let quote_for_dot_merlin s = @@ -215,15 +242,26 @@ module Processed = struct if String.need_quoting s then Filename.quote s else s ;; - let to_dot_merlin stdlib_dir pp_configs flags obj_dirs src_dirs extensions = + let to_dot_merlin + stdlib_dir + source_root + pp_configs + flags + obj_dirs + src_dirs + extensions + indexes + = let b = Buffer.create 256 in let printf = Printf.bprintf b in let print = Buffer.add_string b in print "EXCLUDE_QUERY_DIR\n"; Option.iter stdlib_dir ~f:(fun stdlib_dir -> printf "STDLIB %s\n" (serialize_path stdlib_dir)); + printf "SOURCE_ROOT %s\n" (serialize_path source_root); Path.Set.iter obj_dirs ~f:(fun p -> printf "B %s\n" (serialize_path p)); Path.Set.iter src_dirs ~f:(fun p -> printf "S %s\n" (serialize_path p)); + List.iter indexes ~f:(fun p -> printf "INDEX %s\n" (serialize_path p)); List.iter extensions ~f:(fun x -> Option.iter (get_ext x) ~f:(fun (impl, intf) -> printf "SUFFIX %s" (Printf.sprintf "%s %s" impl intf))); @@ -265,7 +303,8 @@ module Processed = struct Path.Build.Map.find per_file_config (remove_extension file)) in let pp = Module_name.Per_item.get pp_config (Module.name module_) in - to_sexp ~opens ~pp ~reader config + let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in + to_sexp ~unit_name ~opens ~pp ~reader config ;; let print_file path = @@ -275,8 +314,9 @@ module Processed = struct let pp_one (source, { module_; opens; reader }) = let open Pp.O in let name = Module.name module_ in + let unit_name = Module_name.Unique.to_string (Module.obj_name module_) in let pp = Module_name.Per_item.get pp_config name in - let sexp = to_sexp ~reader ~opens ~pp config in + let sexp = to_sexp ~unit_name ~reader ~opens ~pp config in Pp.hvbox (Pp.textf "%s: %s" (Module_name.to_string name) (Path.Build.to_string source)) ++ Pp.newline @@ -295,7 +335,7 @@ module Processed = struct | Error msg -> Printf.eprintf "%s\n" msg | Ok [] -> Printf.eprintf "No merlin configuration found.\n" | Ok (init :: tl) -> - let pp_configs, obj_dirs, src_dirs, flags, extensions = + let pp_configs, obj_dirs, src_dirs, flags, extensions, indexes = (* We merge what is easy to merge and ignore the rest *) List.fold_left tl @@ -304,30 +344,42 @@ module Processed = struct , init.config.obj_dirs , init.config.src_dirs , [ init.config.flags ] - , init.config.extensions ) + , init.config.extensions + , init.config.indexes ) ~f: (fun - (acc_pp, acc_obj, acc_src, acc_flags, acc_ext) + (acc_pp, acc_obj, acc_src, acc_flags, acc_ext, acc_indexes) { per_file_config = _ ; pp_config - ; config = { stdlib_dir = _; obj_dirs; src_dirs; flags; extensions } + ; config = + { stdlib_dir = _ + ; source_root = _ + ; obj_dirs + ; src_dirs + ; flags + ; extensions + ; indexes + } } -> ( pp_config :: acc_pp , Path.Set.union acc_obj obj_dirs , Path.Set.union acc_src src_dirs , flags :: acc_flags - , extensions @ acc_ext )) + , extensions @ acc_ext + , indexes @ acc_indexes )) in Printf.printf "%s\n" (to_dot_merlin init.config.stdlib_dir + init.config.source_root pp_configs flags obj_dirs src_dirs - extensions) + extensions + indexes) ;; end @@ -579,11 +631,19 @@ module Unprocessed = struct obj_dir_of_lib `Public mode (Lib_info.obj_dir info) in Path.Set.add obj_dirs public_cmi_dir ))) - in + and+ indexes = Action_builder.of_memo (Ocaml_index.context_indexes sctx) in let src_dirs = Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions } + let source_root = Path.Source.root |> Path.source in + { Processed.stdlib_dir + ; source_root + ; src_dirs + ; obj_dirs + ; flags + ; extensions + ; indexes + } and+ pp_config = pp_config t (Super_context.context sctx) ~expander in let per_file_config = (* And copy for each module the resulting pp flags *) diff --git a/src/dune_rules/merlin/ocaml_index.ml b/src/dune_rules/merlin/ocaml_index.ml new file mode 100644 index 00000000000..58909d7ba18 --- /dev/null +++ b/src/dune_rules/merlin/ocaml_index.ml @@ -0,0 +1,107 @@ +open Import + +let ocaml_index sctx ~dir = + Super_context.resolve_program ~loc:None ~dir sctx "ocaml-index" +;; + +let index_path_in_obj_dir obj_dir = + let dir = Obj_dir.obj_dir obj_dir in + Path.Build.relative dir "cctx.ocaml-index" +;; + +let project_index ~build_dir = Path.Build.relative build_dir "project.ocaml-index" + +let cctx_rules cctx = + (* Indexing is performed by the external binary [ocaml-index] which performs + full shape reduction to compute the actual definition of all the elements in + the typedtree. This step is therefore dependent on all the cmts of those + definitions are used by all the cmts of modules in this cctx. *) + let sctx = Compilation_context.super_context cctx in + let dir = Compilation_context.dir cctx in + let aggregate = + let obj_dir = Compilation_context.obj_dir cctx in + let fn = index_path_in_obj_dir obj_dir in + let additional_libs = + let open Resolve.Memo.O in + let+ non_compile_libs = + (* The indexer relies on the load_path of cmt files. When + [implicit_transitive_deps] is set to [false] some necessary paths will + be missing.These are passed to the indexer with the `-I` flag. + + The implicit transitive libs correspond to the set: + (requires_link \ req_compile) *) + let* req_link = Compilation_context.requires_link cctx in + let+ req_compile = Compilation_context.requires_compile cctx in + List.filter req_link ~f:(fun l -> not (List.exists req_compile ~f:(Lib.equal l))) + in + Lib_flags.L.include_flags non_compile_libs (Lib_mode.Ocaml Byte) + in + let context_dir = + Compilation_context.context cctx + |> Context.name + |> Context_name.build_dir + |> Path.build + in + let modules_deps = + let cm_kind = Lib_mode.Cm_kind.(Ocaml Cmi) in + (* We only index occurrences in user-written modules *) + Compilation_context.modules cctx + |> Modules.With_vlib.drop_vlib + |> Modules.fold_user_written ~init:[] ~f:(fun module_ acc -> + let cmts = + [ Ml_kind.Intf; Impl ] + |> List.filter_map ~f:(fun ml_kind -> + Obj_dir.Module.cmt_file obj_dir ~ml_kind ~cm_kind module_ + |> Option.map ~f:Path.build) + in + List.rev_append cmts acc) + in + Command.run_dyn_prog + ~dir:context_dir + (ocaml_index sctx ~dir) + [ A "aggregate" + ; A "-o" + ; Target fn + ; Deps modules_deps + ; Dyn (Resolve.Memo.read additional_libs) + ] + in + Super_context.add_rule sctx ~dir aggregate +;; + +let context_indexes sctx = + let open Memo.O in + let ctx = Super_context.context sctx in + Context.name ctx + |> Dune_load.dune_files + >>| Dune_file.fold_static_stanzas ~init:[] ~f:(fun dune_file stanza acc -> + let obj = + let dir = + let build_dir = Context.build_dir ctx in + Path.Build.append_source build_dir (Dune_file.dir dune_file) + in + match Stanza.repr stanza with + | Executables.T exes | Tests.T { exes; _ } -> Some (Executables.obj_dir ~dir exes) + | Library.T lib -> Some (Library.obj_dir ~dir lib) + | _ -> None + in + match obj with + | None -> acc + | Some obj_dir -> Path.build (index_path_in_obj_dir obj_dir) :: acc) +;; + +let project_rule sctx project = + let open Memo.O in + let ocaml_index_alias = + let dir = + let build_dir = + let ctx = Super_context.context sctx in + Context.build_dir ctx + in + Path.Build.append_source build_dir @@ Dune_project.root project + in + Alias.make Alias0.ocaml_index ~dir + in + let* indexes = context_indexes sctx in + Rules.Produce.Alias.add_deps ocaml_index_alias (Action_builder.paths_existing @@ indexes) +;; diff --git a/src/dune_rules/merlin/ocaml_index.mli b/src/dune_rules/merlin/ocaml_index.mli new file mode 100644 index 00000000000..a9d7a9480fc --- /dev/null +++ b/src/dune_rules/merlin/ocaml_index.mli @@ -0,0 +1,26 @@ +open Import + +(** This module provides support for the [ocaml-uideps] indexing tool. Its role + is to index every value in the project by their definition in order for + language server to be able to fetch project-wide occurrences. + + Indexing all definitions usages is a two step process: + + - first, for all compilation contexts we generate the uideps for all the + modules in that cctx in the corresponding obj_dir. + - then we aggregate all these separate indexes into a unique one. *) + +val project_index : build_dir:Path.Build.t -> Path.Build.t + +(** [cctx_rules cctx] sets the rules needed to generate the indexes for every + module in the compilation context [cctx] and aggregate them in a + [cctx.uideps] index covering the whole compilation context. *) +val cctx_rules : Compilation_context.t -> unit Memo.t + +(** [context_indexes] lists all the available cctx.ocaml-index files in the + given context *) +val context_indexes : Super_context.t -> Path.t list Memo.t + +(** [project_rule] adds a rule that will aggregate all the generated indexes + into one global, project-wide, index *) +val project_rule : Super_context.t -> Dune_project.t -> unit Memo.t diff --git a/src/dune_rules/module_compilation.ml b/src/dune_rules/module_compilation.ml index 6b5f82150c6..2679731999f 100644 --- a/src/dune_rules/module_compilation.ml +++ b/src/dune_rules/module_compilation.ml @@ -191,7 +191,14 @@ let build_cm let fn = Option.value_exn (Obj_dir.Module.cmt_file obj_dir m ~cm_kind ~ml_kind) in - fn :: other_targets, A "-bin-annot") + let annots = + [ "-bin-annot" ] + @ + if Version.supports_bin_annot_occurrences ocaml.version + then [ "-bin-annot-occurrences" ] + else [] + in + fn :: other_targets, As annots) else other_targets, Command.Args.empty in let opaque_arg : _ Command.Args.t = diff --git a/src/ocaml/version.ml b/src/ocaml/version.ml index 09c06cdb765..fba7b9e1a25 100644 --- a/src/ocaml/version.ml +++ b/src/ocaml/version.ml @@ -28,3 +28,4 @@ let has_bigarray_library version = version < (5, 0, 0) let supports_alerts version = version >= (4, 8, 0) let has_sandboxed_otherlibs version = version >= (5, 0, 0) let has_META_files version = version >= (5, 0, 0) +let supports_bin_annot_occurrences version = version >= (5, 2, 0) diff --git a/src/ocaml/version.mli b/src/ocaml/version.mli index 8291d77deb2..f7da69ad2b1 100644 --- a/src/ocaml/version.mli +++ b/src/ocaml/version.mli @@ -73,3 +73,6 @@ val has_sandboxed_otherlibs : t -> bool (** Whether the compiler distributes META files independently of ocamlfind *) val has_META_files : t -> bool + +(** Whether the compiler supports occurrences indexation *) +val supports_bin_annot_occurrences : t -> bool diff --git a/test/blackbox-tests/test-cases/describe/aliases.t/run.t b/test/blackbox-tests/test-cases/describe/aliases.t/run.t index f3f2a0d7a28..d166a9adba8 100644 --- a/test/blackbox-tests/test-cases/describe/aliases.t/run.t +++ b/test/blackbox-tests/test-cases/describe/aliases.t/run.t @@ -8,6 +8,7 @@ In an empty dune project, the following aliases are available. all default fmt + ocaml-index User defined aliases can be added to a dune file. These should be picked up by the command. @@ -22,6 +23,7 @@ the command. default fmt foo + ocaml-index Aliases in subdirectories should not be picked up. @@ -36,6 +38,7 @@ Aliases in subdirectories should not be picked up. default fmt foo + ocaml-index But checking the subdirectory it should be available. @@ -58,6 +61,7 @@ Adding an OCaml library will introduce OCaml specific aliases: default doc-private fmt + ocaml-index Adding a cram test will introduce an alias with the name of the test and also introduce the runtest alias: @@ -70,6 +74,7 @@ bbb default fmt mytest + ocaml-index runtest We can also show aliases in multiple directories at once: @@ -80,6 +85,7 @@ We can also show aliases in multiple directories at once: default fmt mytest + ocaml-index runtest subdir: @@ -97,6 +103,7 @@ Including those in the _build/ directory: default fmt mytest + ocaml-index runtest _build/default: @@ -104,6 +111,7 @@ Including those in the _build/ directory: default fmt mytest + ocaml-index runtest These are context sensitive: @@ -123,4 +131,5 @@ These are context sensitive: default fmt mytest + ocaml-index runtest diff --git a/test/blackbox-tests/test-cases/dune b/test/blackbox-tests/test-cases/dune index 55d2ada31c4..3165c0740af 100644 --- a/test/blackbox-tests/test-cases/dune +++ b/test/blackbox-tests/test-cases/dune @@ -9,7 +9,8 @@ ../utils/melc_stdlib_prefix.exe ../utils/refmt.exe ../utils/webserver_oneshot.exe - ../utils/sherlodoc.exe))) + ../utils/sherlodoc.exe + ../utils/ocaml_index.exe))) (cram (applies_to pp-cwd) diff --git a/test/blackbox-tests/test-cases/github2206.t/run.t b/test/blackbox-tests/test-cases/github2206.t/run.t index 976772d7dc0..1848c413d07 100644 --- a/test/blackbox-tests/test-cases/github2206.t/run.t +++ b/test/blackbox-tests/test-cases/github2206.t/run.t @@ -2,9 +2,15 @@ copy_files would break the generation of the preprocessing flags $ dune build copy_files/.merlin-conf/exe-foo $ dune ocaml merlin dump-config $PWD/copy_files | > grep -B 1 -A 0 "pp" + ((INDEX + $TESTCASE_ROOT/_build/default/.pp.eobjs/cctx.ocaml-index) + -- (FLG (-pp $TESTCASE_ROOT/_build/default/pp.exe)) + -- + ((INDEX + $TESTCASE_ROOT/_build/default/.pp.eobjs/cctx.ocaml-index) -- (FLG (-pp diff --git a/test/blackbox-tests/test-cases/melange/merlin-compile-flags.t b/test/blackbox-tests/test-cases/melange/merlin-compile-flags.t index 3bd56c798ff..0cbb9959435 100644 --- a/test/blackbox-tests/test-cases/melange/merlin-compile-flags.t +++ b/test/blackbox-tests/test-cases/melange/merlin-compile-flags.t @@ -18,12 +18,12 @@ Show that the merlin config knows about melange.compile_flags $ dune build @check $ dune ocaml merlin dump-config "$PWD" | grep -i "+42" - +42))) - +42))) - +42))) - +42))) - +42))) - +42))) + +42)) + +42)) + +42)) + +42)) + +42)) + +42)) $ cat >dune < (melange.emit @@ -35,10 +35,10 @@ Show that the merlin config knows about melange.compile_flags $ dune build @check $ dune ocaml merlin dump-config "$PWD" | grep -i "+42" - +42))) - +42))) - +42))) - +42))) - +42))) - +42))) + +42)) + +42)) + +42)) + +42)) + +42)) + +42)) diff --git a/test/blackbox-tests/test-cases/melange/merlin.t b/test/blackbox-tests/test-cases/melange/merlin.t index dba7817a04d..5781fa0ceab 100644 --- a/test/blackbox-tests/test-cases/melange/merlin.t +++ b/test/blackbox-tests/test-cases/melange/merlin.t @@ -23,20 +23,32 @@ $ touch bar.ml $lib.ml $ dune build @check $ dune ocaml merlin dump-config "$PWD" | grep -i "$lib" + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) (FLG (-open Foo__)) + (UNIT_NAME foo__Bar)) + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) (FLG (-open Foo__)) + (UNIT_NAME foo__Bar)) Foo: _build/default/foo + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) (FLG (-open Foo__)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) (FLG (-open Foo__)) + (UNIT_NAME foo)) Foo__: _build/default/foo__ + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) + (UNIT_NAME foo__)) Foo__: _build/default/foo__.ml-gen + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/melange) + (UNIT_NAME foo__)) Paths to Melange stdlib appear in B and S entries without melange.emit stanza @@ -70,6 +82,7 @@ Dump-dot-merlin includes the melange flags $ dune ocaml dump-dot-merlin $PWD EXCLUDE_QUERY_DIR STDLIB /MELC_STDLIB/melange + SOURCE_ROOT $TESTCASE_ROOT B /MELC_STDLIB/__private__/melange_mini_stdlib/melange/.public_cmi_melange B /MELC_STDLIB/melange B /MELC_STDLIB/melange @@ -115,7 +128,13 @@ User ppx flags should appear in merlin config $ dune ocaml merlin dump-config $PWD | grep -v "(B " | grep -v "(S " Bar: _build/default/bar - ((STDLIB /MELC_STDLIB/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /MELC_STDLIB/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B /MELC_STDLIB/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -139,9 +158,16 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Bar)) Bar: _build/default/bar.ml - ((STDLIB /MELC_STDLIB/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /MELC_STDLIB/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B /MELC_STDLIB/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -165,9 +191,16 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Bar)) Foo: _build/default/foo - ((STDLIB /MELC_STDLIB/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /MELC_STDLIB/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B /MELC_STDLIB/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -190,9 +223,16 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml-gen - ((STDLIB /MELC_STDLIB/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /MELC_STDLIB/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B /MELC_STDLIB/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -215,9 +255,16 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Fooppx: _build/default/fooppx - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.fooppx.objs/byte) @@ -230,9 +277,16 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME fooppx)) Fooppx: _build/default/fooppx.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.fooppx.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.fooppx.objs/byte) @@ -245,4 +299,5 @@ User ppx flags should appear in merlin config -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME fooppx)) diff --git a/test/blackbox-tests/test-cases/merlin/alt-context.t b/test/blackbox-tests/test-cases/merlin/alt-context.t index 4808c567d61..24444d6e69c 100644 --- a/test/blackbox-tests/test-cases/merlin/alt-context.t +++ b/test/blackbox-tests/test-cases/merlin/alt-context.t @@ -66,12 +66,16 @@ Request config for file in alt context without using --context Request config for file in alt context using --context $ printf '(4:File%d:%s)' ${#FILE2} $FILE2 | dune ocaml-merlin --context alt | dune format-dune-file | grep -i "$lib2" | sed 's/^[^:]*:[^:]*://' + $TESTCASE_ROOT/_build/alt/.bar.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/alt/.bar.objs/byte) + bar)) Request config for default context without using --context $ printf '(4:File%d:%s)' ${#FILE1} $FILE1 | dune ocaml-merlin | dune format-dune-file | grep -i "$lib1" | sed 's/^[^:]*:[^:]*://' + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) $TESTCASE_ROOT/_build/default/.foo.objs/byte) + foo)) Request config for default context using --context diff --git a/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t b/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t index c0f5f55d8f1..1498b216403 100644 --- a/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/default-based-context.t/run.t @@ -23,7 +23,11 @@ If Merlin field is absent, default context is chosen $ dune ocaml merlin dump-config "$PWD" Foo: _build/default/foo - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -36,9 +40,14 @@ If Merlin field is absent, default context is chosen -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -51,7 +60,8 @@ If Merlin field is absent, default context is chosen -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) If Merlin field is present, this context is chosen @@ -76,7 +86,11 @@ If Merlin field is present, this context is chosen $ dune ocaml merlin dump-config "$PWD" Foo: _build/cross/foo - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/cross/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/cross/.foo.objs/byte) @@ -89,9 +103,14 @@ If Merlin field is present, this context is chosen -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/cross/foo.ml - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/cross/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/cross/.foo.objs/byte) @@ -104,7 +123,8 @@ If Merlin field is present, this context is chosen -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) If `generate_merlin_rules` field is present, rules are generated even if merlin is disabled in that context @@ -132,7 +152,11 @@ is disabled in that context $ dune ocaml merlin dump-config "$PWD" Foo: _build/default/foo - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -145,9 +169,14 @@ is disabled in that context -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml - ((STDLIB OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -160,4 +189,5 @@ is disabled in that context -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) diff --git a/test/blackbox-tests/test-cases/merlin/dialect.t/run.t b/test/blackbox-tests/test-cases/merlin/dialect.t/run.t index 017b3386ac5..c72b1df5e34 100644 --- a/test/blackbox-tests/test-cases/merlin/dialect.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/dialect.t/run.t @@ -9,55 +9,100 @@ CRAM sanitization $ dune build ./exe/.merlin-conf/exe-x --profile release $ dune ocaml merlin dump-config $PWD/exe X: _build/default/exe/x - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exe/.x.eobjs/byte) (S $TESTCASE_ROOT/exe) (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__X) (SUFFIX ".mlx .mlx")) X: _build/default/exe/x.mlx - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exe/.x.eobjs/byte) (S $TESTCASE_ROOT/exe) (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__X) (SUFFIX ".mlx .mlx") (READER (mlx))) X: _build/default/exe/x.mlx.mli - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exe/.x.eobjs/byte) (S $TESTCASE_ROOT/exe) (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__X) (SUFFIX ".mlx .mlx")) CRAM sanitization $ dune build ./lib/.merlin-conf/lib-x --profile release $ dune ocaml merlin dump-config $PWD/lib X: _build/default/lib/x - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.x.objs/byte) (S $TESTCASE_ROOT/lib) (FLG (-w -40 -g)) + (UNIT_NAME x) (SUFFIX ".mlx .mlx") (READER (mlx))) X: _build/default/lib/x.mlx - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.x.objs/byte) (S $TESTCASE_ROOT/lib) (FLG (-w -40 -g)) + (UNIT_NAME x) (SUFFIX ".mlx .mlx") (READER (mlx))) @@ -65,7 +110,15 @@ CRAM sanitization $ dune build ./melange/.merlin-conf/lib-x_mel --profile release $ dune ocaml merlin dump-config $PWD/melange X_mel: _build/default/melange/x_mel - ((STDLIB lib/melange/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB lib/melange/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B lib/melange/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -80,10 +133,19 @@ CRAM sanitization (S $TESTCASE_ROOT/melange) (FLG (-w -40 -g)) + (UNIT_NAME x_mel) (SUFFIX ".mlx .mlx") (READER (mlx))) X_mel: _build/default/melange/x_mel.mlx - ((STDLIB lib/melange/melange) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.x.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/melange/.x_mel.objs/cctx.ocaml-index) + (STDLIB lib/melange/melange) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B lib/melange/__private__/melange_mini_stdlib/melange/.public_cmi_melange) @@ -98,5 +160,6 @@ CRAM sanitization (S $TESTCASE_ROOT/melange) (FLG (-w -40 -g)) + (UNIT_NAME x_mel) (SUFFIX ".mlx .mlx") (READER (mlx))) diff --git a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t index 4f0167631e4..631ec11e9ba 100644 --- a/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/dump-dot-merlin.t/run.t @@ -5,15 +5,21 @@ $ dune ocaml dump-dot-merlin src\ with\ spaces EXCLUDE_QUERY_DIR STDLIB /OCAMLC_WHERE + SOURCE_ROOT $TESTCASE_ROOT B $TESTCASE_ROOT/_build/default/src with spaces/.foo.eobjs/byte S $TESTCASE_ROOT/src with spaces + INDEX $TESTCASE_ROOT/_build/default/p p/.pp.eobjs/cctx.ocaml-index + INDEX $TESTCASE_ROOT/_build/default/src with spaces/.foo.eobjs/cctx.ocaml-index # FLG -pp ''\''$TESTCASE_ROOT/_build/default/p p/pp.exe'\''' # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -g $ dune ocaml dump-dot-merlin "p p" EXCLUDE_QUERY_DIR STDLIB /OCAMLC_WHERE + SOURCE_ROOT $TESTCASE_ROOT B $TESTCASE_ROOT/_build/default/p p/.pp.eobjs/byte S $TESTCASE_ROOT/p p + INDEX $TESTCASE_ROOT/_build/default/p p/.pp.eobjs/cctx.ocaml-index + INDEX $TESTCASE_ROOT/_build/default/src with spaces/.foo.eobjs/cctx.ocaml-index # FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs -g diff --git a/test/blackbox-tests/test-cases/merlin/future-syntax.t b/test/blackbox-tests/test-cases/merlin/future-syntax.t index c70ccca2e6f..9d9cb6338b1 100644 --- a/test/blackbox-tests/test-cases/merlin/future-syntax.t +++ b/test/blackbox-tests/test-cases/merlin/future-syntax.t @@ -18,26 +18,41 @@ $ dune build ./.merlin-conf/exe-pp_future_syntax --profile release $ dune ocaml merlin dump-config . Pp_future_syntax: _build/default/pp_future_syntax - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__Pp_future_syntax)) Pp_future_syntax: _build/default/pp_future_syntax.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__Pp_future_syntax)) Pp_future_syntax: _build/default/pp_future_syntax.mli - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.pp_future_syntax.eobjs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME dune__exe__Pp_future_syntax)) diff --git a/test/blackbox-tests/test-cases/merlin/github1946.t/run.t b/test/blackbox-tests/test-cases/merlin/github1946.t/run.t index ffa28575f75..6ae6ba318f4 100644 --- a/test/blackbox-tests/test-cases/merlin/github1946.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github1946.t/run.t @@ -7,7 +7,17 @@ in the same dune file, but require different ppx specifications $ dune build @all --profile release $ dune ocaml merlin dump-config $PWD Usesppx1: _build/default/usesppx1 - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.usesppx2.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.usesppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx1/.ppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx2/.ppx2.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx1.objs/byte) @@ -19,9 +29,20 @@ in the same dune file, but require different ppx specifications --as-ppx --cookie 'library-name="usesppx1"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME usesppx1)) Usesppx1: _build/default/usesppx1.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.usesppx2.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.usesppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx1/.ppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx2/.ppx2.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx1.objs/byte) @@ -33,9 +54,20 @@ in the same dune file, but require different ppx specifications --as-ppx --cookie 'library-name="usesppx1"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME usesppx1)) Usesppx2: _build/default/usesppx2 - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.usesppx2.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.usesppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx1/.ppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx2/.ppx2.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx2.objs/byte) @@ -47,9 +79,20 @@ in the same dune file, but require different ppx specifications --as-ppx --cookie 'library-name="usesppx2"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME usesppx2)) Usesppx2: _build/default/usesppx2.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.usesppx2.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.usesppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx1/.ppx1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx2/.ppx2.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx2.objs/byte) @@ -61,4 +104,5 @@ in the same dune file, but require different ppx specifications --as-ppx --cookie 'library-name="usesppx2"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME usesppx2)) diff --git a/test/blackbox-tests/test-cases/merlin/github4125.t/run.t b/test/blackbox-tests/test-cases/merlin/github4125.t/run.t index 39b8b2fd915..4b87e69091f 100644 --- a/test/blackbox-tests/test-cases/merlin/github4125.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github4125.t/run.t @@ -23,7 +23,11 @@ We call `$(opam switch show)` so that this test always uses an existing switch $ dune ocaml merlin dump-config "$PWD" Foo: _build/cross/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/cross/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/cross/.foo.objs/byte) @@ -36,9 +40,14 @@ We call `$(opam switch show)` so that this test always uses an existing switch -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/cross/foo.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/cross/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/cross/.foo.objs/byte) @@ -51,4 +60,5 @@ We call `$(opam switch show)` so that this test always uses an existing switch -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) diff --git a/test/blackbox-tests/test-cases/merlin/github759.t/run.t b/test/blackbox-tests/test-cases/merlin/github759.t/run.t index 286f4180c8b..b4fcb10ad9a 100644 --- a/test/blackbox-tests/test-cases/merlin/github759.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github759.t/run.t @@ -4,58 +4,88 @@ $ dune build foo.cma --profile release $ dune ocaml merlin dump-config $PWD Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) $ rm -f .merlin $ dune build foo.cma --profile release $ dune ocaml merlin dump-config $PWD Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) $ echo toto > .merlin $ dune build foo.cma --profile release $ dune ocaml merlin dump-config $PWD Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S $TESTCASE_ROOT) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) diff --git a/test/blackbox-tests/test-cases/merlin/granularity.t b/test/blackbox-tests/test-cases/merlin/granularity.t index ec8bdb63cd1..fd339cafffe 100644 --- a/test/blackbox-tests/test-cases/merlin/granularity.t +++ b/test/blackbox-tests/test-cases/merlin/granularity.t @@ -117,13 +117,16 @@ Preprocessing: Is it expected that the suffix for implementation and interface is the same ? $ ./merlin_conf.sh pped.ml | tee pped.out - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-pp?:$TESTCASE_ROOT/_build/default/pp.sh) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Pped (?:SUFFIX?:.mlx .mlx)) $ ./merlin_conf.sh pped.mli | diff pped.out - @@ -132,17 +135,20 @@ Melange: As expected, the reader is not communicated for the standard mli $ ./merlin_conf.sh mel.mli | tee mel.out - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Mel (?:SUFFIX?:.mlx .mlx)) The reader is set for the mlx file $ ./merlin_conf.sh mel.mlx | diff mel.out - - 7c7,8 + 10c10,11 < (?:SUFFIX?:.mlx .mlx)) \ No newline at end of file --- @@ -161,12 +167,15 @@ found, then it'll make a guess that the file was preprocessed into a file with .ml extension: $ ./merlin_conf.sh cppomod.cppo.ml | tee cppomod.out - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Cppomod (?:SUFFIX?:.mlx .mlx)) $ ./merlin_conf.sh cppomod.ml | diff cppomod.out - @@ -180,12 +189,15 @@ And with unconventional extension: such files) We could expect dune to get the wrongext module configuration $ ./merlin_conf.sh wrongext.cppo.cml | tee wrongext.out - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Wrongext (?:SUFFIX?:.mlx .mlx)) We also have generated.ml and generatedx.mlx promoted: @@ -195,19 +207,25 @@ We also have generated.ml and generatedx.mlx promoted: It should be possible to get its merlin configuration as well: $ ./merlin_conf.sh generated.ml - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Generated (?:SUFFIX?:.mlx .mlx)) $ ./merlin_conf.sh generatedx.mlx - ((?:STDLIB?:/OCAMLC_WHERE + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index + (?:STDLIB?:/OCAMLC_WHERE + (?:SOURCE_ROOT?:$TESTCASE_ROOT (?:EXCLUDE_QUERY_DIR (?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte (?:S?:$TESTCASE_ROOT (?:FLG(?:-open?:Dune__exe) (?:FLG(?:-w?:@1..3@5..28@31..39@43@46..47@49..57@61..62@67@69-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-no-strict-formats?:-g) + (?:UNIT_NAME?:dune__exe__Generatedx (?:SUFFIX?:.mlx .mlx (?:READER(?:mlx))) diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/dune b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/dune new file mode 100644 index 00000000000..95d07f5d928 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/dune @@ -0,0 +1,3 @@ +(executable + (name main) + (libraries lib1)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/main.ml b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/main.ml new file mode 100644 index 00000000000..2f5fb3b592d --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/bin/main.ml @@ -0,0 +1 @@ +type t = Lib1.t \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/dune-project b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/dune-project new file mode 100644 index 00000000000..f390b5360ef --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/dune-project @@ -0,0 +1,2 @@ +(lang dune 2.0) +(implicit_transitive_deps false) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t new file mode 100644 index 00000000000..a4c084111ad --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/run.t @@ -0,0 +1,33 @@ + $ stdlib="$(ocamlc -where)" + $ export BUILD_PATH_PREFIX_MAP="/STDLIB=$stdlib:$BUILD_PATH_PREFIX_MAP" + + $ dune build @check + +FIXME: Merlin must be able to locate the definitions of values coming from an +implicit transitive dependency, even when `implicit-transitive-dependency` is +set to `false`. They should be part of the source path returned by the +configuration. + +In this test the dependencies are as follow: +main -> lib1 -> lib2 -> stdlib + + $ FILE=$PWD/bin/main.ml + $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | + > sed -E "s/[[:digit:]]+:/\?:/g" | tr '(' '\n' | grep ":S?" + ?:S?:/STDLIB) + ?:S?:$TESTCASE_ROOT/bin) + ?:S?:$TESTCASE_ROOT/src/lib1) + ?:S?:$TESTCASE_ROOT/src/lib2) + + $ FILE=$PWD/src/lib1/lib1.ml + $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | + > sed -E "s/[[:digit:]]+:/\?:/g" | tr '(' '\n' | grep ":S?" + ?:S?:/STDLIB) + ?:S?:$TESTCASE_ROOT/src/lib1) + ?:S?:$TESTCASE_ROOT/src/lib2) + + $ FILE=$PWD/src/lib2/lib2.ml + $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | + > sed -E "s/[[:digit:]]+:/\?:/g" | tr '(' '\n' | grep ":S?" + ?:S?:/STDLIB) + ?:S?:$TESTCASE_ROOT/src/lib2) diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/dune b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/dune new file mode 100644 index 00000000000..70976155582 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/dune @@ -0,0 +1,3 @@ +(library + (name lib1) + (libraries lib2)) diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/lib1.ml b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/lib1.ml new file mode 100644 index 00000000000..8b4941c18c6 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib1/lib1.ml @@ -0,0 +1 @@ +include Lib2 diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/dune b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/dune new file mode 100644 index 00000000000..eba0287a9dd --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/dune @@ -0,0 +1,3 @@ +(library + (name lib2) + (libraries unix)) diff --git a/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/lib2.ml b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/lib2.ml new file mode 100644 index 00000000000..e206be29b61 --- /dev/null +++ b/test/blackbox-tests/test-cases/merlin/implicit-transitive-deps.t/src/lib2/lib2.ml @@ -0,0 +1,3 @@ +type t = bool + +type r = Unix.error \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/merlin/include-subdirs-qualified.t b/test/blackbox-tests/test-cases/merlin/include-subdirs-qualified.t index 834f28c3694..0500114f1f0 100644 --- a/test/blackbox-tests/test-cases/merlin/include-subdirs-qualified.t +++ b/test/blackbox-tests/test-cases/merlin/include-subdirs-qualified.t @@ -22,7 +22,11 @@ $ dune build .merlin-conf/lib-foo $ dune ocaml merlin dump-config . Foo: _build/default/foo - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -39,9 +43,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml-gen - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -58,9 +67,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo__Groupintf__: _build/default/foo__Groupintf__ - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -77,9 +91,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf__)) Foo__Groupintf__: _build/default/foo__Groupintf__.ml-gen - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -96,9 +115,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf__)) Utils: _build/default/foo__Utils - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -115,9 +139,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Utils)) Utils: _build/default/foo__Utils.ml-gen - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -134,9 +163,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Utils)) Calc: _build/default/groupintf/calc - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -154,9 +188,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf__Calc)) Calc: _build/default/groupintf/calc.ml - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -174,9 +213,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf__Calc)) Groupintf: _build/default/groupintf/groupintf - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -194,9 +238,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf)) Groupintf: _build/default/groupintf/groupintf.ml - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -214,9 +263,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Groupintf)) Main: _build/default/main - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -234,9 +288,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Main)) Main: _build/default/main.ml - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -254,9 +313,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Main)) Calc: _build/default/utils/calc - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -274,9 +338,14 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Utils__Calc)) Calc: _build/default/utils/calc.ml - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -294,5 +363,6 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Utils__Calc)) $ dune ocaml merlin dump-config utils diff --git a/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t b/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t index 2fea5f64a9f..b7b121b3979 100644 --- a/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/instrumentation.t/run.t @@ -9,7 +9,19 @@ up a project with instrumentation and testing checking the merlin config. $ dune build --instrument-with hello ./lib/.merlin-conf/lib-foo ./lib/.merlin-conf/lib-bar --profile release $ dune ocaml merlin dump-config $PWD/lib Bar: _build/default/lib/bar - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -21,9 +33,22 @@ up a project with instrumentation and testing checking the merlin config. $TESTCASE_ROOT/lib/subdir) (S $TESTCASE_ROOT/ppx) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar)) Bar: _build/default/lib/bar.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -35,9 +60,22 @@ up a project with instrumentation and testing checking the merlin config. $TESTCASE_ROOT/lib/subdir) (S $TESTCASE_ROOT/ppx) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar)) File: _build/default/lib/subdir/file - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -50,9 +88,22 @@ up a project with instrumentation and testing checking the merlin config. (S $TESTCASE_ROOT/ppx) (FLG (-open Bar)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar__File)) File: _build/default/lib/subdir/file.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -65,9 +116,22 @@ up a project with instrumentation and testing checking the merlin config. (S $TESTCASE_ROOT/ppx) (FLG (-open Bar)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar__File)) Foo: _build/default/lib/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) @@ -79,9 +143,22 @@ up a project with instrumentation and testing checking the merlin config. $TESTCASE_ROOT/lib/subdir) (S $TESTCASE_ROOT/ppx) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Foo: _build/default/lib/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) @@ -93,9 +170,22 @@ up a project with instrumentation and testing checking the merlin config. $TESTCASE_ROOT/lib/subdir) (S $TESTCASE_ROOT/ppx) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Privmod: _build/default/lib/privmod - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) @@ -108,9 +198,22 @@ up a project with instrumentation and testing checking the merlin config. (S $TESTCASE_ROOT/ppx) (FLG (-open Foo)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo__Privmod)) Privmod: _build/default/lib/privmod.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.hello_ppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.foo.objs/byte) @@ -123,4 +226,5 @@ up a project with instrumentation and testing checking the merlin config. (S $TESTCASE_ROOT/ppx) (FLG (-open Foo)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo__Privmod)) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t index 3895364d430..97c2408a288 100644 --- a/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/merlin-from-subdir.t/run.t @@ -8,7 +8,13 @@ We build the project Verify that merlin configuration was generated... $ dune ocaml merlin dump-config $PWD Test: _build/default/test - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -25,9 +31,16 @@ Verify that merlin configuration was generated... -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME dune__exe__Test)) Test: _build/default/test.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -44,9 +57,16 @@ Verify that merlin configuration was generated... -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME dune__exe__Test)) Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -61,9 +81,16 @@ Verify that merlin configuration was generated... -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -78,7 +105,8 @@ Verify that merlin configuration was generated... -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) ...but not in the sub-folder whose content was copied $ dune ocaml merlin dump-config $PWD/411 @@ -88,7 +116,7 @@ Now we check that both querying from the root and the subfolder works $ FILE411=$PWD/411/test.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:foo)) $ printf "(4:File%d:%s)" ${#FILE411} $FILE411 | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.test.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.foo.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.test.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:S?:$TESTCASE_ROOT/411)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:dune__exe__Test)) diff --git a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t index c164517d918..cf9a880957d 100644 --- a/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/merlin-tests.t/run.t @@ -14,7 +14,23 @@ CRAM sanitization $ dune build ./exe/.merlin-conf/exe-x --profile release $ dune ocaml merlin dump-config $PWD/exe X: _build/default/exe/x - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -31,9 +47,26 @@ CRAM sanitization (FLG (-pp $TESTCASE_ROOT/_build/default/pp/pp.exe)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME x)) X: _build/default/exe/x.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -50,12 +83,29 @@ CRAM sanitization (FLG (-pp $TESTCASE_ROOT/_build/default/pp/pp.exe)) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME x)) $ dune build ./lib/.merlin-conf/lib-foo ./lib/.merlin-conf/lib-bar --profile release $ dune ocaml merlin dump-config $PWD/lib Bar: _build/default/lib/bar - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -69,9 +119,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="bar"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar)) Bar: _build/default/lib/bar.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -85,9 +152,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="bar"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar)) File: _build/default/lib/subdir/file - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -102,9 +186,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="bar"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar__File)) File: _build/default/lib/subdir/file.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) @@ -119,9 +220,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="bar"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME bar__File)) Foo: _build/default/lib/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -139,9 +257,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="foo"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Foo: _build/default/lib/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -159,9 +294,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="foo"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo)) Privmod: _build/default/lib/privmod - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -180,9 +332,26 @@ CRAM sanitization --as-ppx --cookie 'library-name="foo"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo__Privmod)) Privmod: _build/default/lib/privmod.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_findlib/publicfoo) @@ -201,7 +370,8 @@ CRAM sanitization --as-ppx --cookie 'library-name="foo"'")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foo__Privmod)) Make sure a ppx directive is generated (if not, the [grep ppx] step fails) $ dune ocaml merlin dump-config $PWD/lib | grep ppx > /dev/null @@ -211,7 +381,23 @@ Make sure pp flag is correct and variables are expanded $ dune build ./pp-with-expand/.merlin-conf/exe-foobar --profile release $ dune ocaml merlin dump-config $PWD/pp-with-expand Foobar: _build/default/pp-with-expand/foobar - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/byte) @@ -221,9 +407,26 @@ Make sure pp flag is correct and variables are expanded (-pp "$TESTCASE_ROOT/_build/default/pp/pp.exe -nothing")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foobar)) Foobar: _build/default/pp-with-expand/foobar.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/byte) @@ -233,13 +436,30 @@ Make sure pp flag is correct and variables are expanded (-pp "$TESTCASE_ROOT/_build/default/pp/pp.exe -nothing")) - (FLG (-w -40 -g))) + (FLG (-w -40 -g)) + (UNIT_NAME foobar)) Check hash of executables names if more than one $ dune build ./exes/.merlin-conf/exe-x-6562915302827c6dce0630390bfa68b7 $ dune ocaml merlin dump-config $PWD/exes X: _build/default/exes/x - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) @@ -252,9 +472,26 @@ Check hash of executables names if more than one -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME x)) X: _build/default/exes/x.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) @@ -267,9 +504,26 @@ Check hash of executables names if more than one -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME x)) Y: _build/default/exes/y - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) @@ -282,9 +536,26 @@ Check hash of executables names if more than one -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME y)) Y: _build/default/exes/y.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/exe/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/exes/.x.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.bar.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/ppx/.fooppx.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) @@ -297,4 +568,5 @@ Check hash of executables names if more than one -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME y)) diff --git a/test/blackbox-tests/test-cases/merlin/per-module-pp.t/run.t b/test/blackbox-tests/test-cases/merlin/per-module-pp.t/run.t index 532a2f258a7..495b59dceaa 100644 --- a/test/blackbox-tests/test-cases/merlin/per-module-pp.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/per-module-pp.t/run.t @@ -8,7 +8,13 @@ should appear only once since only Foo is using it. $ dune ocaml merlin dump-config $PWD Bar: _build/default/bar - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -21,9 +27,16 @@ should appear only once since only Foo is using it. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME bar)) Bar: _build/default/bar.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -36,9 +49,16 @@ should appear only once since only Foo is using it. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME bar)) Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -54,9 +74,16 @@ should appear only once since only Foo is using it. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/pp/.pp.eobjs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) @@ -72,4 +99,5 @@ should appear only once since only Foo is using it. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) diff --git a/test/blackbox-tests/test-cases/merlin/server.t/run.t b/test/blackbox-tests/test-cases/merlin/server.t/run.t index fd6f18b1717..505271236e6 100644 --- a/test/blackbox-tests/test-cases/merlin/server.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/server.t/run.t @@ -8,11 +8,11 @@ $ dune build @check $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.main.eobjs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Dune__exe))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.main.eobjs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Dune__exe))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:dune__exe__Main)) $ FILE=$PWD/lib3.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:mylib3__Lib3)) If a file has a name of the kind `module_name.xx.xxx.ml/i` we consider it as ``module_name.ml/i` @@ -20,24 +20,24 @@ This can be useful when some build scripts perform custom preprocessing and copy files around. $ FILE=lib3.foobar.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:mylib3__Lib3)) If a directory has no configuration the configuration of its parent is used This can be useful when some build scripts copy files from subdirectories. $ FILE=foobar/lib3.foobar.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:mylib3__Lib3)) Test of an valid invalid module name $ FILE=not-a-module-name.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-w?:-?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-w?:-?:-g))(?:UNIT_NAME?:dune__exe__Not-a-module-name)) Dune should also provide configuration when the file is in the build folder $ FILE=$PWD/_build/default/lib3.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:mylib3__Lib3)) $ FILE=_build/default/lib3.ml $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | sed -E "s/[[:digit:]]+:/\?:/g" - ((?:STDLIB?:/OCAMLC_WHERE)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))) + ((?:INDEX?:$TESTCASE_ROOT/_build/default/.not-a-module-name.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib3.objs/cctx.ocaml-index)(?:INDEX?:$TESTCASE_ROOT/_build/default/.mylib.objs/cctx.ocaml-index)(?:STDLIB?:/OCAMLC_WHERE)(?:SOURCE_ROOT?:$TESTCASE_ROOT)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib3))(?:FLG(?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs?:-g))(?:UNIT_NAME?:mylib3__Lib3)) diff --git a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t index 178fccc1c7b..cfe9cf7596f 100644 --- a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t +++ b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t @@ -23,7 +23,13 @@ library also has more than one src dir. $ dune build lib2/.merlin-conf/lib-lib2 $ dune ocaml merlin dump-config $PWD/lib2 Lib2: _build/default/lib2/lib2 - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib2/.lib2.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/byte) @@ -42,9 +48,16 @@ library also has more than one src dir. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME lib2)) Lib2: _build/default/lib2/lib2.ml-gen - ((STDLIB /OPAM_PREFIX) + ((INDEX + $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/lib2/.lib2.objs/cctx.ocaml-index) + (STDLIB /OPAM_PREFIX) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/byte) @@ -63,4 +76,5 @@ library also has more than one src dir. -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME lib2)) diff --git a/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t b/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t index eb1036d8902..550ff41a105 100644 --- a/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t @@ -31,4 +31,4 @@ Dune ocaml-merlin also accepts paths relative to the current directory $ dune ocaml merlin dump-config "." --root=".." | head -n 2 Foo: _build/default/realsrc/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX diff --git a/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t b/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t index 0a181e434b2..3cd098a65f8 100644 --- a/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/unit-names-merlin-gh1233.t/run.t @@ -6,7 +6,13 @@ $ dune ocaml merlin dump-config $PWD Foo: _build/default/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.eobjs/byte) @@ -23,9 +29,16 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME dune__exe__Foo)) Foo: _build/default/foo.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.eobjs/byte) @@ -42,11 +55,18 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME dune__exe__Foo)) $ dune ocaml merlin dump-config $PWD/foo Bar: _build/default/foo/bar - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) @@ -60,9 +80,16 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Bar)) Bar: _build/default/foo/bar.ml - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) @@ -76,9 +103,16 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo__Bar)) Foo: _build/default/foo/foo - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) @@ -91,9 +125,16 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) Foo: _build/default/foo/foo.ml-gen - ((STDLIB /OCAMLC_WHERE) + ((INDEX + $TESTCASE_ROOT/_build/default/.foo.eobjs/cctx.ocaml-index) + (INDEX + $TESTCASE_ROOT/_build/default/foo/.foo.objs/cctx.ocaml-index) + (STDLIB /OCAMLC_WHERE) + (SOURCE_ROOT + $TESTCASE_ROOT) (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) @@ -106,7 +147,8 @@ -strict-formats -short-paths -keep-locs - -g))) + -g)) + (UNIT_NAME foo)) FIXME : module Foo is not unbound This test is disabled because it depends on root detection and is not reproducible. diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/dune-workspace b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/dune-workspace new file mode 100644 index 00000000000..1863cf14648 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/dune-workspace @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/run.t b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/run.t new file mode 100644 index 00000000000..0da97dd5b48 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/run.t @@ -0,0 +1,25 @@ + $ mkdir bin + $ cp $(which ocaml_index) bin/ocaml-index + $ export PATH=bin:$PATH + +Building from the workspace folder creates all three indexes: + $ dune build @ocaml-index + $ find . -name '*.ocaml-index' | sort + ./_build/default/sub-project/bin/.main.eobjs/cctx.ocaml-index + ./_build/default/sub-project/lib/.subprojectlib.objs/cctx.ocaml-index + ./_build/default/sub-project2/lib/.subprojectlib2.objs/cctx.ocaml-index + + $ dune clean + +Building from one of the sub-projects folder also creates all three indexes: + $ cd sub-project + $ export PATH=../bin:$PATH + $ dune build --workspace=../dune-workspace --root=.. @sub-project/ocaml-index + Entering directory '..' + Leaving directory '..' + $ cd .. + + $ find . -name '*.ocaml-index' | sort + ./_build/default/sub-project/bin/.main.eobjs/cctx.ocaml-index + ./_build/default/sub-project/lib/.subprojectlib.objs/cctx.ocaml-index + ./_build/default/sub-project2/lib/.subprojectlib2.objs/cctx.ocaml-index diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/dune b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/dune new file mode 100644 index 00000000000..f186fb0b98e --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/dune @@ -0,0 +1,4 @@ +(executable + (name main) + (public_name main) + (libraries subprojectlib subprojectlib2)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/main.ml b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/main.ml new file mode 100644 index 00000000000..f4d83d9b0fa --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/bin/main.ml @@ -0,0 +1,2 @@ +print_int Subprojectlib2.subproject_value; + print_endline "test" diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/dune-project b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/dune-project new file mode 100644 index 00000000000..ec073f599c7 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) + diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/dune b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/dune new file mode 100644 index 00000000000..e260b1dbc40 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/dune @@ -0,0 +1,3 @@ +(library + (name subprojectlib) + (public_name subprojectlib)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/subprojectlib.ml b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/subprojectlib.ml new file mode 100644 index 00000000000..e22b021be33 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/lib/subprojectlib.ml @@ -0,0 +1,2 @@ +let subproject_value = 42 +let () = print_int subproject_value diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/subprojectlib.opam b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project/subprojectlib.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/dune-project b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/dune-project new file mode 100644 index 00000000000..ec073f599c7 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) + diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/dune b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/dune new file mode 100644 index 00000000000..a038335e952 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/dune @@ -0,0 +1,3 @@ +(library + (name subprojectlib2) + (public_name subprojectlib2)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/subprojectlib2.ml b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/subprojectlib2.ml new file mode 100644 index 00000000000..3f4d7e50ac8 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/lib/subprojectlib2.ml @@ -0,0 +1 @@ +let subproject_value = 42 diff --git a/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/subprojectlib2.opam b/test/blackbox-tests/test-cases/ocaml-index/different-workspace-root.t/sub-project2/subprojectlib2.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/ocaml-index/dune b/test/blackbox-tests/test-cases/ocaml-index/dune new file mode 100644 index 00000000000..756128c6037 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/dune @@ -0,0 +1,3 @@ +(cram + (applies_to :whole_subtree) + (deps %{bin:ocaml_index})) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune new file mode 100644 index 00000000000..2baf96810c4 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune @@ -0,0 +1,3 @@ +(executable + (name main) + (libraries otherlib vendored_lib pmodlib)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-project b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-project new file mode 100644 index 00000000000..1614d3d2263 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-project @@ -0,0 +1,3 @@ +(lang dune 3.5) +(implicit_transitive_deps false) + diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-workspace b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-workspace new file mode 100644 index 00000000000..1863cf14648 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/dune-workspace @@ -0,0 +1 @@ +(lang dune 3.5) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/dune new file mode 100644 index 00000000000..cdee168bdbe --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/dune @@ -0,0 +1,2 @@ +(library + (name imp_lib)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/imp_lib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/imp_lib.ml new file mode 100644 index 00000000000..85205179074 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/implicit-lib/imp_lib.ml @@ -0,0 +1,2 @@ +let imp_x = 42 +type t diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/dune new file mode 100644 index 00000000000..534cbaeb840 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/dune @@ -0,0 +1,3 @@ +(library + (name otherlib) + (libraries imp_lib)) \ No newline at end of file diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.ml new file mode 100644 index 00000000000..80450081d6b --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.ml @@ -0,0 +1,6 @@ +type u = Imp_lib.t + +let fromotherlib = 36 +let do_something () = ignore fromotherlib + +include Imp_lib diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.mli b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.mli new file mode 100644 index 00000000000..68328f9ef80 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/lib/otherlib.mli @@ -0,0 +1,6 @@ +val do_something : unit -> unit +val fromotherlib : int + + +include (module type of Imp_lib) +type u = Imp_lib.t diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/main.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/main.ml new file mode 100644 index 00000000000..b77bf81a32c --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/main.ml @@ -0,0 +1,3 @@ +print_int Othermod.(other + Otherlib.fromotherlib + Otherlib.imp_x);; +print_int Vendored_lib.value;; +print_int Pmodlib.x;; diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/othermod.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/othermod.ml new file mode 100644 index 00000000000..64a086316ee --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/othermod.ml @@ -0,0 +1,2 @@ +let y = 36 +let other = 42 + y diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/dune new file mode 100644 index 00000000000..f4ecbe9c95b --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/dune @@ -0,0 +1,3 @@ +(library + (name pmodlib) + (private_modules pmod )) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmod.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmod.ml new file mode 100644 index 00000000000..7fecab12d41 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmod.ml @@ -0,0 +1 @@ +let x = 42 diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmodlib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmodlib.ml new file mode 100644 index 00000000000..19d782a0500 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/private-module/pmodlib.ml @@ -0,0 +1 @@ +include Pmod diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/run.t b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/run.t new file mode 100644 index 00000000000..9f34a834a57 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/run.t @@ -0,0 +1,39 @@ + $ mkdir bin + $ cp $(which ocaml_index) bin/ocaml-index + $ export PATH=bin:$PATH + + $ dune exec ./main.exe + 1564242 + +The @check alias does not build indexes: +(it might at some point if the process becomes fast-enough) + + $ dune build @check + + $ find . -name '*.ocaml-index' | sort + +The @ocaml-index indexes the entire workspace, including librairies that might +not be directly used and thus usually not built by @check: + + $ dune build @ocaml-index + + $ find . -name '*.ocaml-index' | sort + ./_build/default/.main.eobjs/cctx.ocaml-index + ./_build/default/implicit-lib/.imp_lib.objs/cctx.ocaml-index + ./_build/default/lib/.otherlib.objs/cctx.ocaml-index + ./_build/default/private-module/.pmodlib.objs/cctx.ocaml-index + ./_build/default/sub-project/.subprojectlib.objs/cctx.ocaml-index + ./_build/default/vendor/otherproject/.private_lib.objs/cctx.ocaml-index + ./_build/default/vendor/otherproject/.vendored_lib.objs/cctx.ocaml-index + + + $ FILE=$PWD/main.ml + $ printf "(4:File%d:%s)" ${#FILE} $FILE | dune ocaml-merlin | + > sed -E "s/[[:digit:]]+:/\?:/g" | tr '(' '\n' | grep ":INDEX?" + ?:INDEX?:$TESTCASE_ROOT/_build/default/.main.eobjs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/implicit-lib/.imp_lib.objs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/lib/.otherlib.objs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/private-module/.pmodlib.objs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/sub-project/.subprojectlib.objs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/vendor/otherproject/.private_lib.objs/cctx.ocaml-index) + ?:INDEX?:$TESTCASE_ROOT/_build/default/vendor/otherproject/.vendored_lib.objs/cctx.ocaml-index) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune new file mode 100644 index 00000000000..e260b1dbc40 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune @@ -0,0 +1,3 @@ +(library + (name subprojectlib) + (public_name subprojectlib)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune-project b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune-project new file mode 100644 index 00000000000..ec073f599c7 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/dune-project @@ -0,0 +1,2 @@ +(lang dune 3.5) + diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/subprojectlib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/subprojectlib.ml new file mode 100644 index 00000000000..e22b021be33 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/subprojectlib.ml @@ -0,0 +1,2 @@ +let subproject_value = 42 +let () = print_int subproject_value diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/subprojectlib.opam b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/sub-project/subprojectlib.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/dune new file mode 100644 index 00000000000..806de809491 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/dune @@ -0,0 +1 @@ +(vendored_dirs *) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune new file mode 100644 index 00000000000..1edde22bcc6 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune @@ -0,0 +1,8 @@ +(library + (name vendored_lib) + (public_name vendored_lib) + (modules vendored_lib)) + +(library + (name private_lib) ; This private lib is not built when vendored + (modules private_lib)) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune-project b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune-project new file mode 100644 index 00000000000..929c696e561 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/dune-project @@ -0,0 +1 @@ +(lang dune 2.0) diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/private_lib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/private_lib.ml new file mode 100644 index 00000000000..2edb08b94b0 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/private_lib.ml @@ -0,0 +1 @@ +let more = "less" diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/vendored_lib.ml b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/vendored_lib.ml new file mode 100644 index 00000000000..e51d91c9bc2 --- /dev/null +++ b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/vendored_lib.ml @@ -0,0 +1 @@ +let value = 42 diff --git a/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/vendored_lib.opam b/test/blackbox-tests/test-cases/ocaml-index/project-indexation.t/vendor/otherproject/vendored_lib.opam new file mode 100644 index 00000000000..e69de29bb2d diff --git a/test/blackbox-tests/utils/dune b/test/blackbox-tests/utils/dune index 5755469a546..3d1072f7bf0 100644 --- a/test/blackbox-tests/utils/dune +++ b/test/blackbox-tests/utils/dune @@ -33,3 +33,8 @@ (name sherlodoc) (modules sherlodoc) (libraries stdune)) + +(executable + (modules ocaml_index) + (name ocaml_index) + (libraries cmdliner)) diff --git a/test/blackbox-tests/utils/ocaml_index.ml b/test/blackbox-tests/utils/ocaml_index.ml new file mode 100644 index 00000000000..1c4507dc24d --- /dev/null +++ b/test/blackbox-tests/utils/ocaml_index.ml @@ -0,0 +1,101 @@ +(** Mock ocaml-index real CLI *) + +open Cmdliner + +let touch file = + let chan = open_out file in + close_out chan +;; + +module Common = struct + let set_log_level _ _ = () + + let verbose = + let doc = "increase log verbosity" in + Arg.(value & flag & info [ "v"; "verbose" ] ~doc) + ;; + + let debug = + let doc = "set maximum log verbosity" in + Arg.(value & flag & info [ "debug" ] ~doc) + ;; + + let with_log = Term.(const set_log_level $ debug $ verbose) + + let output_file = + let doc = "name of the generated index" in + Arg.(value & opt string "project.ocaml-index" & info [ "o"; "output-file" ] ~doc) + ;; +end + +module Aggregate = struct + let from_files _ _ output_file _ _ () = touch output_file + + let root = + let doc = "if provided all locations will be appended to that path" in + Arg.(value & opt (some string) None & info [ "root" ] ~doc) + ;; + + let files = + let doc = "the files to index" in + Arg.(value & pos_all string [] & info [] ~doc) + ;; + + let build_path = + let doc = "an extra directory to add to the load path" in + Arg.(value & opt_all string [] & info [ "I" ] ~doc) + ;; + + let store_shapes = + let doc = "aggregate input-indexes shapes and store them in the new index" in + Arg.(value & flag & info [ "store-shapes" ] ~doc) + ;; + + let term = + Term.( + const from_files + $ store_shapes + $ root + $ Common.output_file + $ build_path + $ files + $ Common.with_log) + ;; + + let cmd = + let info = + let doc = "builds the index for a single $(i, .cmt) file" in + Cmd.info "aggregate" ~doc + in + Cmd.v info term + ;; +end + +module Dump = struct + let dump file () = Printf.printf "Dump %s" file + + let file = + let doc = "the file to dump" in + Arg.(required & pos 0 (some string) None & info [] ~doc) + ;; + + let term = Term.(const dump $ file $ Common.with_log) + + let cmd = + let info = + let doc = "print the content of an index file to stdout" in + Cmd.info "dump" ~doc + in + Cmd.v info term + ;; +end + +let subcommands = + let info = + let doc = "An indexer for OCaml's artifacts" in + Cmd.info "ocaml-index" ~doc + in + Cmd.group info ~default:Aggregate.term [ Aggregate.cmd; Dump.cmd ] +;; + +let () = exit (Cmd.eval subcommands) diff --git a/test/expect-tests/persistent_tests.ml b/test/expect-tests/persistent_tests.ml index 96263336a2a..47b6fed45c7 100644 --- a/test/expect-tests/persistent_tests.ml +++ b/test/expect-tests/persistent_tests.ml @@ -43,8 +43,8 @@ let%expect_test "persistent digests" = 7e311b06ebde9ff1708e4c3a1d3f5633 --- - merlin-conf version 4 - 782b1c9ea57a40a427f80fa24ba6d853 + merlin-conf version 5 + 49e3a1010b7218f5b229d98991d6d11d --- INCREMENTAL-DB version 5