diff --git a/master_changes.md b/master_changes.md index 9bd26397023..a0cd2983f97 100644 --- a/master_changes.md +++ b/master_changes.md @@ -99,6 +99,9 @@ users) * Add `sys-pkg-manager-cmd` field to store specific system package manager command paths [#5433 @rjbou] * Regenerate the environment file when a local switch is moved [#5476 @dra27 - fix #3411] * Regenerate the environment file in `opam exec` [#5476 @dra27] + * Regenerate the environment file when a local switch is moved [#5417 @dra27 - fix #3411] + * Regenerate the environment file in `opam exec` [#5417 @dra27] + * Store the exact environment in `OPAM_LAST_ENV` [#5417 @dra27 - fix #3411] ## Pin * Switch the default version when undefined from ~dev to dev [#4949 @kit-ty-kate] @@ -160,6 +163,7 @@ users) * Update repository package filename display [#5068 @rjbou] * E67: check checksums only for vcs urls [#4960 @rjbou] * E57: Enforce synopsis to always be there, restoring behaviour from opam 2.1 [#5442 @kit-ty-kate] + * W56: detection removed, since `OPAM_LAST_ENV` allows reliable reverting [#5417 @dra27] ## Repository * When several checksums are specified, instead of adding in the cache only the archive by first checksum, name by best one and link others to this archive [#4696 rjbou] diff --git a/src/client/opamCommands.ml b/src/client/opamCommands.ml index c86d987f9c8..0120d95c714 100644 --- a/src/client/opamCommands.ml +++ b/src/client/opamCommands.ml @@ -4096,6 +4096,7 @@ let clean cli = cleandir (OpamPath.Switch.build_dir root sw); cleandir (OpamPath.Switch.remove_dir root sw); cleandir (OpamPath.Switch.extra_files_dir root sw); + cleandir (OpamPath.Switch.last_env root sw); let pinning_overlay_dirs = List.map (fun nv -> OpamPath.Switch.Overlay.package root sw nv.name) diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index d807c08a353..9b6b2e6c130 100644 --- a/src/client/opamConfigCommand.ml +++ b/src/client/opamConfigCommand.ml @@ -189,7 +189,7 @@ let print_eval_env ~csh ~sexp ~fish ~pwsh ~cmd env = else print_env env -let regenerate_env ?(base=[]) ~set_opamroot ~set_opamswitch ~force_path +let regenerate_env ~set_opamroot ~set_opamswitch ~force_path gt switch env_file = OpamSwitchState.with_ `Lock_none ~switch gt @@ fun st -> let upd = @@ -200,18 +200,20 @@ let regenerate_env ?(base=[]) ~set_opamroot ~set_opamswitch ~force_path OpamSwitchState.with_write_lock st @@ fun st -> (OpamFile.Environment.write env_file upd), st in OpamSwitchState.drop st); - OpamEnv.add base upd + upd -let load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path +let load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path gt switch env_file = let upd = - OpamEnv.get_opam_raw ?base ~set_opamroot ~set_opamswitch ~force_path + OpamEnv.get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path gt.root switch in let environment_opam_switch_prefix = - List.find_opt (function "OPAM_SWITCH_PREFIX", _, _ -> true | _ -> false) - (upd :> (string * string * string option) list) - |> OpamStd.Option.map_default (fun (_, v, _) -> v) "" + List.find_opt (function + | "OPAM_SWITCH_PREFIX", OpamParserTypes.Eq, _, _ -> true + | _ -> false) + upd + |> OpamStd.Option.map_default (fun (_, _, v, _) -> v) "" in let actual_opam_switch_prefix = OpamFilename.Dir.to_string (OpamPath.Switch.root gt.root switch) @@ -224,16 +226,64 @@ let load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path gt switch env_file) else upd -let ensure_env_aux ?base ?(set_opamroot=false) ?(set_opamswitch=false) +(* Returns [Some file] where [file] contains [updates]. [hash] should be + [OpamEnv.hash_env_updates updates] and [n] should initially be [0]. If for + whatever reason the file cannot be created, returns [None]. *) +let write_last_env_file gt switch updates = + let temp_dir = OpamPath.Switch.last_env gt.root switch in + let hash = OpamEnv.hash_env_updates updates in + let rec aux n = + (* The principal aim here is not to spam /tmp with gazillions of files, but + also to be sure that the file present has the correct content. [n] is used + to avoid content collisions. If an existing file is used, it is touched as + this is used on Windows to allow garbage collection. *) + let trial = "env-" ^ hash ^ "-" ^ string_of_int n in + let target = OpamFilename.Op.(temp_dir // trial) in + if OpamFilename.exists target then + (* File already exists - check its content *) + let target_hash = + OpamFile.make target + |> OpamFile.Environment.read_opt + |> Option.map OpamEnv.hash_env_updates + in + if target_hash = Some hash then Some target else + (* Content collision/corruption, so try with higher [n] *) + aux (succ n) + else + try + (* Environment files are written atomically *) + OpamFile.Environment.write (OpamFile.make target) updates; + (* File should now exist with the correct content *) + aux n + with e -> OpamStd.Exn.fatal e; None + in + aux 0 + +let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false) ?(force_path=true) gt switch = let env_file = OpamPath.Switch.environment gt.root switch in - if OpamFile.exists env_file then - load_and_verify_env ?base ~set_opamroot ~set_opamswitch ~force_path - gt switch env_file - else - (log "Missing environment file, regenerate it"; - regenerate_env ?base ~set_opamroot ~set_opamswitch ~force_path - gt switch env_file) + let updates = + if OpamFile.exists env_file then + load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path + gt switch env_file + else begin + log "Missing environment file, regenerate it"; + regenerate_env ~set_opamroot ~set_opamswitch ~force_path + gt switch env_file + end + in + let updates = + List.filter (function ("OPAM_LAST_ENV", _, _, _) -> false | _ -> true) + updates + in + let last_env_file = write_last_env_file gt switch updates in + let updates = + OpamStd.Option.map_default (fun target -> + ("OPAM_LAST_ENV", OpamParserTypes.Eq, OpamFilename.to_string target, None) + ::updates) + updates last_env_file + in + OpamEnv.add base updates let ensure_env gt switch = ignore (ensure_env_aux gt switch) diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 03611c8e8f2..54701b9426d 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -543,7 +543,8 @@ module Pinned_legacy = struct end -(** Cached environment updates (/.opam-switch/environment) *) +(** Cached environment updates (/.opam-switch/environment + /.opam-switch/last-env/env-* last env files) *) module Environment = LineFile(struct diff --git a/src/format/opamPath.ml b/src/format/opamPath.ml index 68aea0b63ff..cefd503cc2b 100644 --- a/src/format/opamPath.ml +++ b/src/format/opamPath.ml @@ -140,6 +140,8 @@ module Switch = struct let environment t a = meta t a /- env_filename + let last_env t a = meta t a / "last-env" + let env_relative_to_prefix pfx = pfx / meta_dirname /- env_filename let installed_opams t a = meta t a / "packages" diff --git a/src/format/opamPath.mli b/src/format/opamPath.mli index 116ed83939a..e6b09dc6354 100644 --- a/src/format/opamPath.mli +++ b/src/format/opamPath.mli @@ -174,6 +174,8 @@ module Switch: sig (** Cached environment updates. *) val environment: t -> switch -> OpamFile.Environment.t OpamFile.t + val last_env: t -> switch -> dirname + (** Like [environment], but from the switch prefix dir *) val env_relative_to_prefix: dirname -> OpamFile.Environment.t OpamFile.t diff --git a/src/state/opamEnv.ml b/src/state/opamEnv.ml index 8913edda05c..2c3edbf4a4d 100644 --- a/src/state/opamEnv.ml +++ b/src/state/opamEnv.ml @@ -123,19 +123,33 @@ let map_update_names env_keys updates = in List.map convert updates -let global_env_keys = lazy (OpamStd.Env.Name.Set.of_list (List.map fst (OpamStd.Env.list ()))) +let global_env_keys = lazy ( + OpamStd.Env.list () + |> List.map fst + |> OpamStd.Env.Name.Set.of_list) let updates_from_previous_instance = lazy ( - match OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" with - | None -> None - | Some pfx -> - let env_file = - OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx) - in - try OpamStd.Option.map (map_update_names (Lazy.force global_env_keys)) - (OpamFile.Environment.read_opt env_file) - with e -> OpamStd.Exn.fatal e; None -) + let get_env env_file = + OpamStd.Option.map + (map_update_names (Lazy.force global_env_keys)) + (OpamFile.Environment.read_opt env_file) + in + let open OpamStd.Option.Op in + (OpamStd.Env.getopt "OPAM_LAST_ENV" + >>= fun env_file -> + try + OpamFilename.of_string env_file + |> OpamFile.make + |> get_env + with e -> OpamStd.Exn.fatal e; None) + >>+ (fun () -> + OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" + >>= fun pfx -> + let env_file = + OpamPath.Switch.env_relative_to_prefix (OpamFilename.Dir.of_string pfx) + in + try get_env env_file + with e -> OpamStd.Exn.fatal e; None)) let expand (updates: env_update list) : env = let updates = @@ -167,6 +181,19 @@ let expand (updates: env_update list) : env = | None -> defs0) updates [] in + (* OPAM_LAST_ENV and OPAM_SWITCH_PREFIX must be reverted if they were set *) + let reverts = + if OpamStd.Env.getopt "OPAM_LAST_ENV" <> None then + (OpamStd.Env.Name.of_string "OPAM_LAST_ENV", ([], []))::reverts + else + reverts + in + let reverts = + if OpamStd.Env.getopt "OPAM_SWITCH_PREFIX" <> None then + (OpamStd.Env.Name.of_string "OPAM_SWITCH_PREFIX", ([], []))::reverts + else + reverts + in (* And apply the new ones *) let rec apply_updates reverts acc = function | (var, op, arg, doc) :: updates -> @@ -299,9 +326,7 @@ let get_pure ?(updates=[]) () = let get_opam ~set_opamroot ~set_opamswitch ~force_path st = add [] (updates ~set_opamroot ~set_opamswitch ~force_path st) -let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) - ~force_path - root switch = +let get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch = let env_file = OpamPath.Switch.environment root switch in let upd = OpamFile.Environment.safe_read env_file in let upd = @@ -316,9 +341,27 @@ let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) var, to_op, v, doc | e -> e) upd in - add base - (updates_common ~set_opamroot ~set_opamswitch root switch @ - upd) + updates_common ~set_opamroot ~set_opamswitch root switch @ upd + +let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) ~force_path + root switch = + let upd = + get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch + in + add base upd + +let hash_env_updates upd = + (* Should we use OpamFile.Environment.write_to_string ? cons: it contains + tabulations *) + let to_string (name, op, value, _) = + String.escaped name + ^ OpamPrinter.FullPos.env_update_op_kind op + ^ String.escaped value + in + List.rev_map to_string upd + |> String.concat "\n" + |> Digest.string + |> Digest.to_hex let get_full ~set_opamroot ~set_opamswitch ~force_path ?updates:(u=[]) ?(scrub=[]) diff --git a/src/state/opamEnv.mli b/src/state/opamEnv.mli index 3e9c9e021d7..877eb9ec658 100644 --- a/src/state/opamEnv.mli +++ b/src/state/opamEnv.mli @@ -43,6 +43,16 @@ val get_opam_raw: force_path:bool -> dirname -> switch -> env +(** Like [get_opam_raw], but returns the list of updates instead of the new + environment. *) +val get_opam_raw_updates: + set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> + dirname -> switch -> env_update list + +(** Returns a hash of the given env_update list suitable for use with + OPAM_LAST_ENV *) +val hash_env_updates: env_update list -> string + (** Returns the running environment, with any opam modifications cleaned out, and optionally the given updates *) val get_pure: ?updates:env_update list -> unit -> env diff --git a/src/state/opamFileTools.ml b/src/state/opamFileTools.ml index 2dfbd6b4f7c..77ec09b0d63 100644 --- a/src/state/opamFileTools.ml +++ b/src/state/opamFileTools.ml @@ -650,9 +650,13 @@ let t_lint ?check_extra_files ?(check_upstream=false) ?(all=false) t = used norm) bad_os_arch_values) (bad_os_arch_values <> [])); + (* Retired, since `OPAM_LAST_ENV` allows environment updates to be reliably + reverted. *) +(* cond 56 `Warning "It is discouraged for non-compiler packages to use 'setenv:'" (t.env <> [] && not (has_flag Pkgflag_Compiler t)); +*) cond 57 `Error "Synopsis must not be empty" (match t.descr with None -> true | Some d -> String.equal (OpamFile.Descr.synopsis d) ""); diff --git a/tests/reftests/clean.test b/tests/reftests/clean.test index da14a207cfe..33d25653608 100644 --- a/tests/reftests/clean.test +++ b/tests/reftests/clean.test @@ -73,6 +73,7 @@ rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/backup"/* rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/build"/* rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/remove"/* rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/extra-files-cache"/* +rm -rf "${BASEDIR}/OPAM/clean/.opam-switch/last-env"/* ### opam clean --untracked Cleaning up switch clean Remaining directories and files: diff --git a/tests/reftests/env.test b/tests/reftests/env.test index 2a981adb8ff..04745dcfe52 100644 --- a/tests/reftests/env.test +++ b/tests/reftests/env.test @@ -106,6 +106,40 @@ NV_VARS4='': export NV_VARS4: ### opam exec -- opam env --revert | grep "NV_VARS" | ';' -> ':' NV_VARS3='/yet/another/different/path': export NV_VARS3: NV_VARS4='': export NV_VARS4: +### : Full revert of uninstalled package with setenv : +### +opam-version: "2.0" +setenv: [ FOO = "--> I'm here" ] +### opam switch create full-revert --empty +### opam install foo +The following actions will be performed: +=== install 1 package + - install foo 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> installed foo.1 +Done. +### opam exec -- sh -c "eval $(opam env | tr -d '\\r'); echo $FOO" +--> I'm here +### opam exec -- sh -c "eval $(opam env | tr -d '\\r'); opam remove foo; eval $(opam env | tr -d '\\r'); echo $FOO" +The following actions will be performed: +=== remove 1 package + - remove foo 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> removed foo.1 +Done. + +### opam install foo +The following actions will be performed: +=== install 1 package + - install foo 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> installed foo.1 +Done. +### opam exec -- sh -c "eval $(opam env | tr -d '\\r'); opam remove foo; opam env; eval $(opam env | tr -d '\\r'); opam env" | grep "FOO" +FOO=''; export FOO; ### : root and switch with spaces : ### RT="$BASEDIR/root 2" ### SW="switch w spaces" @@ -150,37 +184,45 @@ Switch invariant: ["av"] Done. ### # switch switch ### opam switch switch1 -### opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/environment in 0.000s +FILE(environment) Wrote ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 atomically in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch1/lib': export A_VAR: -### opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch1/lib': export A_VAR: ### # missing environment file ### rm $OPAMROOT/switch1/.opam-switch/environment -### opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env CONFIG Missing environment file, regenerate it STATE LOAD-SWITCH-STATE @ switch1 STATE Switch state loaded in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch1/lib': export A_VAR: -### opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env CONFIG Missing environment file, regenerate it STATE LOAD-SWITCH-STATE @ switch1 STATE Switch state loaded in 0.000s FILE(environment) Wrote ${BASEDIR}/OPAM/switch1/.opam-switch/environment atomically in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch1/lib': export A_VAR: ### # set via OPAMSWITCH -### OPAMSWITCH=switch2 opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### OPAMSWITCH=switch2 opam env --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/OPAM/switch2/.opam-switch/environment in 0.000s +FILE(environment) Wrote ${BASEDIR}/OPAM/switch2/.opam-switch/last-env/env-hash-0 atomically in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch2/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch2/lib': export A_VAR: -### OPAMSWITCH=switch2 opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | ';' -> ':' +### OPAMSWITCH=switch2 opam env --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/OPAM/switch2/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch2/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/OPAM/switch2/lib': export A_VAR: ### # entering directory ### mkdir local-sw @@ -192,25 +234,30 @@ Switch invariant: ["av"] <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> -> installed av.1 Done. -### sh -c "cd local-sw ; opam env --readonly --debug-level=-3" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' +### sh -c "cd local-sw ; opam env --readonly --debug-level=-3" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/local-sw/_opam/.opam-switch/environment in 0.000s +FILE(environment) Wrote ${BASEDIR}/local-sw/_opam/.opam-switch/last-env/env-hash-0 atomically in 0.000s +FILE(environment) Read ${BASEDIR}/local-sw/_opam/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/local-sw/_opam/lib': export A_VAR: -### sh -c "cd local-sw ; opam env --debug-level=-3" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' +### sh -c "cd local-sw ; opam env --debug-level=-3" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/local-sw/_opam/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/local-sw/_opam/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/local-sw/_opam/lib': export A_VAR: ### # moving a switch ### mv local-sw local-sw.new -### opam env --switch ./local-sw.new --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' +### opam env --switch ./local-sw.new --readonly --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/environment in 0.000s CONFIG Switch has moved from ${BASEDIR}/local-sw/_opam to ${BASEDIR}/local-sw.new/_opam CONFIG Regenerating environment file STATE LOAD-SWITCH-STATE @ ${BASEDIR}/local-sw.new STATE Switch state loaded in 0.000s +FILE(environment) Wrote ${BASEDIR}/local-sw.new/_opam/.opam-switch/last-env/env-hash-0 atomically in 0.000s +FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/local-sw.new/_opam/lib': export A_VAR: -### opam env --switch ./local-sw.new --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' +### opam env --switch ./local-sw.new --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/environment in 0.000s CONFIG Switch has moved from ${BASEDIR}/local-sw/_opam to ${BASEDIR}/local-sw.new/_opam @@ -218,27 +265,33 @@ CONFIG Regenerating environment file STATE LOAD-SWITCH-STATE @ ${BASEDIR}/local-sw.new STATE Switch state loaded in 0.000s FILE(environment) Wrote ${BASEDIR}/local-sw.new/_opam/.opam-switch/environment atomically in 0.000s +FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/local-sw.new/_opam/lib': export A_VAR: -### opam env --switch ./local-sw.new --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' +### opam env --switch ./local-sw.new --debug-level=-3 | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | '[0-9a-f]{32}' -> 'hash' | "\(\\\\\|/\)_opam\(\\\\|/\)lib" -> '/_opam/lib' | ';' -> ':' CONFIG config-env FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/local-sw.new/_opam/.opam-switch/last-env/env-hash-0 in 0.000s A_VAR='${BASEDIR}/local-sw.new/_opam/lib': export A_VAR: ### : opam exec & environment regeneration : -### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | ';' -> ':' +### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-exec command=sh -c echo $A_VAR FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s ### rm $OPAMROOT/switch1/.opam-switch/environment -### opam exec --readonly --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | ';' -> ':' +### opam exec --readonly --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-exec command=sh -c echo $A_VAR CONFIG Missing environment file, regenerate it STATE LOAD-SWITCH-STATE @ switch1 STATE Switch state loaded in 0.000s -### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | ';' -> ':' +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s +### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-exec command=sh -c echo $A_VAR CONFIG Missing environment file, regenerate it STATE LOAD-SWITCH-STATE @ switch1 STATE Switch state loaded in 0.000s FILE(environment) Wrote ${BASEDIR}/OPAM/switch1/.opam-switch/environment atomically in 0.000s -### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | ';' -> ':' +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s +### opam exec --debug-level=-3 -- sh -c "echo $A_VAR" | grep "A_VAR\|FILE\\(environment\\)\|CONFIG\|^STATE" | grep -v PROC | '[0-9a-f]{32}' -> 'hash' | ';' -> ':' CONFIG config-exec command=sh -c echo $A_VAR FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/environment in 0.000s +FILE(environment) Read ${BASEDIR}/OPAM/switch1/.opam-switch/last-env/env-hash-0 in 0.000s diff --git a/tests/reftests/lint.test b/tests/reftests/lint.test index d75caf09531..ebee8f18892 100644 --- a/tests/reftests/lint.test +++ b/tests/reftests/lint.test @@ -579,21 +579,6 @@ depexts: ["foo"] { arch = "i486" } ${BASEDIR}/lint.opam: Errors. error 55: Non-normalised OS or arch string being tested: "i486 (use x86_32 instead)" # Return code 1 # -### : W56: It is discouraged for non-compiler packages to use 'setenv:' -### -opam-version: "2.0" -synopsis: "A word" -description: "Two words." -authors: "the testing team" -homepage: "egapemoh" -maintainer: "maint@tain.er" -license: "ISC" -dev-repo: "hg+https://to@li.nt" -bug-reports: "https://nobug" -setenv: [ idoit="anyway" ] -### opam lint ./lint.opam -${BASEDIR}/lint.opam: Warnings. - warning 56: It is discouraged for non-compiler packages to use 'setenv:' ### : E57: Synopsis must not be empty ### opam-version: "2.0"