From 228f2b637efc7cefe2dca68cb18839dd0385a30b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Wed, 10 Feb 2021 12:44:30 +0100 Subject: [PATCH 1/3] merlin: communicate STDLIB directive MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- src/dune_rules/exe_rules.ml | 4 +++- src/dune_rules/lib_rules.ml | 5 +++-- src/dune_rules/merlin.ml | 22 ++++++++++++++-------- src/dune_rules/merlin.mli | 1 + 4 files changed, 21 insertions(+), 11 deletions(-) diff --git a/src/dune_rules/exe_rules.ml b/src/dune_rules/exe_rules.ml index f00267a94e3..13d4f2e4f94 100644 --- a/src/dune_rules/exe_rules.ml +++ b/src/dune_rules/exe_rules.ml @@ -159,6 +159,7 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~modules ~flags ~requires_link ~requires_compile ~preprocessing:pp ~js_of_ocaml ~opaque:Inherit_from_settings ~package:exes.package in + let stdlib_dir = ctx.Context.stdlib_dir in let requires_compile = Compilation_context.requires_compile cctx in let preprocess = Preprocess.Per_module.with_instrumentation exes.buildable.preprocess @@ -197,7 +198,8 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info ~promote:exes.promote ~embed_in_plugin_libraries in ( cctx - , Merlin.make ~requires:requires_compile ~flags ~modules ~preprocess ~obj_dir + , Merlin.make ~requires:requires_compile ~stdlib_dir ~flags ~modules + ~preprocess ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) ~ident:(Lib.Compile.merlin_ident compile_info) () ) diff --git a/src/dune_rules/lib_rules.ml b/src/dune_rules/lib_rules.ml index 04a7f762063..cf986e2a038 100644 --- a/src/dune_rules/lib_rules.ml +++ b/src/dune_rules/lib_rules.ml @@ -386,6 +386,7 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents let dir = Compilation_context.dir cctx in let scope = Compilation_context.scope cctx in let requires_compile = Compilation_context.requires_compile cctx in + let stdlib_dir = (Compilation_context.context cctx).Context.stdlib_dir in let dep_graphs = Dep_rules.rules cctx ~modules in Option.iter vimpl ~f:(Virtual_rules.setup_copy_rules_for_impl ~sctx ~dir); Check_rules.add_obj_dir sctx ~obj_dir; @@ -415,8 +416,8 @@ let library_rules (lib : Library.t) ~cctx ~source_modules ~dir_contents ; compile_info }; ( cctx - , Merlin.make ~requires:requires_compile ~flags ~modules ~preprocess - ~libname:(snd lib.name) ~obj_dir + , Merlin.make ~requires:requires_compile ~stdlib_dir ~flags ~modules + ~preprocess ~libname:(snd lib.name) ~obj_dir ~dialects:(Dune_project.dialects (Scope.project scope)) ~ident:(Lib.Compile.merlin_ident compile_info) () ) diff --git a/src/dune_rules/merlin.ml b/src/dune_rules/merlin.ml index 9013e7125e4..7975e6203ff 100644 --- a/src/dune_rules/merlin.ml +++ b/src/dune_rules/merlin.ml @@ -17,7 +17,8 @@ module Processed = struct (* Most of the configuration is shared accros a same lib/exe... *) type config = - { obj_dirs : Path.Set.t + { stdlib_dir : Path.t + ; obj_dirs : Path.Set.t ; src_dirs : Path.Set.t ; flags : string list ; extensions : string Ml_kind.Dict.t list @@ -42,13 +43,14 @@ module Processed = struct let load_file = Persist.load - let to_sexp ~pp { obj_dirs; src_dirs; flags; extensions } = + let to_sexp ~pp { stdlib_dir; obj_dirs; src_dirs; flags; extensions } = let serialize_path = Path.to_absolute_filename in let to_atom s = Sexp.Atom s in 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 stdlib_dir = [ make_directive_of_path "STDLIB" stdlib_dir ] in let exclude_query_dir = [ Sexp.List [ Atom "EXCLUDE_QUERY_DIR" ] ] in let obj_dirs = Path.Set.to_list obj_dirs |> List.map ~f:(make_directive_of_path "B") @@ -73,7 +75,8 @@ module Processed = struct make_directive "SUFFIX" (Sexp.Atom (Printf.sprintf "%s %s" impl intf))) in Sexp.List - (List.concat [ exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ]) + (List.concat + [ stdlib_dir; exclude_query_dir; obj_dirs; src_dirs; flags; suffixes ]) let get { modules; pp_config; config } ~filename = let fname = Filename.remove_extension filename |> String.lowercase in @@ -106,7 +109,8 @@ module Unprocessed = struct for it's elaboration via the function [process : Unprocessed.t ... -> Processed.t] *) type config = - { requires : Lib.Set.t + { stdlib_dir : Path.t + ; requires : Lib.Set.t ; flags : string list Action_builder.t ; preprocess : Preprocess.Without_instrumentation.t Preprocess.t Module_name.Per_item.t @@ -122,7 +126,7 @@ module Unprocessed = struct ; modules : Modules.t } - let make ?(requires = Ok []) ~flags + let make ?(requires = Ok []) ~stdlib_dir ~flags ?(preprocess = Preprocess.Per_module.no_preprocessing ()) ?libname ?(source_dirs = Path.Source.Set.empty) ~modules ~obj_dir ~dialects ~ident () = @@ -146,7 +150,8 @@ module Unprocessed = struct in let extensions = Dialect.DB.extensions_for_merlin dialects in let config = - { requires + { stdlib_dir + ; requires ; flags = Action_builder.catch flags ~on_error:[] ; preprocess ; libname @@ -235,7 +240,8 @@ module Unprocessed = struct { modules ; ident = _ ; config = - { extensions + { stdlib_dir + ; extensions ; flags ; objs_dirs ; source_dirs @@ -260,7 +266,7 @@ module Unprocessed = struct Path.Set.union src_dirs (Path.Set.of_list_map ~f:Path.source more_src_dirs) in - { Processed.src_dirs; obj_dirs; flags; extensions } + { Processed.stdlib_dir; src_dirs; obj_dirs; flags; extensions } and+ pp_config = Module_name.Per_item.map_with_targets preprocess ~f:(pp_flags sctx ~expander libname) diff --git a/src/dune_rules/merlin.mli b/src/dune_rules/merlin.mli index 02880af1f0e..2259b020312 100644 --- a/src/dune_rules/merlin.mli +++ b/src/dune_rules/merlin.mli @@ -26,6 +26,7 @@ end val make : ?requires:Lib.t list Or_exn.t + -> stdlib_dir:Path.t -> flags:Ocaml_flags.t -> ?preprocess: Preprocess.Without_instrumentation.t Preprocess.t Module_name.Per_item.t From 14ee3fdacab430550c8f13f5d326277a6f9554ce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Wed, 10 Feb 2021 13:16:36 +0100 Subject: [PATCH 2/3] Update tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- .../test-cases/github1946.t/run.t | 9 ++++--- .../test-cases/github759.t/run.t | 18 +++++++++----- .../test-cases/merlin/github4125.t/run.t | 6 +++-- .../merlin/merlin-from-subdir.t/run.t | 17 +++++++------ .../test-cases/merlin/merlin-tests.t/run.t | 24 ++++++++++++------- .../test-cases/merlin/per-module-pp.t/run.t | 9 ++++--- .../test-cases/merlin/server.t/run.t | 8 +++---- .../merlin/src-dirs-of-deps.t/run.t | 6 +++-- .../test-cases/merlin/symlinks.t/run.t | 6 +++-- .../merlin/unit-names-merlin-gh1233.t/run.t | 15 ++++++++---- 10 files changed, 76 insertions(+), 42 deletions(-) diff --git a/test/blackbox-tests/test-cases/github1946.t/run.t b/test/blackbox-tests/test-cases/github1946.t/run.t index 0967c28ef87..b53b8696446 100644 --- a/test/blackbox-tests/test-cases/github1946.t/run.t +++ b/test/blackbox-tests/test-cases/github1946.t/run.t @@ -2,9 +2,11 @@ This test demonstrates that -ppx is no more missing when two stanzas are in the same dune file, but require different ppx specifications $ dune build @all --profile release - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Usesppx1 - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx1.objs/byte) (S @@ -17,7 +19,8 @@ in the same dune file, but require different ppx specifications 'library-name="usesppx1"'")) (FLG (-open Usesppx1 -w -40))) Usesppx2 - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.usesppx2.objs/byte) (S diff --git a/test/blackbox-tests/test-cases/github759.t/run.t b/test/blackbox-tests/test-cases/github759.t/run.t index 7d2a9feacf9..2a232e760ab 100644 --- a/test/blackbox-tests/test-cases/github759.t/run.t +++ b/test/blackbox-tests/test-cases/github759.t/run.t @@ -1,7 +1,9 @@ $ dune build foo.cma --profile release - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S @@ -10,9 +12,11 @@ $ rm -f .merlin $ dune build foo.cma --profile release - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S @@ -21,9 +25,11 @@ $ echo toto > .merlin $ dune build foo.cma --profile release - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S 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 46c49a9c6e8..575579d5ae6 100644 --- a/test/blackbox-tests/test-cases/merlin/github4125.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/github4125.t/run.t @@ -17,9 +17,11 @@ We call `$(opam switch show)` so that this test always uses an existing switch .. lib-foo - $ dune ocaml-merlin --dump-config="$(pwd)" + $ dune ocaml-merlin --dump-config="$(pwd)" | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/cross/.foo.objs/byte) (S 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 2eef029f8e0..92c7135e26e 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 @@ -3,9 +3,11 @@ We build the project bar Verify that merlin configuration was generated... - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Test - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (B @@ -22,7 +24,8 @@ Verify that merlin configuration was generated... -short-paths -keep-locs))) Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S @@ -44,12 +47,12 @@ Now we check that both querying from the root and the subfolder works $ FILE=$(pwd)/foo.ml $ FILE411=$(pwd)/411/test.ml - $ dune ocaml-merlin < (4:File${#FILE}:$FILE) > EOF - ((?: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))) + ((?:STDLIB?:OPAM_PREFIX/lib/ocaml)(?: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))) - $ dune ocaml-merlin < (4:File${#FILE411}:$FILE411) > EOF - ((?: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))) + ((?:STDLIB?:OPAM_PREFIX/lib/ocaml)(?: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))) 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 a3cc6105ee8..2e078c62006 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 @@ -3,7 +3,8 @@ CRAM sanitization $ dune ocaml-merlin --dump-config=$(pwd)/exe | > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' X - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B OPAM_PREFIX/lib/bytes) (B OPAM_PREFIX/lib/findlib) (B OPAM_PREFIX/lib/ocaml) @@ -27,7 +28,8 @@ CRAM sanitization $ dune ocaml-merlin --dump-config=$(pwd)/lib | > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' File - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) (S @@ -42,7 +44,8 @@ CRAM sanitization 'library-name="bar"'")) (FLG (-open Bar -w -40))) Bar - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib/.bar.objs/byte) (S @@ -57,7 +60,8 @@ CRAM sanitization 'library-name="bar"'")) (FLG (-open Bar -w -40))) Privmod - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B OPAM_PREFIX/lib/bytes) (B OPAM_PREFIX/lib/findlib) (B OPAM_PREFIX/lib/ocaml) @@ -78,7 +82,8 @@ CRAM sanitization 'library-name="foo"'")) (FLG (-open Foo -w -40))) Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B OPAM_PREFIX/lib/bytes) (B OPAM_PREFIX/lib/findlib) (B OPAM_PREFIX/lib/ocaml) @@ -108,7 +113,8 @@ Make sure pp flag is correct and variables are expanded $ dune ocaml-merlin --dump-config=$(pwd)/pp-with-expand | > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foobar - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/pp-with-expand/.foobar.eobjs/byte) (S @@ -124,7 +130,8 @@ Check hash of executables names if more than one $ dune ocaml-merlin --dump-config=$(pwd)/exes | > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Y - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) (S @@ -137,7 +144,8 @@ Check hash of executables names if more than one -short-paths -keep-locs))) X - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/exes/.x.eobjs/byte) (S 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 4e09cf08ca3..8d39fa17faf 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 @@ -3,9 +3,11 @@ We dump the config for Foo and Bar modules but the pp.exe preprocessor should appear only once since only Foo is using it. - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S @@ -21,7 +23,8 @@ should appear only once since only Foo is using it. -short-paths -keep-locs))) Bar - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.objs/byte) (S 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 2b9e9211aa8..2286956fcca 100644 --- a/test/blackbox-tests/test-cases/merlin/server.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/server.t/run.t @@ -6,13 +6,13 @@ $ dune build @check - $ dune ocaml-merlin < (4:File${#FILE}:$FILE) > EOF - ((?: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?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) + ((?:STDLIB?:OPAM_PREFIX/lib/ocaml)(?: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?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) $ FILE=$PWD/lib3.ml - $ dune ocaml-merlin < (4:File${#FILE}:$FILE) > EOF - ((?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) + ((?:STDLIB?:OPAM_PREFIX/lib/ocaml)(?:EXCLUDE_QUERY_DIR)(?:B?:$TESTCASE_ROOT/_build/default/.mylib.objs/byte)(?:B?:$TESTCASE_ROOT/_build/default/.mylib3.objs/byte)(?:S?:$TESTCASE_ROOT)(?:FLG(?:-open?:Mylib?:-w?:@1..3@5..28@30..39@43@46..47@49..57@61..62-?:-strict-sequence?:-strict-formats?:-short-paths?:-keep-locs))) diff --git a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t index 87573752218..667d83c95d4 100644 --- a/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/src-dirs-of-deps.t/run.t @@ -15,9 +15,11 @@ library also has more than one src dir. > EOF $ dune build lib2/.merlin-conf/lib-lib2 - $ dune ocaml-merlin --dump-config=$(pwd)/lib2 + $ dune ocaml-merlin --dump-config=$(pwd)/lib2 | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Lib2 - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/lib1/.lib1.objs/byte) (B 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 f63d106d137..9824f8e8bf0 100644 --- a/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t +++ b/test/blackbox-tests/test-cases/merlin/symlinks.t/run.t @@ -25,7 +25,9 @@ Dune ocaml-merlin also accepts paths relative to the current directory Foo $ cd realsrc - $ dune ocaml-merlin --dump-config="." --root=".." | head -n 2 + $ dune ocaml-merlin --dump-config="." --root=".." | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' | + > head -n 2 Entering directory '..' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) 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 8f36f235831..777d48c56ec 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 @@ -1,9 +1,11 @@ $ dune exec ./foo.exe 42 - $ dune ocaml-merlin --dump-config=$(pwd) + $ dune ocaml-merlin --dump-config=$(pwd) | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/.foo.eobjs/byte) (B @@ -20,9 +22,11 @@ -short-paths -keep-locs))) - $ dune ocaml-merlin --dump-config=$(pwd)/foo + $ dune ocaml-merlin --dump-config=$(pwd)/foo | + > sed 's#'$(opam config var prefix)'#OPAM_PREFIX#' Bar - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) (S @@ -37,7 +41,8 @@ -short-paths -keep-locs))) Foo - ((EXCLUDE_QUERY_DIR) + ((STDLIB OPAM_PREFIX/lib/ocaml) + (EXCLUDE_QUERY_DIR) (B $TESTCASE_ROOT/_build/default/foo/.foo.objs/byte) (S From 24ec0025f691f8491791c590f84fe030b94a72bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Tue, 16 Feb 2021 10:16:02 +0100 Subject: [PATCH 3/3] CHANGES.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- CHANGES.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 89f1bd9fae5..4d87a2287e3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -41,6 +41,9 @@ Unreleased - Dune no longer automatically create or edit `dune-project` files (#4239, fixes #4108, @jeremiedimino) +- Have `dune` communicate the location of the standard library directory to + `merlin` (#4211, fixes #4188, @nojb) + 2.8.2 (21/01/2021) ------------------