diff --git a/doc/changes/11366.md b/doc/changes/11366.md new file mode 100644 index 00000000000..a74552ba401 --- /dev/null +++ b/doc/changes/11366.md @@ -0,0 +1 @@ +- Fix cram tests build-path-prefix-map substitutions (#11366, @art-w) diff --git a/doc/tests.rst b/doc/tests.rst index 9e9a9f9267f..c5a35469862 100644 --- a/doc/tests.rst +++ b/doc/tests.rst @@ -690,9 +690,9 @@ the standard BUILD_PATH_PREFIX_MAP_ environment variable. For example: .. code:: console - $ export BUILD_PATH_PREFIX_MAP="HOME=$HOME:$BUILD_PATH_PREFIX_MAP" + $ export BUILD_PATH_PREFIX_MAP="/HOME=$HOME:$BUILD_PATH_PREFIX_MAP" $ echo $HOME - $HOME + /HOME Note: Unlike Dune's version of Cram, the original specification for Cram supports regular expression and glob filtering for matching output. We chose diff --git a/src/dune_engine/process.ml b/src/dune_engine/process.ml index 2b4d64fc3af..d083e732283 100644 --- a/src/dune_engine/process.ml +++ b/src/dune_engine/process.ml @@ -855,6 +855,14 @@ let report_process_finished let set_temp_dir_when_running_actions = ref true +let set_temp_dir ~temp_dir env = + match temp_dir, !set_temp_dir_when_running_actions with + | Some path, _ -> + Env.add env ~var:Env.Var.temp_dir ~value:(Path.to_absolute_filename path) + | None, true -> Dtemp.add_to_env env + | None, false -> env +;; + let await { response_file; pid; _ } = let+ process_info, termination_reason = Scheduler.wait_for_build_process pid ~is_process_group_leader:true @@ -865,6 +873,7 @@ let await { response_file; pid; _ } = let spawn ?dir + ?temp_dir ?(env = Env.initial) ~(stdout : _ Io.t) ~(stderr : _ Io.t) @@ -933,14 +942,7 @@ let spawn Unix.gettimeofday () in let pid = - let env = - let env = - match !set_temp_dir_when_running_actions with - | true -> Dtemp.add_to_env env - | false -> env - in - Env.to_unix env |> Spawn.Env.of_list - in + let env = set_temp_dir ~temp_dir env |> Env.to_unix |> Spawn.Env.of_list in let stdout = Io.fd stdout in let stderr = Io.fd stderr in let stdin = Io.fd stdin in @@ -976,6 +978,7 @@ let spawn let run_internal ?dir + ?temp_dir ~(display : Display.t) ?(stdout_to = Io.stdout) ?(stderr_to = Io.stderr) @@ -1015,7 +1018,16 @@ let run_internal | _ -> Pp.nop in let t = - spawn ?dir ?env ~stdout:stdout_to ~stderr:stderr_to ~stdin:stdin_from ~prog ~args () + spawn + ?dir + ?temp_dir + ?env + ~stdout:stdout_to + ~stderr:stderr_to + ~stdin:stdin_from + ~prog + ~args + () in let* () = let description = @@ -1092,11 +1104,23 @@ let run_internal res, times) ;; -let run ?dir ~display ?stdout_to ?stderr_to ?stdin_from ?env ?metadata fail_mode prog args +let run + ?dir + ?temp_dir + ~display + ?stdout_to + ?stderr_to + ?stdin_from + ?env + ?metadata + fail_mode + prog + args = let+ run = run_internal ?dir + ?temp_dir ~display ?stdout_to ?stderr_to @@ -1113,6 +1137,7 @@ let run ?dir ~display ?stdout_to ?stderr_to ?stdin_from ?env ?metadata fail_mode let run_with_times ?dir + ?temp_dir ~display ?stdout_to ?stderr_to @@ -1126,6 +1151,7 @@ let run_with_times let+ code, times = run_internal ?dir + ?temp_dir ~display ?stdout_to ?stderr_to @@ -1141,6 +1167,7 @@ let run_with_times let run_capture_gen ?dir + ?temp_dir ~display ?stderr_to ?stdin_from @@ -1155,6 +1182,7 @@ let run_capture_gen let+ run = run_internal ?dir + ?temp_dir ~display ~stdout_to:(Io.file fn Io.Out) ?stderr_to @@ -1178,6 +1206,7 @@ let run_capture_zero_separated = run_capture_gen ~f:Stdune.Io.zero_strings_of_fi let run_capture_line ?dir + ?temp_dir ~display ?stderr_to ?stdin_from @@ -1189,6 +1218,7 @@ let run_capture_line = run_capture_gen ?dir + ?temp_dir ~display ?stderr_to ?stdin_from diff --git a/src/dune_engine/process.mli b/src/dune_engine/process.mli index 19deccc06c1..74f9166f39b 100644 --- a/src/dune_engine/process.mli +++ b/src/dune_engine/process.mli @@ -90,6 +90,7 @@ val set_temp_dir_when_running_actions : bool ref termination. [stdout_to] [stderr_to] are released *) val run : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stdout_to:Io.output Io.t -> ?stderr_to:Io.output Io.t @@ -103,6 +104,7 @@ val run val run_with_times : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stdout_to:Io.output Io.t -> ?stderr_to:Io.output Io.t @@ -117,6 +119,7 @@ val run_with_times (** Run a command and capture its output *) val run_capture : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stderr_to:Io.output Io.t -> ?stdin_from:Io.input Io.t @@ -129,6 +132,7 @@ val run_capture val run_capture_line : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stderr_to:Io.output Io.t -> ?stdin_from:Io.input Io.t @@ -141,6 +145,7 @@ val run_capture_line val run_capture_lines : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stderr_to:Io.output Io.t -> ?stdin_from:Io.input Io.t @@ -153,6 +158,7 @@ val run_capture_lines val run_capture_zero_separated : ?dir:Path.t + -> ?temp_dir:Path.t -> display:Display.t -> ?stderr_to:Io.output Io.t -> ?stdin_from:Io.input Io.t diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml index d0a742cfe4d..88ff770dcd5 100644 --- a/src/dune_rules/action_unexpanded.ml +++ b/src/dune_rules/action_unexpanded.ml @@ -564,8 +564,15 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = let+ l = A.all (List.map l ~f:expand) in O.Pipe (outputs, l) | Cram script -> - let+ script = E.dep script in - Cram_exec.action script + A.with_expander (fun expander -> + let open Memo.O in + let+ version = + let dir = Expander.dir expander in + Dune_load.find_project ~dir >>| Dune_project.dune_version + in + let open Action_expander.O in + let+ script = E.dep script in + Cram_exec.action ~version script) | Format_dune_file (src, dst) -> A.with_expander (fun expander -> let open Memo.O in diff --git a/src/dune_rules/cram/cram_exec.ml b/src/dune_rules/cram/cram_exec.ml index 09888192b87..82feddc1af7 100644 --- a/src/dune_rules/cram/cram_exec.ml +++ b/src/dune_rules/cram/cram_exec.ml @@ -259,17 +259,31 @@ let line_number = seq [ set "123456789"; rep digit ] ;; -let rewrite_paths build_path_prefix_map ~parent_script ~command_script s = +let absolute_paths = + let not_dir = Printf.sprintf " \n\r\t%c" Bin.path_sep in + Re.(compile (seq [ char '/'; rep1 (diff any (set not_dir)) ])) +;; + +let known_paths map = + List.filter_map + ~f:(function + | None | Some { Build_path_prefix_map.source = ""; _ } -> None + | Some pair -> Some (Re.str pair.source)) + map + |> List.rev + (* prefer right-most paths in the list, as required by the build-path-prefix-map spec *) + |> Re.alt + |> Re.compile +;; + +let rewrite_paths ~version ~build_path_prefix_map ~parent_script ~command_script s = match Build_path_prefix_map.decode_map build_path_prefix_map with | Error msg -> Code_error.raise "Cannot decode build prefix map" [ "build_path_prefix_map", String build_path_prefix_map; "msg", String msg ] | Ok map -> - let abs_path_re = - let not_dir = Printf.sprintf " \n\r\t%c" Bin.path_sep in - Re.(compile (seq [ char '/'; rep1 (diff any (set not_dir)) ])) - in + let known_paths = if version < (3, 18) then absolute_paths else known_paths map in let error_msg = let open Re in let command_script = str (Path.to_absolute_filename command_script) in @@ -281,12 +295,12 @@ let rewrite_paths build_path_prefix_map ~parent_script ~command_script s = let b = seq [ command_script; str ": line "; line_number; str ": " ] in [ a; b ] |> List.map ~f:(fun re -> seq [ bol; re ]) |> alt |> compile in - Re.replace abs_path_re s ~f:(fun g -> + Re.replace ~all:true known_paths s ~f:(fun g -> Build_path_prefix_map.rewrite map (Re.Group.get g 0)) |> Re.replace_string error_msg ~by:"" ;; -let sanitize ~parent_script cram_to_output +let sanitize ~version ~parent_script cram_to_output : (block_result * metadata_result * string) Cram_lexer.block list = List.map cram_to_output ~f:(fun (t : (block_result * _) Cram_lexer.block) -> @@ -300,9 +314,10 @@ let sanitize ~parent_script cram_to_output Io.read_file ~binary:false block_result.output_file |> Ansi_color.strip |> rewrite_paths + ~version ~parent_script ~command_script:block_result.script - build_path_prefix_map + ~build_path_prefix_map in Command (block_result, metadata, output)) ;; @@ -389,7 +404,7 @@ let create_sh_script cram_stanzas ~temp_dir : sh_script Fiber.t = let _display_with_bars s = List.iter (String.split_lines s) ~f:(Printf.eprintf "| %s\n") -let run ~env ~script lexbuf : string Fiber.t = +let run ~version ~env ~script lexbuf : string Fiber.t = let temp_dir = let suffix = let basename = Path.basename script in @@ -406,19 +421,16 @@ let run ~env ~script lexbuf : string Fiber.t = let open Fiber.O in let* sh_script = create_sh_script cram_stanzas ~temp_dir in let cwd = Path.parent_exn script in + let temp_dir = Path.relative temp_dir "tmp" in + Path.mkdir_p temp_dir; let env = let env = Env.add env ~var:"LC_ALL" ~value:"C" in - let temp_dir = Path.relative temp_dir "tmp" in - let env = - Dune_util.Build_path_prefix_map.extend_build_path_prefix_map - env - `New_rules_have_precedence - [ Some { source = Path.to_absolute_filename cwd; target = "$TESTCASE_ROOT" } - ; Some { source = Path.to_absolute_filename temp_dir; target = "$TMPDIR" } - ] - in - Path.mkdir_p temp_dir; - Env.add env ~var:Env.Var.temp_dir ~value:(Path.to_absolute_filename temp_dir) + Dune_util.Build_path_prefix_map.extend_build_path_prefix_map + env + `New_rules_have_precedence + [ Some { source = Path.to_absolute_filename cwd; target = "$TESTCASE_ROOT" } + ; Some { source = Path.to_absolute_filename temp_dir; target = "$TMPDIR" } + ] in let open Fiber.O in let+ () = @@ -442,29 +454,38 @@ let run ~env ~script lexbuf : string Fiber.t = ~display:Quiet ~metadata ~dir:cwd + ~temp_dir ~env Strict sh [ Path.to_string sh_script.script ] in let raw = read_and_attach_exit_codes sh_script in - let sanitized = sanitize ~parent_script:sh_script.script raw in + let sanitized = sanitize ~version ~parent_script:sh_script.script raw in compose_cram_output sanitized ;; -let run ~env ~script = run_expect_test script ~f:(fun lexbuf -> run ~env ~script lexbuf) +let run ~version ~env ~script = + run_expect_test script ~f:(fun lexbuf -> run ~version ~env ~script lexbuf) +;; module Spec = struct - type ('path, _) t = 'path + type ('path, _) t = Dune_lang.Syntax.Version.t * 'path let name = "cram" let version = 2 - let bimap path f _ = f path + let bimap (version, path) f _ = version, f path let is_useful_to ~memoize:_ = true - let encode script path _ : Sexp.t = List [ path script ] - let action script ~ectx:_ ~(eenv : Action.env) = run ~env:eenv.env ~script + + let encode (version, script) path _ : Sexp.t = + List [ Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp; path script ] + ;; + + let action (version, script) ~ectx:_ ~(eenv : Action.env) = + run ~version ~env:eenv.env ~script + ;; end module Action = Action_ext.Make (Spec) -let action = Action.action +let action ~version path = Action.action (version, path) diff --git a/src/dune_rules/cram/cram_exec.mli b/src/dune_rules/cram/cram_exec.mli index 6f625daf7a1..2a592a25dd1 100644 --- a/src/dune_rules/cram/cram_exec.mli +++ b/src/dune_rules/cram/cram_exec.mli @@ -1,3 +1,3 @@ open Import -val action : Path.t -> Action.t +val action : version:Dune_lang.Syntax.Version.t -> Path.t -> Action.t diff --git a/src/dune_rules/cram/cram_rules.ml b/src/dune_rules/cram/cram_rules.ml index 3a01f023552..b8419b9eae7 100644 --- a/src/dune_rules/cram/cram_rules.ml +++ b/src/dune_rules/cram/cram_rules.ml @@ -47,6 +47,7 @@ let missing_run_t (error : Cram_test.t) = ;; let test_rule + ~version ~sctx ~dir ({ alias; loc; enabled_if; deps; locks; sandbox; packages = _ } : Spec.t) @@ -86,7 +87,7 @@ let test_rule () and+ locks = locks >>| Path.Set.to_list in Action.progn - [ Cram_exec.action (Path.build script) + [ Cram_exec.action ~version (Path.build script) ; Promote.Diff_action.diff ~optional:true ~mode:Text @@ -125,7 +126,7 @@ let collect_stanzas = | Some dir -> collect_whole_subtree [ acc ] dir ;; -let rules ~sctx ~dir tests = +let rules ~version ~sctx ~dir tests = let* stanzas = collect_stanzas ~dir and* with_package_mask = Dune_load.mask () @@ -237,7 +238,7 @@ let rules ~sctx ~dir tests = in { acc with alias } in - with_package_mask spec.packages (fun () -> test_rule ~sctx ~dir spec test)) + with_package_mask spec.packages (fun () -> test_rule ~version ~sctx ~dir spec test)) ;; let cram_tests dir = @@ -284,5 +285,7 @@ let rules ~sctx ~dir source_dir = cram_tests source_dir >>= function | [] -> Memo.return () - | tests -> rules ~sctx ~dir tests + | tests -> + let version = Source_tree.Dir.project source_dir |> Dune_project.dune_version in + rules ~version ~sctx ~dir tests ;; diff --git a/test/blackbox-tests/test-cases/cram/build-path-prefix-map.t b/test/blackbox-tests/test-cases/cram/build-path-prefix-map.t new file mode 100644 index 00000000000..0069e2de8c1 --- /dev/null +++ b/test/blackbox-tests/test-cases/cram/build-path-prefix-map.t @@ -0,0 +1,102 @@ +Before dune 3.18, the substitution would only apply to absolute paths containing no spaces: + + $ mkdir test + $ cd test + + $ cat >dune-project < (lang dune 3.17) + > EOF + + $ cat >dune < (cram) + > EOF + + $ cat >run.t < $ export BUILD_PATH_PREFIX_MAP=LOCAL=tmp/local + > $ echo /path/to/tmp/local/thing + > /path/to/tmp/local/thing + > EOF + + $ dune runtest + +After 3.18: + + $ cat >dune-project < (lang dune 3.18) + > EOF + + $ cat >run.t < $ export BUILD_PATH_PREFIX_MAP=LOCAL=tmp/local + > $ echo /path/to/tmp/local/thing + > /path/to/LOCAL/thing + > EOF + + $ dune runtest + +A longer test, which could be un-nested once dune itself requires 3.18 in its dune-project: + + $ export BUILD_PATH_PREFIX_MAP=parent-env=ignore + + $ cat >run.t <<"EOF" + > The build-path-prefix-map substitutes any dynamic path in the output of + > commands, to help with reproducibility: + > + > $ PWD=$(pwd) + > $ echo $PWD + > $TESTCASE_ROOT + > $ echo /nest/$PWD/sub/dir + > /nest/$TESTCASE_ROOT/sub/dir + > $ echo "[\"$PWD\",\"$PWD\"]" + > ["$TESTCASE_ROOT","$TESTCASE_ROOT"] + > + > Besides the current `$TESTCASE_ROOT` directory, an empty `$TMPDIR` is available: + > + > $ ls -a $TMPDIR + > . + > .. + > $ echo $TMPDIR + > $TMPDIR + > $ echo $TMPDIR/sub/dir + > $TMPDIR/sub/dir + > $ echo The tempdir is at:$TMPDIR: + > The tempdir is at:$TMPDIR: + > + > And the dune workspace root is replaced by `/workspace_root`: + > + > $ dirname $(pwd) + > /workspace_root + > + > The environment variable `$BUILD_PATH_PREFIX_MAP` can be extended with new + > entries, e.g. the user `$HOME` directory: + > + > $ export BUILD_PATH_PREFIX_MAP="HOME=$HOME:$BUILD_PATH_PREFIX_MAP" + > $ echo $HOME + > HOME + > + > Spaces in paths are supported: + > + > $ SPACED="path/contains spaces/.but/it's not an" + > $ echo /this/$SPACED/issue + > /this/path/contains spaces/.but/it's not an/issue + > $ export BUILD_PATH_PREFIX_MAP="\$SPACED=$SPACED:$BUILD_PATH_PREFIX_MAP" + > $ echo /this/$SPACED/issue + > /this/$SPACED/issue + > + > Right-most entries are preferred: + > + > $ SUBDIR="$(pwd)/sub" + > $ export BUILD_PATH_PREFIX_MAP="\$LEFT=$SUBDIR:$BUILD_PATH_PREFIX_MAP" + > $ echo $SUBDIR + > $TESTCASE_ROOT/sub + > $ export BUILD_PATH_PREFIX_MAP="$BUILD_PATH_PREFIX_MAP:\$RIGHT=$SUBDIR" + > $ echo $SUBDIR + > $RIGHT + > + > Inspecting the `$BUILD_PATH_PREFIX_MAP` should show no dynamic path as they are + > all replaced by their binding: + > + > $ echo $BUILD_PATH_PREFIX_MAP + > $LEFT=$RIGHT:$SPACED=$SPACED:HOME=HOME:parent-env=parent-env:/workspace_root=/workspace_root:$TESTCASE_ROOT=$TESTCASE_ROOT:$TMPDIR=$TMPDIR:$RIGHT=$RIGHT + > EOF + + $ dune runtest diff --git a/test/blackbox-tests/test-cases/pkg/install-action.t b/test/blackbox-tests/test-cases/pkg/install-action.t index 4c76930aa45..bdd73c3df56 100644 --- a/test/blackbox-tests/test-cases/pkg/install-action.t +++ b/test/blackbox-tests/test-cases/pkg/install-action.t @@ -11,8 +11,6 @@ Testing install actions $ build_pkg test foobar - $ export BUILD_PATH_PREFIX_MAP="/PKG_ROOT=test/target:$BUILD_PATH_PREFIX_MAP" - $ show_pkg_targets test /bin