diff --git a/doc/pages/Manual.md b/doc/pages/Manual.md index 02c21d10999..adf404a8d95 100644 --- a/doc/pages/Manual.md +++ b/doc/pages/Manual.md @@ -639,8 +639,7 @@ Some fields define updates to environment variables in the form: The allowed update operators `update-op` denote how the string is applied to the environment variable. Prepend and append operators assume list of elements -separated by an OS-specific character (`;` on Windows, `:` on Cygwin or any -other system). +separated by an OS-specific character. - `=` override (or set if undefined) - `+=` or `:=` prepend. They differ when the variable is unset of empty, where `:=` adds a trailing separator. - `=+` or `=:` append. They differ when the variable is unset of empty, where `=:` adds a leading separator. @@ -652,6 +651,59 @@ other system). `FOO += ""`, `FOO := ""`, etc. are all ignored - i.e. opam never adds empty segments to an existing variable. +#### Environment update portability + + +Some fields define an environment update portability specification. In the opam +file it is the [`x-env-path-rewrite:`](#opamfield-x-env-path-rewrite) field, of the +form: + +```BNF + ::= { }* + ::= + | + + ::= "|" + | ( ) + | { { }* } + ::= "|" + | ( ) + | { { }* } + + ::= (") ":" (") | (") ";" (") + ::= (") "host" (") | (") "host-quoted" (") | (") "target" (") | (") "target-quoted" (") + + ::= + | "!" + | "(" ")" + ::= "&" | "|" +``` + +The `` defines the path separator to use for the variable. +The `` defines the way to handle variables path formatting: +- host: use the *host* interpretation of PATHs (i.e. convert via `cygpath` on + Windows). +- host-quoted: use the *host* interpretation of entries and double-quote any + entries which include the separator character. +- target: use the *target* interpretation of entries (i.e. rewrite slashes to + backslashes on Windows). +- target-quoted: use the *target* interpretation of entries and double-quote + any entries which include the separator character. + +If a variable is not mentioned in `x-env-path-rewrite`, the separator is assumed to be `;` on Windows and `:` on all other systems; no slash or quoting transformations are performed. There are two special default cases: +* `PKG_CONFIG_PATH` uses `:` separator and is `target-quoted` +* `PATH` on Windows uses `;` separator and is `target-quoted` + +For example, on Windows: +- `[FOO false]`: `FOO` won't be translated nor rewritten, and default separator is used if needed +- `[FOO true]`: `FOO` is rewritten using defaults `;` and `target` with slash rewriting + - `FOO = "a:/path/to"` -> FOO=a:\path\to +- `[FOO ":" "target-quoted"]: `FOO` will be appended using `:` separator, if the added path contains '/' they are transformed into `\`, and if the added path contains a `:`, the added path will be quoted + - `FOO += "a/path/to"` -> FOO=a\path\to:R:\previous\path + - `FOO += "a:path/to"` -> FOO="a:path\to":R:\previous\path +- `[FOO ":" "host"]: `FOO` will be appended using `:`, and its path will be translated according to the host translator, i.e. `cygpath `: + - `FOO += "A:\path\to"` -> FOO=/cygdrive/a/path/to:/previous/path + ### URLs URLs are provided as strings. They can refer to: @@ -1124,6 +1176,9 @@ files. - `OPAMCLI=2.0` (since opam 2.1) - `TMP` and `TMPDIR` are set by the sandbox script (bubblewrap), but should not be relied on since the sandbox is not used on all platforms and can be disabled by the user. + See [`x-env-path-rewrite:`](#opamfield-x-env-path-rewrite) + for path portability of environment variables on Windows. + - `extra-source "{" "}"`: allows the definition of extra files that need downloading into the source tree before the package can be patched (if necessary) and built. The format is @@ -1132,6 +1187,9 @@ files. `` indicates the name the file should be saved to, and is relative to the root of the source tree. + See [`x-env-path-rewrite:`](#opamfield-x-env-path-rewrite) + for path portability of environment variables on Windows. + - `extra-files: [ [ ] ... ]`: optionally lists the files below `files/` with their checksums. Used internally for integrity verifications. @@ -1152,6 +1210,11 @@ files. has changed. Even then, this won't unpin any packages that would have been removed from `pin-depends:`. +- `x-env-path-rewrite: [ ... ]`: + a specific extra field, used to specify rewrite rules for environment variables + defined in [`setenv:`](#opamfield-setenv) and [`build-env`](#opamfield-build-env). + See [`environment update portability`](#env-update-rewrite) for syntax. + - `x-*: `: extra fields prefixed with `x-` can be defined for use by external tools. opam will ignore them except for some search operations. diff --git a/master_changes.md b/master_changes.md index 8305bea912c..b25cff23855 100644 --- a/master_changes.md +++ b/master_changes.md @@ -28,6 +28,7 @@ users) * [BUG] On install driven by `.install` file, track intermediate directories too, in order to have them suppressed at package removal [#5691 @rjbou - fix #5688] * [BUG] With `--assume-built`, resolve variables in depends filter according switch & global environment, not only depends predefined variables [#570 @rjbou - fix #5698] * [BUG] Handle undefined variables defaults to false in dependencies formula resolution for assume built [#5701 rjbou] + * Reinstall if `x-env-path-rewrite` is updated [#5636 @rjbou] ## Remove @@ -64,8 +65,13 @@ users) ## Clean +## Env + * When computing environment variables updates, use rewriting rules (defined in opam file, or default per variable) to split, join, quote, etc. [#5636 @rjbou - fix #5602 #4690 #2927] + ## Opamfile * Update populating extra-files fields log [#5640 @rjbou] + * Fix `x-locked` type error message [#5636 @rjbou] + * Add `x-env-path-rewrite` extensions field to permit specification of rewriting rules for variables defined in `setenv` and `build-env`: no rewrite; separator and path format formulae [#5636 @rjbou - fix #5602 #4690 #2927] ## External dependencies @@ -104,6 +110,7 @@ users) ## Shell ## Internal + * `environment` file now stores environmnet variable rewriting rules [#5636 @rjbou] ## Internal: Windows * Fix sporadic crash and segfault in shell detection (seen in native containers) [#5714 @dra27] @@ -123,6 +130,7 @@ users) * dot-install: add a test for removal of non specified in .install empty directories [#5701 @rjbou] * Add test in assume-built for depends with switch variable filters [#5700 @rjbou] * Add undefined variable handling in assume built test [#5701 @rjbou] + * Add `env.unix` & `env.win32` to test environment variables rewriting rules [#5636 @rjbou] ### Engine * With real path resolved for all opam temp dir, remove `/private` from mac temp dir regexp [#5654 @rjbou] @@ -138,6 +146,7 @@ users) ## Doc * Fix typos in readme [#5706 @MisterDA] * Fix formatting in the Manual [#5708 @kit-ty-kate] + * Add `x-env-path-rewriting` documentation [#5636 @rjbou] ## Security fixes @@ -151,13 +160,31 @@ users) ## opam-solver -## opam-format ## opam-format * `OpamFilter`: add `expand_interpolations_in_file_full` which allows setting the output file along with the input file [#5629 @rgrinberg] * `OpamFilter`: expose `string_interp_regex` which allows clients to identify variable interpolations in strings [#5633 @gridbugs] + * `OpamTypes.env_update`: change from tuple to a record [#5636 @rjbou] + * `OpamTypesBase`: add `env_update`, `env_update_resolved`, and `env_update_unresolved` builders [#5636 @rjbou] + * `OpamTypes.env_update`: add a `rewrite` field, that contains environment variable rewriting rules (formula to resolved, or already resolved, or no rewriting) [#5636 @rjbou] + * `OpamPp.fallback`: add name concatenation and printing fallback too [#5636 @rjbou] + * `OpamFormat`: add `formula_items` to permit definition of formulae pp not only of the type `package-formula` [#5636 @rjbou] + * `OpamTypesBase`: add to_string function for `path_format` & `separator` [#5636 @rjbou] + * `OpamFormat.V`: add `path_format` & `separator` value parser printer [#5636 @rjbou] + * `OpamFile.OPAM`: add handling of `x-env-path-rewrite` extensions field, that specifies rewrite rules [#5636 @rjbou] + * `OpamFile.Environment`: add parsing-printing of rewriting rules, keeping backward compatibility [#5636 @rjbou] + * `OpamFile.OPAM`: `effective_part` keeps `x-env-path-rewrite`, affects also `effectively_equal` [#5636 @rjbou] + * `OpamTypesBase`: add `env_update_resolved` and `env_update_unresolved` builders [#5636 @rjbou] + * `OpamPp.fallback`: add name concatenation and printing fallback too [#5636 @rjbou] + * `OpamFormat`: add `formula_items` to permit definition of formulae pp not only of the type `package-formula` [#5636 @rjbou] + * `OpamTypesBase`: add to_string function for `path_format` & `separator` [#5636 @rjbou] + * `OpamFormat.V`: add `path_format` & `separator` value parser printer [#5636 @rjbou] + * `OpamFile.OPAM`: add handling of `x-env-path-rewrite` extensions field, that specifies rewrite rules [#5636 @rjbou] + * `OpamFile.Environment`: add parsing-printing of rewriting rules, keeping backward compatibility [#5636 @rjbou] + * `OpamFile.OPAM`: `effective_part` keeps `x-env-path-rewrite`, affects also `effectively_equal` [#5636 @rjbou] ## opam-core * `OpamSystem.mk_temp_dir`: resolve real path with `OpamSystem.real_path` before returning it [#5654 @rjbou] * `OpamSystem.resolve_command`: in command resolution path, check that the file is not a directory and that it is a regular file [#5606 @rjbou - fix #5585 #5597 #5650 #5626] * `OpamStd.Config.env_level`: fix level parsing, it was inverted (eg, "no" gives level 1, and "yes" level 0) [#5686 @smorimoto] * `OpamStd.Sys.chop_exe_suffix`: removes `.exe` from the end of a path, if present + * `OpamSystem.get_cygpath_path_transform`: add labeled argument to specify if path is a pathlist [#5636 @rjbou] diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 2b077553838..150633cc094 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -522,30 +522,61 @@ let prepare_package_source st nv dir = let compilation_env t opam = let open OpamParserTypes in let build_env = - List.map (OpamEnv.env_expansion ~opam t) (OpamFile.OPAM.build_env opam) + List.map + (fun env -> + OpamEnv.resolve_separator_and_format + (OpamEnv.env_expansion ~opam t env)) + (OpamFile.OPAM.build_env opam) in let cygwin_env = match OpamSysInteract.Cygwin.cygbin_opt t.switch_global.config with | Some cygbin -> - [ "PATH", EqPlus, OpamFilename.Dir.to_string cygbin, Some "Cygwin path" ] + [ OpamTypesBase.env_update_resolved "PATH" EqPlus + (OpamFilename.Dir.to_string cygbin) + ~comment:"Cygwin path" + ] | None -> [] in + let shell_sanitization = "shell env sanitization" in + let build_env_def = "build environment definition" in + let cdpath = + OpamTypesBase.env_update_resolved "CDPATH" Eq "" + ~comment:shell_sanitization + in + let makeflags = + OpamTypesBase.env_update_resolved "MAKEFLAGS" Eq "" + ~comment:shell_sanitization + in + let makelevel = + OpamTypesBase.env_update_resolved "MAKELEVEL" Eq "" + ~comment:"make env sanitization" + in + let pkg_name = + OpamTypesBase.env_update_resolved "OPAM_PACKAGE_NAME" Eq + (OpamPackage.Name.to_string (OpamFile.OPAM.name opam)) + ~comment:build_env_def + in + let pkg_version = + OpamTypesBase.env_update_resolved "OPAM_PACKAGE_VERSION" Eq + (OpamPackage.Version.to_string (OpamFile.OPAM.version opam)) + ~comment:build_env_def + in + let cli = + OpamTypesBase.env_update_resolved "OPAMCLI" Eq "2.0" + ~comment:"opam CLI version" + in let scrub = OpamClientConfig.(!r.scrubbed_environment_variables) in OpamEnv.get_full ~scrub ~set_opamroot:true ~set_opamswitch:true ~force_path:true t ~updates:([ - "CDPATH", Eq, "", Some "shell env sanitization"; - "MAKEFLAGS", Eq, "", Some "make env sanitization"; - "MAKELEVEL", Eq, "", Some "make env sanitization"; - "OPAM_PACKAGE_NAME", Eq, - OpamPackage.Name.to_string (OpamFile.OPAM.name opam), - Some "build environment definition"; - "OPAM_PACKAGE_VERSION", Eq, - OpamPackage.Version.to_string (OpamFile.OPAM.version opam), - Some "build environment definition"; - "OPAMCLI", Eq, "2.0", Some "opam CLI version"; - ] @ - build_env - @ cygwin_env) + cdpath; + makeflags; + makelevel; + pkg_name; + pkg_version; + cli + ] @ + build_env + @ cygwin_env) let installed_opam_opt st nv = OpamStd.Option.Op.( diff --git a/src/client/opamAdminRepoUpgrade.ml b/src/client/opamAdminRepoUpgrade.ml index 5ce06fafb4d..84a12fae7f2 100644 --- a/src/client/opamAdminRepoUpgrade.ml +++ b/src/client/opamAdminRepoUpgrade.ml @@ -366,12 +366,16 @@ let do_upgrade repo_root = None ] |> O.with_maintainer [ "platform@lists.ocaml.org" ] |> - O.with_build_env ["CAML_LD_LIBRARY_PATH", Eq, "", None] |> - O.with_env [ - "CAML_LD_LIBRARY_PATH", Eq, "%{_:stubsdir}%", None; - "CAML_LD_LIBRARY_PATH", PlusEq, "%{lib}%/stublibs", None; - "OCAML_TOPLEVEL_PATH", Eq, "%{toplevel}%", None; + O.with_build_env [ + OpamTypesBase.env_update_unresolved "CAML_LD_LIBRARY_PATH" Eq "" ] |> + O.with_env [ + OpamTypesBase.env_update_unresolved "CAML_LD_LIBRARY_PATH" Eq + "%{_:stubsdir}%"; + OpamTypesBase.env_update_unresolved "CAML_LD_LIBRARY_PATH" PlusEq + "%{lib}%/stublibs"; + OpamTypesBase.env_update_unresolved "OCAML_TOPLEVEL_PATH" Eq + "%{toplevel}%" ] |> (* leave the Compiler flag to the implementations (since the user needs to select one) O.with_flags [Pkgflag_Compiler] |> *) diff --git a/src/client/opamCliMain.ml b/src/client/opamCliMain.ml index fa0a60da9fc..121cb2e3c37 100644 --- a/src/client/opamCliMain.ml +++ b/src/client/opamCliMain.ml @@ -206,10 +206,10 @@ let check_and_run_external_commands () = in let env = if has_init then - let updates = - ["PATH", OpamParserTypes.PlusEq, - OpamFilename.Dir.to_string plugins_bin, None] - in + let updates = [ + env_update_resolved "PATH" PlusEq + (OpamFilename.Dir.to_string plugins_bin) + ] in OpamStateConfig.init ~root_dir (); match OpamStateConfig.get_switch_opt () with | None -> env_array (OpamEnv.get_pure ~updates ()) diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index 7d9f71f0ade..87b44c1fd83 100644 --- a/src/client/opamConfigCommand.ml +++ b/src/client/opamConfigCommand.ml @@ -63,7 +63,8 @@ let list t ns = OpamConsole.print_table stdout ~sep:" " let possibly_unix_path_env_value k v = - if k = "PATH" then (Lazy.force OpamSystem.get_cygpath_path_transform) v + if k = "PATH" then + (Lazy.force OpamSystem.get_cygpath_path_transform) ~pathlist:true v else v let rec print_env = function @@ -209,11 +210,14 @@ let load_and_verify_env ~set_opamroot ~set_opamswitch ~force_path gt.root switch in let environment_opam_switch_prefix = - List.find_opt (function - | "OPAM_SWITCH_PREFIX", OpamParserTypes.Eq, _, _ -> true - | _ -> false) + OpamStd.List.find_map_opt (function + | OpamTypes.{ envu_var = "OPAM_SWITCH_PREFIX"; + envu_op = OpamParserTypes.Eq; + envu_value; _} -> + Some envu_value + | _ -> None) upd - |> OpamStd.Option.map_default (fun (_, _, v, _) -> v) "" + |> OpamStd.Option.default "" in let actual_opam_switch_prefix = OpamFilename.Dir.to_string (OpamPath.Switch.root gt.root switch) @@ -272,14 +276,17 @@ let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false) gt switch env_file end in + let open OpamTypes in let updates = - List.filter (function ("OPAM_LAST_ENV", _, _, _) -> false | _ -> true) + List.filter (fun upd -> + not (String.equal upd.envu_var "OPAM_LAST_ENV")) 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) + (env_update_resolved "OPAM_LAST_ENV" Eq + (OpamFilename.to_string target)) ::updates) updates last_env_file in @@ -638,10 +645,21 @@ let switch_allowed_fields, switch_allowed_sections = ("setenv", Modifiable ( (fun nc c -> { c with env = nc.env @ c.env }), (fun nc c -> + let open OpamTypes in let env = - List.filter (fun (vr,op,vl,_) -> - None = OpamStd.List.find_opt (fun (vr',op',vl',_) -> - vr = vr' && op = op' && vl = vl') nc.env) c.env + List.filter + (fun { envu_var = var; envu_op = op; + envu_value = value; envu_comment = _; + envu_rewrite = _ } -> + None = + OpamStd.List.find_opt + (fun { envu_var = var'; envu_op = op'; + envu_value = value'; envu_comment = _; + envu_rewrite = _ } -> + String.equal var var' + && (op : OpamParserTypes.env_update_op) = op' + && String.equal value value') + nc.env) c.env in { c with env })), fun t -> { t with env = empty.env }); diff --git a/src/core/opamSystem.ml b/src/core/opamSystem.ml index bb3f6924afc..146516a95ab 100644 --- a/src/core/opamSystem.ml +++ b/src/core/opamSystem.ml @@ -548,10 +548,12 @@ let get_cygpath_function = let f = Lazy.from_val (fun x -> x) in fun ~command:_ -> f -let apply_cygpath_path_transform path = +let apply_cygpath_path_transform ~pathlist path = + let args = if pathlist then [ "--path" ] else [] in let r = OpamProcess.run - (OpamProcess.command ~name:(temp_file "command") ~verbose:false "cygpath" ["--path"; "--"; path]) + (OpamProcess.command ~name:(temp_file "command") + ~verbose:false "cygpath" (args @ ["--"; path])) in OpamProcess.cleanup ~force:true r; if OpamProcess.is_success r then @@ -566,9 +568,9 @@ let get_cygpath_path_transform = lazy ( match resolve_command "cygpath" with | Some _ -> apply_cygpath_path_transform - | None -> fun x -> x) + | None -> fun ~pathlist:_ x -> x) else - Lazy.from_val (fun x -> x) + Lazy.from_val (fun ~pathlist:_ x -> x) let runs = ref [] let print_stats () = diff --git a/src/core/opamSystem.mli b/src/core/opamSystem.mli index 92e1c46b1ee..0ae01338079 100644 --- a/src/core/opamSystem.mli +++ b/src/core/opamSystem.mli @@ -190,11 +190,14 @@ val resolve_command: ?env:string array -> ?dir:string -> string -> string option the identity function otherwise. *) val get_cygpath_function: command:string -> (string -> string) lazy_t -(** Returns a function which should be applied to a PATH environment variable - if in a functioning Cygwin or MSYS2 environment, translating the Windows or a - Unix PATH variable into a Unix PATH variable. Returns the identity function - otherwise. *) -val get_cygpath_path_transform: (string -> string) lazy_t +(** Returns a function which should be applied to a path (or a path list), if + in a functioning Cygwin or MSYS2 environment, translating the Windows or a + Unix path into a Unix path, by calling `cygpath`. Returns the identity + function + otherwise. + [pathlist] argument permit to specify if it is applied to a path or a path + list, by giving the `--path` argument in the last case. *) +val get_cygpath_path_transform: (pathlist:bool -> string -> string) lazy_t (** [command cmd] executes the command [cmd] in the correct OPAM environment. *) diff --git a/src/format/opamFile.ml b/src/format/opamFile.ml index 54701b9426d..b3f27154cf2 100644 --- a/src/format/opamFile.ml +++ b/src/format/opamFile.ml @@ -551,26 +551,157 @@ module Environment = LineFile(struct let internal = "environment" let atomic = true - type t = env_update list + type t = spf_resolved env_update list let empty = [] + type optional_parts = [ + | `comment of string + | `format of separator * path_format + | `norewrite + | `comment_format of string * separator * path_format + | `comment_norewrite of string + ] + let pp = - (OpamFormat.lines_set ~empty:[] ~add:OpamStd.List.cons ~fold:List.fold_right @@ - Pp.identity ^+ - Pp.of_pair "env_update_op" - (OpamLexer.FullPos.env_update_op, OpamPrinter.env_update_op_kind) ^+ - Pp.identity ^+ - Pp.opt Pp.singleton) + let path_format : (string, path_format) Pp.t = + Pp.of_pair "path-format" + ((function + | "host" -> Host + | "target" -> Target + | "target-quoted" -> Target_quoted + | "host-quoted" -> Host_quoted + | _ -> Pp.unexpected ()), + OpamTypesBase.string_of_path_format) + in + let separator : (string, separator) Pp.t = + Pp.of_pair "separator" + ((function + | ":" -> SColon + | ";" -> SSemiColon + | _ -> Pp.unexpected ()), + (fun sep -> String.make 1 (char_of_separator sep))) + in + let env : (string, env_update_op_kind) Pp.t = + (Pp.of_pair "env_update_op" + (OpamLexer.FullPos.env_update_op, OpamPrinter.env_update_op_kind)) + in + let failparse name = failwith (Printf.sprintf "parse <%s>" name) in + let failprint name = failwith (Printf.sprintf "print <%s>" name) in + let norewrite: (string, [ `norewrite ]) Pp.t = + let name = "norewrite" in + Pp.of_pair name + ((function "norewrite" -> `norewrite | _ -> failparse name), + (function `norewrite -> "norewrite" )) + in + let comment_and_sepformat : (string list, optional_parts) Pp.t = + (separator ^+ path_format ^+ (Pp.last -| Pp.identity)) + -| (let name = "separator-pathi-format-comment" in + Pp.of_pair name + ((fun (sep, (fmt, comment)) -> + `comment_format (comment, sep, fmt)), + (function + | `comment_format (comment, sep, fmt) -> sep, (fmt, comment) + | _ -> failprint name))) + in + let comment_and_norewrite : (string list, optional_parts) Pp.t = + (norewrite ^+ (Pp.last -| Pp.identity)) + -| (let name = "norewrite-comment" in + Pp.of_pair name + ((fun (`norewrite, comment) -> + `comment_norewrite comment), + (function + | `comment_norewrite comment -> `norewrite, comment + | _ -> failprint name))) + in + let only_comment : (string list, optional_parts) Pp.t = + Pp.singleton + -| (let name = "only-comment" in + Pp.of_pair name + ((fun x -> `comment x), + (function `comment x -> x | _ -> failprint name))) + in + let only_format : (string list, optional_parts) Pp.t = + (separator ^+ (Pp.last -| path_format)) + -| (let name = "only-path-format" in + Pp.of_pair name + ((fun sh -> `format sh), + (function `format sh -> sh | _ -> failprint name))) + in + let only_norewrite : (string list, optional_parts) Pp.t = + Pp.last -| norewrite + -| (let name = "only-norewrite" in + Pp.of_pair name + ((function `norewrite -> `norewrite), + (function `norewrite -> `norewrite | _ -> failprint name))) + in + let optional_parts : (string list, optional_parts option) Pp.t = + Pp.opt + @@ Pp.fallback comment_and_sepformat + @@ Pp.fallback comment_and_norewrite + @@ Pp.fallback only_norewrite + @@ Pp.fallback only_format only_comment + in + (OpamFormat.lines_set ~empty:[] ~add:OpamStd.List.cons + ~fold:List.fold_right + @@ (Pp.identity + ^+ env + ^+ Pp.identity + ^+ optional_parts)) -| Pp.pp (fun ~pos:_ -> List.rev) List.rev let pp = - pp -| - Pp.map_list - (Pp.pp - (fun ~pos:_ (a, (b, (c, d))) -> (a, b, c, d)) - (fun (a, b, c, d) -> (a, (b, (c, d))))) + pp -| + Pp.map_list + (Pp.pp + (fun ~pos:_ (envu_var, (envu_op, (envu_value, optional_parts))) -> + let envu = { + envu_var; envu_op; envu_value; envu_comment = None; + envu_rewrite = Some (SPF_Resolved None); + } in + match optional_parts with + | None -> envu + | Some (`comment_format (comment, sep, fmt)) -> + { envu with + envu_comment = Some comment; + envu_rewrite = Some (SPF_Resolved (Some (sep, fmt))); + } + | Some (`comment comment) -> + { envu with + envu_comment = Some comment; + } + | Some (`format (sep, fmt)) -> + { envu with + envu_rewrite = Some (SPF_Resolved (Some (sep, fmt))); + } + | Some `norewrite -> + { envu with + envu_rewrite = None; + } + | Some (`comment_norewrite comment) -> + { envu with + envu_comment = Some comment; + envu_rewrite = None; + } + ) + (fun {envu_var; envu_op; envu_value; envu_comment; envu_rewrite} -> + let optional_parts = + match envu_comment, envu_rewrite with + | None, Some (SPF_Resolved None) -> + None + | None, Some (SPF_Resolved (Some (sep, fmt))) -> + Some (`format (sep, fmt)) + | None, None -> + Some `norewrite + | Some comment, Some (SPF_Resolved (Some (sep, fmt))) -> + Some (`comment_format (comment, sep, fmt)) + | Some comment, Some (SPF_Resolved None) -> + Some (`comment comment) + | Some comment, None -> + Some (`comment_norewrite comment) + in + (envu_var, (envu_op, (envu_value, optional_parts))))) end) @@ -1850,7 +1981,7 @@ module Switch_configSyntax = struct variables: (variable * variable_contents) list; opam_root: dirname option; wrappers: Wrappers.t; - env: env_update list; + env: spf_resolved env_update list; invariant: OpamFormula.t option; depext_bypass: OpamSysPkg.Set.t; } @@ -2402,7 +2533,7 @@ module OPAMSyntax = struct conflict_class : name list; available : filter; flags : package_flag list; - env : env_update list; + env : spf_unresolved env_update list; (* Build instructions *) build : command list; @@ -2413,7 +2544,7 @@ module OPAMSyntax = struct (* Auxiliary data affecting the build *) substs : basename list; patches : (basename * filter option) list; - build_env : env_update list; + build_env : spf_unresolved env_update list; features : (OpamVariable.t * filtered_formula * string) list; extra_sources: (basename * URL.t) list; @@ -2564,10 +2695,11 @@ module OPAMSyntax = struct let env (t:t) = List.map (fun env -> match t.name, env with - | Some name, (var,op,value,None) -> - var, op, value, - Some ("Updated by package " ^ OpamPackage.Name.to_string name) - | _, b -> b) + | Some name, { envu_comment = None; _ } -> + { env with + envu_comment = + Some ("Updated by package " ^ OpamPackage.Name.to_string name) } + | _, b -> b) t.env let build t = t.build @@ -2929,7 +3061,7 @@ module OPAMSyntax = struct Pp.V.ident -| Pp.of_pair "package-flag" (pkg_flag_of_string, string_of_pkg_flag)); "setenv", no_cleanup Pp.ppacc with_env env - (Pp.V.map_list ~depth:2 Pp.V.env_binding); + (Pp.V.map_list ~depth:2 Pp.V.env_binding_unresolved); "build", no_cleanup Pp.ppacc with_build build (Pp.V.map_list ~depth:2 Pp.V.command); @@ -2946,7 +3078,7 @@ module OPAMSyntax = struct (Pp.V.map_list ~depth:1 @@ Pp.V.map_option pp_basename (Pp.opt Pp.V.filter)); "build-env", no_cleanup Pp.ppacc with_build_env build_env - (Pp.V.map_list ~depth:2 Pp.V.env_binding); + (Pp.V.map_list ~depth:2 Pp.V.env_binding_unresolved); "features", no_cleanup Pp.ppacc with_features features (Pp.V.map_list ~depth:1 @@ Pp.V.map_options_2 @@ -3187,7 +3319,7 @@ module OPAMSyntax = struct { t with locked = Some locked } |> Pp.parse ~pos pp_constraint | Some {pos; _} -> - Pp.bad_format ~pos "Field %s must be a bool" + Pp.bad_format ~pos "Field %s must be a string" (OpamConsole.colorise `underline locked_xfield) | None -> { t with locked = None } in @@ -3203,6 +3335,63 @@ module OPAMSyntax = struct in Pp.pp parse print + let rewrite_xfield = "x-env-path-rewrite" + let handle_env_paths = + let pp = + let filtered pp = + let name = pp.Pp.ppname^"-filtered-formula" in + Pp.V.list + -| Pp.V.formula_items ~name `Disj ~only:`Or + pp Pp.V.filter + in + let rewrite pp = + pp -| + Pp.pp ~name:"-x-env-path-rewrite-formula" + (fun ~pos:_ (name,separator,path) -> name, Some (separator, path)) + (function n, Some (sep, ht) -> n, sep, ht | _ -> assert false) + in + let norewrite pp = + pp -| + Pp.pp ~name:"x-env-path-rewrite-bool" + (fun ~pos:_ (name, rewrite) -> + if rewrite then name, Some (Empty, Empty) + else name, None) + (function + | n, None -> n, false + | n, Some (Empty, Empty) -> n, true + | _ -> assert false) + in + Pp.V.map_list @@ + Pp.fallback + (norewrite @@ Pp.V.map_pair Pp.V.ident Pp.V.bool) + (rewrite @@ Pp.V.map_triple Pp.V.ident + (filtered Pp.V.separator) (filtered Pp.V.path_format)) + in + let parse ~pos t = + if OpamVersion.(compare t.opam_version (of_string "2.0") > 0) then t + else + match OpamStd.String.Map.find_opt rewrite_xfield t.extensions with + | None -> t + | Some value -> + let rewrites = Pp.parse pp value ~pos |> OpamStd.String.Map.of_list in + let update env = + List.map (fun upd -> + match OpamStd.String.Map.find_opt upd.envu_var rewrites with + | Some (Some (sep, ht)) -> + { upd with envu_rewrite = Some (SPF_Unresolved (sep, ht)) } + | Some None -> + { upd with envu_rewrite = None; } + | None -> upd) + env + in + { t with + env = update t.env; + build_env = update t.build_env; + } + in + let print t = t in (* extension field is rewritten as is *) + Pp.pp parse print + (* Doesn't handle package name encoded in directory name *) let pp_raw_fields = Pp.I.check_opam_version ~format_version () -| @@ -3223,7 +3412,8 @@ module OPAMSyntax = struct ~errmsg:"The url.subpath field is not allowed in files with \ `opam-version` <= 2.0" -| handle_subpath_2_0 -| - handle_locked + handle_locked -| + handle_env_paths let pp_raw = Pp.I.map_file @@ pp_raw_fields @@ -3386,7 +3576,11 @@ module OPAM = struct doc = empty.doc; bug_reports = empty.bug_reports; - extensions = empty.extensions; + (* We keep only `x-env-path-rewrite` as it affects build/install *) + extensions = + OpamStd.String.Map.filter (fun x _ -> String.equal rewrite_xfield x) + t.extensions; + url = OpamStd.Option.map effective_url t.url; descr = empty.descr; @@ -3790,7 +3984,7 @@ module CompSyntax = struct make : string list ; build : command list ; packages : formula ; - env : env_update list; + env : spf_unresolved env_update list; tags : string list; } @@ -3827,9 +4021,8 @@ module CompSyntax = struct let preinstalled t = t.preinstalled let env (t:t) = List.map (function - | var,op,value,None -> - var, op, value, - Some ("Updated by compiler " ^ t.name) + | { envu_comment = None; _ } as env -> + { env with envu_comment = Some ("Updated by compiler " ^ t.name) } | b -> b) t.env @@ -3892,7 +4085,7 @@ module CompSyntax = struct "packages", Pp.ppacc with_packages packages (Pp.V.package_formula `Conj (Pp.V.constraints Pp.V.version)); "env", Pp.ppacc with_env env - (Pp.V.map_list ~depth:2 Pp.V.env_binding); + (Pp.V.map_list ~depth:2 Pp.V.env_binding_unresolved); "preinstalled", Pp.ppacc_opt with_preinstalled (fun t -> if t.preinstalled then Some true else None) Pp.V.bool; diff --git a/src/format/opamFile.mli b/src/format/opamFile.mli index dd1971448a4..fb2e10c824a 100644 --- a/src/format/opamFile.mli +++ b/src/format/opamFile.mli @@ -359,7 +359,7 @@ module OPAM: sig conflict_class : name list; available : filter; flags : package_flag list; - env : env_update list; + env : spf_unresolved env_update list; (* Build instructions *) build : command list; @@ -370,7 +370,7 @@ module OPAM: sig (* Auxiliary data affecting the build *) substs : basename list; patches : (basename * filter option) list; - build_env : env_update list; + build_env : spf_unresolved env_update list; features : (OpamVariable.t * filtered_formula * string) list; extra_sources: (basename * URL.t) list; @@ -471,7 +471,7 @@ module OPAM: sig val substs: t -> basename list (** List of environment variables to set-up for the build *) - val build_env: t -> env_update list + val build_env: t -> spf_unresolved env_update list (** List of command to run for building the package *) val build: t -> command list @@ -561,7 +561,7 @@ module OPAM: sig val has_flag: package_flag -> t -> bool (** The environment variables that this package exports *) - val env: t -> env_update list + val env: t -> spf_unresolved env_update list val descr: t -> Descr.t option @@ -646,7 +646,7 @@ module OPAM: sig (** Construct as [substs] *) val with_substs: basename list -> t -> t - val with_build_env: env_update list -> t -> t + val with_build_env: spf_unresolved env_update list -> t -> t val with_available: filter -> t -> t @@ -674,7 +674,7 @@ module OPAM: sig val with_tags: string list -> t -> t - val with_env: env_update list -> t -> t + val with_env: spf_unresolved env_update list -> t -> t val with_dev_repo: url -> t -> t @@ -754,6 +754,9 @@ module OPAM: sig sections can be accessed through [section.field]. *) val print_field_as_syntax: string -> t -> value option + (** x-field name for path rewriting on windows *) + val rewrite_xfield: string + end (** Compiler aliases: [$opam/aliases]. Deprecated, used only for migration *) @@ -792,7 +795,7 @@ end module PkgList: IO_FILE with type t = package_set (** Cached environment updates (/environment) *) -module Environment: IO_FILE with type t = env_update list +module Environment: IO_FILE with type t = spf_resolved env_update list (** Compiler version [$opam/compilers/]. Deprecated, only used to upgrade old data *) @@ -805,7 +808,7 @@ module Comp: sig (** Create a pre-installed compiler description file *) val create_preinstalled: - compiler -> compiler_version -> name list -> env_update list -> t + compiler -> compiler_version -> name list -> spf_unresolved env_update list -> t (** Is it a pre-installed compiler description file *) val preinstalled: t -> bool @@ -840,7 +843,7 @@ module Comp: sig (** Environment variable to set-up before running commands in the subtree *) - val env: t -> env_update list + val env: t -> spf_unresolved env_update list val tags: t -> string list @@ -1025,7 +1028,7 @@ module Switch_config: sig variables: (variable * variable_contents) list; opam_root: dirname option; wrappers: Wrappers.t; - env: env_update list; + env: spf_resolved env_update list; invariant: OpamFormula.t option; depext_bypass: OpamSysPkg.Set.t; } diff --git a/src/format/opamFormat.ml b/src/format/opamFormat.ml index dd848585389..ef1db0a7c5a 100644 --- a/src/format/opamFormat.ml +++ b/src/format/opamFormat.ml @@ -508,19 +508,25 @@ module V = struct List.rev_append (ors_to_list f) (rev_ors_to_list e) | x -> [x] - let package_formula_items kind constraints = + let formula_items ~name kind ?only atom constraints = let split, join = match kind with | `Conj -> ands_to_list, OpamFormula.ands | `Disj -> ors_to_list, OpamFormula.ors in + let keep = match only with + | None -> fun _ -> true + | Some `And -> fun x -> not (OpamStd.Compare.equal `Or x) + | Some `Or -> fun x -> not (OpamStd.Compare.equal `And x) + in + let pp_atom = map_option atom constraints in let rec parse_formula ~pos:_ l = let rec aux v = match v.pelem with | String _ | Option (_,_) -> - Atom (parse (package_atom constraints) ~pos:v.pos v) + Atom (parse pp_atom ~pos:v.pos v) | Group g -> Block (parse_formula ~pos:v.pos g.pelem) - | Logop ({ pelem = `Or; _}, e1, e2) -> + | Logop ({ pelem = `Or; _}, e1, e2) when keep `Or -> let left = aux e1 in Or (left, aux e2) - | Logop ({ pelem = `And; _}, e1, e2) -> + | Logop ({ pelem = `And; _}, e1, e2) when keep `And -> let left = aux e1 in And (left, aux e2) | _ -> unexpected ~pos:(value_pos v) () in @@ -537,36 +543,80 @@ module V = struct | Empty -> assert false | Block f -> nullify_pos @@ Group (nullify_pos @@ print_formula ~inner:true f) - | And (e,f) -> + | And (e,f) when keep `And -> group_if @@ nullify_pos @@ Logop (nullify_pos `And, aux ~in_and:true e, aux ~in_and:true f) - | Or (e,f) -> + | Or (e,f) when keep `Or -> group_if ~cond:in_and @@ nullify_pos @@ Logop (nullify_pos `Or, aux e, aux f) - | Atom at -> group_if (print (package_atom constraints) at) + | Atom at -> group_if (print pp_atom at) + | _ -> unexpected () in let fl = if inner then [f] else split f in List.map (aux ~in_and:false) fl in - pp ~name:"pkg-formula" parse_formula print_formula + pp ~name parse_formula print_formula + + let package_formula_items kind constraints = + formula_items ~name:"pkg-formula" kind pkgname constraints let package_formula kind constraints = list -| package_formula_items kind constraints - let env_binding = + let path_format = + let parse ~pos:_ v = + match v.pelem with + | String "host" -> Host + | String "target" -> Target + | String "target-quoted" -> Target_quoted + | String "host-quoted" -> Host_quoted + | _ -> unexpected () + in + let print ht = + nullify_pos (String (OpamTypesBase.string_of_path_format ht)) + in + pp ~name:"path-format" parse print + + let separator = + let parse ~pos:_ v = + match v.pelem with + | String ":" -> SColon + | String ";" -> SSemiColon + | _ -> unexpected () + in + let print sep = + nullify_pos (String (String.make 1 (OpamTypesBase.char_of_separator sep))) + in + pp ~name:"separator" parse print + + let env_binding_t empty = let parse ~pos:_ v = match v.pelem with | Relop ({ pelem = `Eq;_}, { pelem = Ident i;_}, { pelem = String s;_}) -> - i, OpamParserTypes.Eq, s, None + { envu_var = i; envu_op = OpamParserTypes.Eq; + envu_value = s; envu_comment = None; + envu_rewrite = Some empty; + } | Env_binding ({ pelem = Ident i; _}, op, { pelem = String s; _}) -> - i, op.pelem, s, None + { envu_var = i; envu_op = op.pelem; + envu_value = s; envu_comment = None; + envu_rewrite = Some empty; + } | _ -> unexpected () in - let print (id, op, str, _) = + let print { envu_var; envu_op; envu_value; envu_comment = _ ; + envu_rewrite = _} = nullify_pos @@ - Env_binding (print ident id, nullify_pos op, print string str) + Env_binding (print ident envu_var, nullify_pos envu_op, + print string envu_value) in list -| singleton -| pp ~name:"env-binding" parse print + let env_binding = + env_binding_t (SPF_Resolved None) + + let env_binding_unresolved = + env_binding_t (SPF_Unresolved (Empty, Empty)) + (* Only used by the deprecated "os" field *) let os_constraint = let rec parse_osc ~pos:_ l = diff --git a/src/format/opamFormat.mli b/src/format/opamFormat.mli index aa55a928473..24556be110f 100644 --- a/src/format/opamFormat.mli +++ b/src/format/opamFormat.mli @@ -171,8 +171,20 @@ module V : sig (value list, 'a) t -> (value list, (name * 'a) OpamFormula.formula) t + (** Generic [package_formula_items] pp *) + val formula_items : + name:string -> + [< `Conj | `Disj ] -> + ?only:[ `And | `Or ] -> + (value, 'a) t -> + (value list, 'b) t -> + (value list, ('a * 'b) OpamFormula.formula) t + (** Environment variable updates syntax *) - val env_binding : (value, env_update) t + val separator : (value, separator) t + val path_format : (value, path_format) t + val env_binding : (value, spf_resolved env_update) t + val env_binding_unresolved : (value, spf_unresolved env_update) t val os_constraint : (value, (bool * string) OpamFormula.formula) t end diff --git a/src/format/opamPp.ml b/src/format/opamPp.ml index 6188ddcce26..634947d9a5f 100644 --- a/src/format/opamPp.ml +++ b/src/format/opamPp.ml @@ -242,6 +242,7 @@ let default d = (fun x -> Some x) let fallback pp1 pp2 = + let ppname = pp1.ppname^" | "^pp2.ppname in let parse ~pos x = try pp1.parse ~pos x with e -> OpamStd.Exn.fatal e; @@ -249,7 +250,14 @@ let fallback pp1 pp2 = try pp2.parse ~pos x with _ -> Printexc.raise_with_backtrace e bt in - { pp1 with parse } + let print x = + try pp1.print x with e -> + OpamStd.Exn.fatal e; + let bt = Printexc.get_raw_backtrace () in + try pp2.print x with _ -> + Printexc.raise_with_backtrace e bt + in + { pp1 with ppname; parse; print } module Op = struct diff --git a/src/format/opamTypes.mli b/src/format/opamTypes.mli index d89adf71769..385dab76624 100644 --- a/src/format/opamTypes.mli +++ b/src/format/opamTypes.mli @@ -399,12 +399,50 @@ type stats = { s_remove : int; } -(** Environement variables: var name, value, optional comment *) +(** Environment variables: var name, value, optional comment *) type env = (OpamStd.Env.Name.t * string * string option) list +type path_format = + | Host + (** use host interpretation of path format *) + + | Host_quoted + (** use host interpretation of path format and quote resulting path if it + contains the separator character *) + + | Target + (** use the target interpretation of path format (opam file one) *) + + | Target_quoted + (** use the target interpretation of path format (opam file one) and quote + path if it contains the separator character *) + +type separator = + | SColon + (** Colon separator, i.e. ':' *) + + | SSemiColon + (** Semi-colon separator, i.e. ';' *) + +type spf_resolved = [ `resolved ] +type spf_unresolved = [ `unresolved ] +type _ separator_path_format = + | SPF_Resolved: + (separator * path_format) option + -> spf_resolved separator_path_format + | SPF_Unresolved: + (separator * filter) generic_formula + * (path_format * filter) generic_formula + -> spf_unresolved separator_path_format + (** Environment updates *) -type env_update = string * OpamParserTypes.FullPos.env_update_op_kind * string * string option -(** var, update_op, value, comment *) +type 'a env_update = { + envu_var : string; + envu_op : OpamParserTypes.FullPos.env_update_op_kind; + envu_value : string; + envu_comment : string option; + envu_rewrite: 'a separator_path_format option; +} (** Tags *) type tags = OpamStd.String.Set.t OpamStd.String.SetMap.t diff --git a/src/format/opamTypesBase.ml b/src/format/opamTypesBase.ml index a1260b833f9..76d72ecfc5d 100644 --- a/src/format/opamTypesBase.ml +++ b/src/format/opamTypesBase.ml @@ -221,3 +221,33 @@ let map_success f = function let iter_success f = function | Success x -> f x | Conflicts _ -> () + +(** Environment update helpers *) +let env_update ?comment:envu_comment ~rewrite:envu_rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; envu_rewrite } + +let env_update_resolved ?comment:envu_comment ?rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; + envu_rewrite = OpamStd.Option.default (Some (SPF_Resolved None)) rewrite; + } + +let env_update_unresolved ?comment:envu_comment ?rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; + envu_rewrite = + OpamStd.Option.default (Some (SPF_Unresolved (Empty, Empty))) + rewrite; + } + +(** Environment update path transformers functions *) +let string_of_path_format = function + | Host -> "host" + | Target -> "target" + | Target_quoted -> "target-quoted" + | Host_quoted -> "host-quoted" + +let char_of_separator = function + | SSemiColon -> ';' + | SColon -> ':' diff --git a/src/format/opamTypesBase.mli b/src/format/opamTypesBase.mli index f74ff5f4151..37913793b32 100644 --- a/src/format/opamTypesBase.mli +++ b/src/format/opamTypesBase.mli @@ -76,3 +76,24 @@ val all_package_flags: package_flag list (** Map on a solver result *) val map_success: ('a -> 'b) -> ('a,'fail) result -> ('b,'fail) result val iter_success: ('a -> unit) -> ('a, 'b) result -> unit + +(** Environment update helpers *) +(* Build an environment update *) +val env_update: + ?comment:string -> rewrite:'a separator_path_format option + -> string -> env_update_op_kind -> string + -> 'a env_update + +val env_update_resolved: + ?comment:string -> ?rewrite:spf_resolved separator_path_format option + -> string -> env_update_op_kind -> string + -> spf_resolved env_update + +val env_update_unresolved: + ?comment:string -> ?rewrite:spf_unresolved separator_path_format option + -> string -> env_update_op_kind -> string + -> spf_unresolved env_update + +(* Path transformers & separator functions *) +val string_of_path_format: path_format -> string +val char_of_separator: separator -> char diff --git a/src/state/opamEnv.ml b/src/state/opamEnv.ml index cdcb61479ac..d5371474cda 100644 --- a/src/state/opamEnv.ml +++ b/src/state/opamEnv.ml @@ -19,39 +19,190 @@ open OpamFilename.Op let log fmt = OpamConsole.log "ENV" fmt let slog = OpamConsole.slog -(* - Environment and updates handling - *) -type _ env_classification = -| Separator : char env_classification -| Split : (string -> string list) env_classification - -let get_env_property : type s . string -> s env_classification -> s = fun var classification -> - let split_delim = Fun.flip OpamStd.String.split in - let separator, split = - match String.uppercase_ascii var with - | "CAML_LD_LIBRARY_PATH" -> - OpamStd.Sys.path_sep, split_delim OpamStd.Sys.path_sep - | "PKG_CONFIG_PATH" | "MANPATH" -> - ':', split_delim ':' +(* Path format & separator handling *) +let default_separator = if Sys.win32 then SSemiColon else SColon +let default_format = Target + +(* Predefined default separators and format for some environment variables *) +let default_sep_fmt_str var = + match String.uppercase_ascii var with + | "PATH" when Sys.win32 -> + SSemiColon, Target_quoted + | "PKG_CONFIG_PATH" | "MANPATH" -> + SColon, Target_quoted + | _ -> default_separator, default_format + +let default_sep_fmt var = default_sep_fmt_str (OpamStd.Env.Name.to_string var) + +(* sepfmt argument: + - None: no rewrite + - Some None: rewrite with defaults for given variable + - Some (Some (separator, path_format): use given separator & path format +*) +type sep_path_format = [ + | `norewrite (* not a path, rewrite *) + | `rewrite_default of string (* path, default of variable *) + | `rewrite of separator * path_format (* path, rewrite using sep & fmt *) +] + +let transform_format ~(sepfmt:sep_path_format) = + match sepfmt with + | `norewrite -> fun x -> x + | (`rewrite_default _ | `rewrite _) as sepfmt -> + let separator, format = + match sepfmt with + | `rewrite_default var -> default_sep_fmt_str var + | `rewrite (sep, fmt) -> sep, fmt + in + let translate = + match format with + | Target | Target_quoted -> + (match sepfmt with + | `rewrite_default _ -> fun x -> x + | `rewrite _ -> OpamSystem.forward_to_back) + | Host | Host_quoted -> + (* noop on non windows *) + (Lazy.force OpamSystem.get_cygpath_path_transform) ~pathlist:false + in + match format with + | Target | Host -> translate + | Target_quoted | Host_quoted -> + fun arg -> + let path = translate arg in + let separator = OpamTypesBase.char_of_separator separator in + if String.contains path separator then + "\""^path^"\"" else path + +let resolve_separator_and_format : + type r. r env_update -> spf_resolved env_update = + let env fv = + let fv = OpamVariable.Full.variable fv in + OpamStd.Option.(Op.( + of_Not_found + (OpamStd.List.assoc OpamVariable.equal fv) + OpamSysPoll.variables >>= Lazy.force)) + in + let resolve var to_str formula = + let evaluated = + OpamFormula.map (fun (x, filter) -> + let eval = OpamFilter.eval_to_bool ~default:false env filter in + if eval then Atom (x, FBool true) else Empty) + formula + |> OpamFormula.map_formula (function + | Block x -> x + | x -> x) + in + match evaluated with + | Empty -> None + | Atom (x, FBool true) -> Some x | _ -> - OpamStd.Sys.path_sep, OpamStd.Sys.split_path_variable ~clean:false + let sep, pfmt = default_sep_fmt_str var in + OpamConsole.error + "Formula can't be completely resolved : %s %s. Using default '%c' '%s'." + var + (OpamFormula.string_of_formula (fun (s, f) -> + "\""^to_str s ^ "\" " ^ + OpamFilter.to_string f) formula) + (char_of_separator sep) + (string_of_path_format pfmt); + None in - match classification with - | Separator -> separator - | Split -> split + fun upd -> + let var = upd.envu_var in + let envu_rewrite = + match upd.envu_rewrite with + | Some (SPF_Unresolved (sep_f, pfmt_f)) -> + let def_sep, def_pfmt = default_sep_fmt_str var in + let sep = + resolve upd.envu_var + (fun sep -> String.make 1 (char_of_separator sep)) + sep_f + in + let pfmt = + resolve upd.envu_var string_of_path_format pfmt_f + in + let sep_pfmt = + match sep, pfmt with + | Some sep, Some pfmt -> Some (sep, pfmt) + | Some sep, None -> Some (sep, def_pfmt) + | None, Some pfmt -> Some (def_sep, pfmt) + | None, None -> None + in + Some (SPF_Resolved (sep_pfmt)) + | Some (SPF_Resolved _) -> upd.envu_rewrite + | None -> None + in + { upd with envu_rewrite } -let split_var (var : OpamStd.Env.Name.t) = - get_env_property (var :> string) Split +(* - Environment and updates handling - *) +let split_var ~(sepfmt:sep_path_format) var value = + match sepfmt with + | `norewrite -> + default_sep_fmt var + |> fst + |> char_of_separator + |> OpamStd.String.split value + | (`rewrite_default _ | `rewrite _) as sepfmt -> + let separator, format = + match sepfmt with + | `rewrite_default var -> default_sep_fmt_str var + | `rewrite (sep, fmt) -> sep, fmt + in + let sep = OpamTypesBase.char_of_separator separator in + match format with + | Target_quoted | Host_quoted -> + OpamStd.String.split value sep + | Target | Host -> + (* we suppose that it is in the form: + - "quoted":unquoted + - unquoted:"quoted" + - "quoted":unquoted:"quoted" + - unquoted:"quoted":unquoted + - "quoted" + - unquoted + *) + let rec aux remaining acc = + match String.get remaining 0 with + | '"' -> + (let remaining = + String.sub remaining 1 (String.length remaining - 1) + in + match OpamStd.String.cut_at remaining '"' with + | Some (quoted, rest) -> + aux rest (("\""^quoted^"\"")::acc) + | None -> remaining::acc) + | _ -> + let remaining = + if Char.equal (String.get remaining 0) sep then + String.sub remaining 1 (String.length remaining - 1) + else remaining in + (match OpamStd.String.cut_at remaining sep with + | Some (unquoted, rest) -> + aux rest (unquoted::acc) + | None -> remaining::acc) + | exception Invalid_argument _ -> acc + in + List.rev @@ aux value [] + +let join_var ~(sepfmt:sep_path_format) var values = + let separator = + match sepfmt with + | `norewrite -> fst (default_sep_fmt var) + | `rewrite_default var -> fst (default_sep_fmt_str var) + | `rewrite (sep, _) -> sep + in + String.concat + (String.make 1 (OpamTypesBase.char_of_separator separator)) + values -let join_var (var : OpamStd.Env.Name.t) l = - String.concat (String.make 1 (get_env_property (var :> string) Separator)) l (* To allow in-place updates, we store intermediate values of path-like as a pair of list [(rl1, l2)] such that the value is [List.rev_append rl1 l2] and the place where the new value should be inserted is in front of [l2] *) -let unzip_to var elt current = +let unzip_to ~sepfmt var elt current = (* If [r = l @ rs] then [remove_prefix l r] is [Some rs], otherwise [None] *) let rec remove_prefix l r = match l, r with @@ -60,7 +211,8 @@ let unzip_to var elt current = | ([], rs) -> Some rs | _ -> None in - match (if String.equal elt "" then [""] else split_var var elt) with + match (if String.equal elt "" then [""] + else split_var ~sepfmt var elt) with | [] -> invalid_arg "OpamEnv.unzip_to" | hd::tl -> let rec aux acc = function @@ -77,10 +229,13 @@ let unzip_to var elt current = let rezip ?insert (l1, l2) = List.rev_append l1 (match insert with None -> l2 | Some i -> i::l2) -let rezip_to_string var ?insert z = - join_var var (rezip ?insert z) +let rezip_to_string ~sepfmt var ?insert z = + join_var ~sepfmt var (rezip ?insert z) -let apply_op_zip op arg (rl1,l2 as zip) = + +(* apply_zip take an already transformed arg *) +let apply_op_zip ~sepfmt op arg (rl1,l2 as zip) = + let arg = transform_format ~sepfmt arg in let colon_eq ?(eqcol=false) = function (* prepend a, but keep ":"s *) | [] | [""] -> [], [arg; ""] | "" :: l -> @@ -110,36 +265,37 @@ let apply_op_zip op arg (rl1,l2 as zip) = position of the matching element and allow [=+=] to be applied later. A pair or empty lists is returned if the variable should be unset or has an unknown previous value. *) -let reverse_env_update var op arg cur_value = +let reverse_env_update ~sepfmt var op arg cur_value = if String.equal arg "" && op <> Eq then None else match op with | Eq -> - if arg = join_var var cur_value + if arg = join_var ~sepfmt var cur_value then Some ([],[]) else None - | PlusEq | EqPlusEq -> unzip_to var arg cur_value + | PlusEq | EqPlusEq -> unzip_to var ~sepfmt arg cur_value | EqPlus -> - (match unzip_to var arg (List.rev cur_value) with + (match unzip_to ~sepfmt var arg (List.rev cur_value) with | None -> None | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1)) | ColonEq -> - (match unzip_to var arg cur_value with + (match unzip_to var ~sepfmt arg cur_value with | Some ([], [""]) -> Some ([], []) | r -> r) | EqColon -> - (match unzip_to var arg (List.rev cur_value) with + (match unzip_to ~sepfmt var arg (List.rev cur_value) with | Some ([], [""]) -> Some ([], []) | Some (rl1, l2) -> Some (List.rev l2, List.rev rl1) | None -> None) let map_update_names env_keys updates = - let convert (k, o, a, d) = + let convert upd = + let { envu_var = k; _ } = upd in let k = try let k = OpamStd.Env.Name.of_string k in (OpamStd.Env.Name.(Set.find (equal k) env_keys) :> string) with Not_found -> k in - k, o, a, d + { upd with envu_var = k } in List.map convert updates @@ -171,7 +327,7 @@ let updates_from_previous_instance = lazy ( try get_env env_file with e -> OpamStd.Exn.fatal e; None)) -let expand (updates: env_update list) : env = +let expand (updates: spf_resolved env_update list) : env = let updates = if Sys.win32 then (* Preserve the case of updates which are already in env *) @@ -179,76 +335,112 @@ let expand (updates: env_update list) : env = else updates in + let pick_assoc3 eq x l = + let rec aux acc = function + | [] -> None, l + | (k,v,_) as b::r -> + if eq k x then Some v, List.rev_append acc r + else aux (b::acc) r + in + aux [] l + in (* Reverse all previous updates, in reverse order, on current environment *) let reverts = match Lazy.force updates_from_previous_instance with | None -> [] | Some updates -> - List.fold_right (fun (var, op, arg, _) defs0 -> + List.fold_right (fun upd defs0 -> + let { envu_var = var; envu_op = op; envu_value = arg; + envu_rewrite; _} = upd + in + let sepfmt = + match envu_rewrite with + | None -> `norewrite + | Some (SPF_Resolved None) -> `rewrite_default var + | Some (SPF_Resolved (Some spf)) -> `rewrite spf + in let var = OpamStd.Env.Name.of_string var in let v_opt, defs = - OpamStd.List.pick_assoc OpamStd.Env.Name.equal var defs0 + pick_assoc3 OpamStd.Env.Name.equal var defs0 in let v = match Option.map rezip v_opt with | Some v -> v | None -> - OpamStd.Option.map_default (split_var var) [] + OpamStd.Option.map_default (split_var ~sepfmt var) [] (OpamStd.Env.getopt (var :> string)) in - match reverse_env_update var op arg v with - | Some v -> (var, v)::defs + match reverse_env_update ~sepfmt var op arg v with + | Some v -> (var, v, sepfmt)::defs | 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 + (OpamStd.Env.Name.of_string "OPAM_LAST_ENV", ([], []), + `rewrite_default "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 + (OpamStd.Env.Name.of_string "OPAM_SWITCH_PREFIX", ([], []), + `rewrite_default "OPAM_SWITCH_PREFIX") + ::reverts else reverts in (* And apply the new ones *) - let rec apply_updates reverts acc = function - | (var, op, arg, doc) :: updates -> - let var = OpamStd.Env.Name.of_string var in + let rec apply_updates reverts acc lst = + match lst with + | upd :: updates -> + let { envu_var = svar; envu_op = op; + envu_value = arg; envu_comment = doc; + envu_rewrite } = upd + in + let sepfmt = + match envu_rewrite with + | None -> `norewrite + | Some (SPF_Resolved None) -> `rewrite_default svar + | Some (SPF_Resolved (Some spf)) -> `rewrite spf + in + let var = OpamStd.Env.Name.of_string svar in let zip, reverts = - match OpamStd.List.find_opt (fun (v, _, _) -> + match OpamStd.List.find_opt (fun (v, _, _, _) -> OpamStd.Env.Name.equal var v) acc with - | Some (_, z, _doc) -> z, reverts + | Some (_, z, _doc, _) -> z, reverts | None -> - match OpamStd.List.pick_assoc OpamStd.Env.Name.equal var reverts with + match pick_assoc3 OpamStd.Env.Name.equal var reverts with | Some z, reverts -> z, reverts | None, _ -> - match OpamStd.Env.getopt (var :> string) with - | Some s -> ([], split_var var s), reverts + match OpamStd.Env.getopt svar with + | Some s -> ([], split_var var s ~sepfmt), reverts | None -> ([], []), reverts in let acc = if String.equal arg "" && op <> Eq then acc else - ((var, apply_op_zip op arg zip, doc) :: acc) + ((var, apply_op_zip ~sepfmt op arg zip, doc, sepfmt) + :: acc) in apply_updates reverts acc updates | [] -> - List.rev @@ - List.rev_append - (List.rev_map (fun (var, z, doc) -> var, rezip_to_string var z, doc) acc) @@ - List.rev_map (fun (var, z) -> - var, rezip_to_string var z, Some "Reverting previous opam update") + List.rev + @@ List.rev_append + (List.rev_map (fun (var, z, doc, sepfmt) -> + var, rezip_to_string ~sepfmt var z, doc) acc) + @@ List.rev_map (fun (var, z, sepfmt) -> + var, rezip_to_string ~sepfmt var z, + Some "Reverting previous opam update") reverts in apply_updates reverts [] updates -let add (env: env) (updates: env_update list) = +let add (env: env) (updates: 'r env_update list) : env = let updates = if Sys.win32 then (* Preserve the case of updates which are already in env *) @@ -258,8 +450,8 @@ let add (env: env) (updates: env_update list) = updates in let update_keys = - List.fold_left (fun m (k,_,_,_) -> - OpamStd.Env.Name.(Set.add (of_string k) m)) + List.fold_left (fun m upd -> + OpamStd.Env.Name.(Set.add (of_string upd.envu_var) m)) OpamStd.Env.Name.Set.empty updates in let env = @@ -269,15 +461,17 @@ let add (env: env) (updates: env_update list) = in env @ expand updates -let env_expansion ?opam st (name, op, str, cmt) = +let env_expansion ?opam st upd = let fenv v = try OpamPackageVar.resolve st ?opam v with Not_found -> log "Undefined variable: %s" (OpamVariable.Full.to_string v); None in - let s = OpamFilter.expand_string ~default:(fun _ -> "") fenv str in - name, op, s, cmt + let s = + OpamFilter.expand_string ~default:(fun _ -> "") fenv upd.envu_value + in + { upd with envu_value = s } let compute_updates ?(force_path=false) st = (* Todo: put these back into their packages! @@ -289,49 +483,57 @@ let compute_updates ?(force_path=false) st = OpamPath.Switch.bin st.switch_global.root st.switch st.switch_config in let path = - "PATH", - (if force_path then PlusEq else EqPlusEq), - OpamFilename.Dir.to_string bindir, - Some ("Binary dir for opam switch "^OpamSwitch.to_string st.switch) - in + env_update_resolved "PATH" + (if force_path then PlusEq else EqPlusEq) + (OpamFilename.Dir.to_string bindir) + ~comment:("Binary dir for opam switch "^OpamSwitch.to_string st.switch) + in let man_path = let open OpamStd.Sys in match os () with | OpenBSD | NetBSD | FreeBSD | Darwin | DragonFly -> [] (* MANPATH is a global override on those, so disabled for now *) | _ -> - ["MANPATH", EqColon, - OpamFilename.Dir.to_string - (OpamPath.Switch.man_dir - st.switch_global.root st.switch st.switch_config), - Some "Current opam switch man dir"] - in - let switch_env = - ("OPAM_SWITCH_PREFIX", Eq, - OpamFilename.Dir.to_string - (OpamPath.Switch.root st.switch_global.root st.switch), - Some "Prefix of the current opam switch") :: - List.map (env_expansion st) st.switch_config.OpamFile.Switch_config.env + [ env_update_resolved "MANPATH" EqColon + (OpamFilename.Dir.to_string + (OpamPath.Switch.man_dir st.switch_global.root + st.switch st.switch_config)) + ~comment:"Current opam switch man dir" + ] + in + let switch_env = + (env_update_resolved "OPAM_SWITCH_PREFIX" Eq + (OpamFilename.Dir.to_string + (OpamPath.Switch.root st.switch_global.root st.switch)) + ~comment:"Prefix of the current opam switch") + :: + List.map (env_expansion st) st.switch_config.OpamFile.Switch_config.env in let pkg_env = (* XXX: Does this need a (costly) topological sort? *) - OpamPackage.Set.fold (fun nv acc -> - match OpamPackage.Map.find_opt nv st.opams with - | Some opam -> List.map (env_expansion ~opam st) (OpamFile.OPAM.env opam) @ acc - | None -> acc) - st.installed [] + let updates = + OpamPackage.Set.fold (fun nv acc -> + match OpamPackage.Map.find_opt nv st.opams with + | Some opam -> + List.map (env_expansion ~opam st) (OpamFile.OPAM.env opam) @ acc + | None -> acc) + st.installed [] + in + List.map resolve_separator_and_format updates in switch_env @ pkg_env @ man_path @ [path] let updates_common ~set_opamroot ~set_opamswitch root switch = let root = if set_opamroot then - [ "OPAMROOT", Eq, OpamFilename.Dir.to_string root, - Some "Opam root in use" ] + [ env_update_resolved "OPAMROOT" Eq + (OpamFilename.Dir.to_string root) + ~comment:"Opam root in use" ] else [] in let switch = if set_opamswitch then - [ "OPAMSWITCH", Eq, OpamSwitch.to_string switch, None ] + [ env_update_resolved "OPAMSWITCH" Eq + (OpamSwitch.to_string switch) ] else [] in root @ switch @@ -356,12 +558,13 @@ let get_opam_raw_updates ~set_opamroot ~set_opamswitch ~force_path root switch = else PlusEq, EqPlusEq in - List.map (function - | var, op, v, doc when String.uppercase_ascii var = "PATH" && op = from_op -> - var, to_op, v, doc - | e -> e) upd + List.map (function + | { envu_var; envu_op; _} as upd when + String.uppercase_ascii envu_var = "PATH" && envu_op = from_op -> + { upd with envu_op = to_op } + | e -> e) upd in - 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 = @@ -373,10 +576,10 @@ let get_opam_raw ~set_opamroot ~set_opamswitch ?(base=[]) ~force_path 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 + let to_string { envu_var; envu_op; envu_value; _} = + String.escaped envu_var + ^ OpamPrinter.FullPos.env_update_op_kind envu_op + ^ String.escaped envu_value in List.rev_map to_string upd |> String.concat "\n" @@ -397,27 +600,38 @@ let get_full List.filter (fun (name, _) -> not (OpamStd.Env.Name.Set.mem name scrub)) env in let env0 = List.map (fun (v,va) -> v,va,None) env in - let updates = u @ updates ~set_opamroot ~set_opamswitch ~force_path st in + let updates = + (List.map resolve_separator_and_format u) + @ updates ~set_opamroot ~set_opamswitch ~force_path st in add env0 updates let is_up_to_date_raw ?(skip=OpamStateConfig.(!r.no_env_notice)) updates = skip || let not_utd = - List.fold_left (fun notutd (var, op, arg, _doc as upd) -> + List.fold_left (fun notutd upd -> + let { envu_var = var; envu_op = op; envu_value = arg; + envu_rewrite; _} = upd in + let sepfmt = + match envu_rewrite with + | None -> `norewrite + | Some (SPF_Resolved None) -> `rewrite_default var + | Some (SPF_Resolved (Some spf)) -> `rewrite spf + in let var = OpamStd.Env.Name.of_string var in match OpamStd.Env.getopt_full var with | _, None -> upd::notutd | var, Some v -> - if reverse_env_update var op arg (split_var var v) = None then upd::notutd - else List.filter (fun (v, _, _, _) -> - OpamStd.Env.Name.equal_string var v) notutd) + if reverse_env_update ~sepfmt var op arg + (split_var ~sepfmt var v) = None then upd::notutd + else List.filter (fun upd -> + OpamStd.Env.Name.equal_string var upd.envu_var) notutd) [] updates in let r = not_utd = [] in if not r then log "Not up-to-date env variables: [%a]" - (slog @@ String.concat " " @* List.map (fun (v, _, _, _) -> v)) not_utd + (slog @@ String.concat " " @* List.map (fun upd -> upd.envu_var)) not_utd else log "Environment is up-to-date"; r @@ -435,12 +649,10 @@ let switch_path_update ~force_path root switch = (OpamStateConfig.Switch.safe_load_t ~lock_kind:`Lock_read root switch) in - [ - "PATH", - (if force_path then PlusEq else EqPlusEq), - OpamFilename.Dir.to_string bindir, - Some "Current opam switch binary dir" - ] + [ env_update_resolved "PATH" + (if force_path then PlusEq else EqPlusEq) + (OpamFilename.Dir.to_string bindir) + ~comment:"Current opam switch binary dir" ] let path ~force_path root switch = let env = expand (switch_path_update ~force_path root switch) in @@ -718,13 +930,29 @@ let init_script root shell = let string_of_update st shell updates = let fenv = OpamPackageVar.resolve st in - let aux (ident, symbol, string, comment) = + let aux { envu_var; envu_op; envu_value; envu_comment; envu_rewrite } = let string = - OpamFilter.expand_string ~default:(fun _ -> "") fenv string |> + OpamFilter.expand_string ~default:(fun _ -> "") fenv envu_value |> OpamStd.Env.escape_single_quotes ~using_backslashes:(shell = SH_fish) in + let sepfmt = + match envu_rewrite with + | None -> `norewrite + | Some (SPF_Resolved None) -> `rewrite_default envu_var + | Some (SPF_Resolved (Some spf)) -> `rewrite spf + in + let string = + transform_format ~sepfmt string + in + let sep = + OpamTypesBase.char_of_separator + (match envu_rewrite with + | Some (SPF_Resolved (Some (sep, _))) -> sep + | None | Some (SPF_Resolved None) -> + fst @@ default_sep_fmt_str envu_var) + in let key, value = - ident, match symbol with + envu_var, match envu_op with | Eq -> (match shell with | SH_pwsh _ -> @@ -732,21 +960,19 @@ let string_of_update st shell updates = | SH_cmd -> string | _ -> Printf.sprintf "'%s'" string) | PlusEq | ColonEq | EqPlusEq -> - let sep = get_env_property ident Separator in (match shell with | SH_pwsh _ -> Printf.sprintf "'%s%c' + \"$env:%s\"" - (OpamStd.Env.escape_powershell string) sep ident - | SH_cmd -> Printf.sprintf "%s%c%%%s%%" string sep ident - | _ -> Printf.sprintf "'%s':\"$%s\"" string ident) + (OpamStd.Env.escape_powershell string) sep envu_var + | SH_cmd -> Printf.sprintf "%s%c%%%s%%" string sep envu_var + | _ -> Printf.sprintf "'%s':\"$%s\"" string envu_var) | EqColon | EqPlus -> - let sep = get_env_property ident Separator in (match shell with - | SH_pwsh _ -> Printf.sprintf "\"$env:%s\" + '%c%s'" ident sep string - | SH_cmd -> Printf.sprintf "%%%s%%%c%s" ident sep string - | _ -> Printf.sprintf "\"$%s\":'%s'" ident string) + | SH_pwsh _ -> Printf.sprintf "\"$env:%s\" + '%c%s'" envu_var sep string + | SH_cmd -> Printf.sprintf "%%%s%%%c%s" envu_var sep string + | _ -> Printf.sprintf "\"$%s\":'%s'" envu_var string) in - export_in_shell shell (key, value, comment) in + export_in_shell shell (key, value, envu_comment) in OpamStd.List.concat_map "" aux updates let write_script dir (name, body) = diff --git a/src/state/opamEnv.mli b/src/state/opamEnv.mli index 877eb9ec658..2e3cab36756 100644 --- a/src/state/opamEnv.mli +++ b/src/state/opamEnv.mli @@ -16,6 +16,10 @@ open OpamStateTypes (** {2 Environment handling} *) +(* Resolve [env_update] separator & format according system *) +val resolve_separator_and_format: + 'r env_update -> spf_resolved env_update + (** Get the current environment with OPAM specific additions. If [force_path], the PATH is modified to ensure opam dirs are leading. [set_opamroot] and [set_opamswitch] can be additionally used to set the [OPAMROOT] and @@ -23,7 +27,7 @@ open OpamStateTypes remove from the environment. *) val get_full: set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> - ?updates:env_update list -> ?scrub:string list -> 'a switch_state -> env + ?updates: 'r env_update list -> ?scrub:string list -> 'a switch_state -> env (** Get only environment modified by OPAM. If [force_path], the PATH is modified to ensure opam dirs are leading. [set_opamroot] and [set_opamswitch] can be @@ -47,26 +51,26 @@ val get_opam_raw: environment. *) val get_opam_raw_updates: set_opamroot:bool -> set_opamswitch:bool -> force_path:bool -> - dirname -> switch -> env_update list + dirname -> switch -> spf_resolved 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 +val hash_env_updates: 'a 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 +val get_pure: ?updates:spf_resolved env_update list -> unit -> env (** Update an environment, including reverting opam changes that could have been previously applied (therefore, don't apply to an already updated env as returned by e.g. [get_full]!) *) -val add: env -> env_update list -> env +val add: env -> spf_resolved env_update list -> env (** Like [get_opam] computes environment modification by OPAM , but returns these [updates] instead of the new environment. *) val updates: set_opamroot:bool -> set_opamswitch:bool -> ?force_path:bool -> - 'a switch_state -> env_update list + 'a switch_state -> spf_resolved env_update list (** Check if the shell environment is in sync with the current OPAM switch, unless [skip] is true (it's default value is OPAMNOENVNOTICE *) @@ -79,7 +83,7 @@ val is_up_to_date_switch: dirname -> switch -> bool (** Returns the current environment updates to configure the current switch with its set of installed packages *) -val compute_updates: ?force_path:bool -> 'a switch_state -> env_update list +val compute_updates: ?force_path:bool -> 'a switch_state -> spf_resolved env_update list (** Returns shell-appropriate statement to evaluate [cmd]. *) val shell_eval_invocation: @@ -102,10 +106,10 @@ val path: force_path:bool -> dirname -> switch -> string (** Returns the full environment with only the PATH variable updated, as per [path] *) val full_with_path: - force_path:bool -> ?updates:env_update list -> dirname -> switch -> env + force_path:bool -> ?updates:spf_resolved env_update list -> dirname -> switch -> env (** Performs variable expansion on the strings in an environment update *) -val env_expansion: ?opam:OpamFile.OPAM.t -> 'a switch_state -> env_update -> env_update +val env_expansion: ?opam:OpamFile.OPAM.t -> 'a switch_state -> spf_unresolved env_update -> spf_unresolved env_update (** {2 Shell and initialisation support} *) diff --git a/tests/reftests/dune.inc b/tests/reftests/dune.inc index 01ae8f61444..69497f6548a 100644 --- a/tests/reftests/dune.inc +++ b/tests/reftests/dune.inc @@ -542,6 +542,27 @@ %{targets} (run ./run.exe %{exe:../../src/client/opamMain.exe.exe} %{dep:env.test} %{read-lines:testing-env})))) +(rule + (alias reftest-env.unix) + (enabled_if (= %{os_type} "Unix")) + (action + (diff env.unix.test env.unix.out))) + +(alias + (name reftest) + (enabled_if (= %{os_type} "Unix")) + (deps (alias reftest-env.unix))) + +(rule + (targets env.unix.out) + (deps root-N0REP0) + (enabled_if (= %{os_type} "Unix")) + (package opam) + (action + (with-stdout-to + %{targets} + (run ./run.exe %{exe:../../src/client/opamMain.exe.exe} %{dep:env.unix.test} %{read-lines:testing-env})))) + (rule (alias reftest-env.win32) (enabled_if (= %{os_type} "Win32")) diff --git a/tests/reftests/env.unix.test b/tests/reftests/env.unix.test new file mode 100644 index 00000000000..ad6fe4133a6 --- /dev/null +++ b/tests/reftests/env.unix.test @@ -0,0 +1,756 @@ +N0REP0 +### : setenv & build env rewriting : +### opam switch create rewriting --empty +### :::::::::::::::::: +### : Colon & target : +### :::::::::::::::::: +### RCT_ENVSET_ADD=a/path/to +### RCT_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCT_ENVBUILD_ADD=a/path/to +### RCT_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCT_ENVSET = "/a/given/path" ] + [ RCT_ENVSET_STR = "something" ] + [ RCT_ENVSET_WITH_COL = "s:mething" ] + [ RCT_ENVSET_ADD += "/a/given/path" ] + [ RCT_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCT_ENVBUILD = "/a/given/path" ] + [ RCT_ENVBUILD_STR = "something" ] + [ RCT_ENVBUILD_WITH_COL = "s:mething" ] + [ RCT_ENVBUILD_ADD += "/a/given/path" ] + [ RCT_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCT_ENV" ] +x-env-path-rewrite: [ + [ RCT_ENVSET ":" "target" ] + [ RCT_ENVSET_STR ":" "target" ] + [ RCT_ENVSET_WITH_COL ":" "target" ] + [ RCT_ENVSET_ADD ":" "target" ] + [ RCT_ENVSET_ADD_WITH_COL ":" "target" ] + + [ RCT_ENVBUILD ":" "target" ] + [ RCT_ENVBUILD_STR ":" "target" ] + [ RCT_ENVBUILD_WITH_COL ":" "target" ] + [ RCT_ENVBUILD_ADD ":" "target" ] + [ RCT_ENVBUILD_ADD_WITH_COL ":" "target" ] +] +### opam install col-target -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-target 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-target: sh env | grep RCT_ENV] ++ sh "-c" "env | grep RCT_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-target.1) +- RCT_ENVBUILD=/a/given/path +- RCT_ENVBUILD_ADD=/a/given/path:a/path/to +- RCT_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted" +- RCT_ENVBUILD_STR=something +- RCT_ENVBUILD_WITH_COL=s:mething +- RCT_ENVSET_ADD=a/path/to +- RCT_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-target.1 +-> installed col-target.1 +Done. +### opam env | grep "RCT_ENV" +RCT_ENVSET='/a/given/path'; export RCT_ENVSET; +RCT_ENVSET_STR='something'; export RCT_ENVSET_STR; +RCT_ENVSET_WITH_COL='s:mething'; export RCT_ENVSET_WITH_COL; +RCT_ENVSET_ADD='/a/given/path:a/path/to'; export RCT_ENVSET_ADD; +RCT_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted"'; export RCT_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCT_ENV +RCT_ENVSET = /a/given/path : target Updated\ by\ package\ col-target +RCT_ENVSET_STR = something : target Updated\ by\ package\ col-target +RCT_ENVSET_WITH_COL = s:mething : target Updated\ by\ package\ col-target +RCT_ENVSET_ADD += /a/given/path : target Updated\ by\ package\ col-target +RCT_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : target Updated\ by\ package\ col-target +### ::::::::::::::::::::::::: +### : Colon & target-quoted : +### ::::::::::::::::::::::::: +### RCTQ_ENVSET_ADD=a/path/to +### RCTQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCTQ_ENVBUILD_ADD=a/path/to +### RCTQ_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCTQ_ENVSET = "/a/given/path" ] + [ RCTQ_ENVSET_STR = "something" ] + [ RCTQ_ENVSET_WITH_COL = "s:mething" ] + [ RCTQ_ENVSET_ADD += "/a/given/path" ] + [ RCTQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCTQ_ENVBUILD = "/a/given/path" ] + [ RCTQ_ENVBUILD_STR = "something" ] + [ RCTQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RCTQ_ENVBUILD_ADD += "/a/given/path" ] + [ RCTQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCTQ_ENV" ] +x-env-path-rewrite: [ + [ RCTQ_ENVSET ":" "target-quoted" ] + [ RCTQ_ENVSET_STR ":" "target-quoted" ] + [ RCTQ_ENVSET_WITH_COL ":" "target-quoted" ] + [ RCTQ_ENVSET_ADD ":" "target-quoted" ] + [ RCTQ_ENVSET_ADD_WITH_COL ":" "target-quoted" ] + + [ RCTQ_ENVBUILD ":" "target-quoted" ] + [ RCTQ_ENVBUILD_STR ":" "target-quoted" ] + [ RCTQ_ENVBUILD_WITH_COL ":" "target-quoted" ] + [ RCTQ_ENVBUILD_ADD ":" "target-quoted" ] + [ RCTQ_ENVBUILD_ADD_WITH_COL ":" "target-quoted" ] +] +### opam install col-target-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-target-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-target-quoted: sh env | grep RCTQ_ENV] ++ sh "-c" "env | grep RCTQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-target-quoted.1) +- RCTQ_ENVBUILD=/a/given/path +- RCTQ_ENVBUILD_ADD=/a/given/path:a/path/to +- RCTQ_ENVBUILD_ADD_WITH_COL="a:/nother/gi;ven/path":/a/path/to:"t:/his/is/quoted" +- RCTQ_ENVBUILD_STR=something +- RCTQ_ENVBUILD_WITH_COL="s:mething" +- RCTQ_ENVSET_ADD=a/path/to +- RCTQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-target-quoted.1 +-> installed col-target-quoted.1 +Done. +### opam env | grep "RCTQ_ENV" +RCTQ_ENVSET='/a/given/path'; export RCTQ_ENVSET; +RCTQ_ENVSET_STR='something'; export RCTQ_ENVSET_STR; +RCTQ_ENVSET_WITH_COL='"s:mething"'; export RCTQ_ENVSET_WITH_COL; +RCTQ_ENVSET_ADD='/a/given/path:a/path/to'; export RCTQ_ENVSET_ADD; +RCTQ_ENVSET_ADD_WITH_COL='"a:/nother/gi;ven/path":/a/path/to:"t:/his/is/quoted"'; export RCTQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCTQ_ENV +RCTQ_ENVSET = /a/given/path : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_STR = something : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_WITH_COL = s:mething : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_ADD += /a/given/path : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : target-quoted Updated\ by\ package\ col-target-quoted +### :::::::::::::::: +### : Colon & host : +### :::::::::::::::: +### RCH_ENVSET_ADD=a/path/to +### RCH_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCH_ENVBUILD_ADD=a/path/to +### RCH_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCH_ENVSET = "/a/given/path" ] + [ RCH_ENVSET_STR = "something" ] + [ RCH_ENVSET_WITH_COL = "s:mething" ] + [ RCH_ENVSET_ADD += "/a/given/path" ] + [ RCH_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCH_ENVBUILD = "/a/given/path" ] + [ RCH_ENVBUILD_STR = "something" ] + [ RCH_ENVBUILD_WITH_COL = "s:mething" ] + [ RCH_ENVBUILD_ADD += "/a/given/path" ] + [ RCH_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCH_ENV" ] +x-env-path-rewrite: [ + [ RCH_ENVSET ":" "host" ] + [ RCH_ENVSET_STR ":" "host" ] + [ RCH_ENVSET_WITH_COL ":" "host" ] + [ RCH_ENVSET_ADD ":" "host" ] + [ RCH_ENVSET_ADD_WITH_COL ":" "host" ] + + [ RCH_ENVBUILD ":" "host" ] + [ RCH_ENVBUILD_STR ":" "host" ] + [ RCH_ENVBUILD_WITH_COL ":" "host" ] + [ RCH_ENVBUILD_ADD ":" "host" ] + [ RCH_ENVBUILD_ADD_WITH_COL ":" "host" ] +] +### opam install col-host -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-host 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-host: sh env | grep RCH_ENV] ++ sh "-c" "env | grep RCH_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-host.1) +- RCH_ENVBUILD=/a/given/path +- RCH_ENVBUILD_ADD=/a/given/path:a/path/to +- RCH_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted" +- RCH_ENVBUILD_STR=something +- RCH_ENVBUILD_WITH_COL=s:mething +- RCH_ENVSET_ADD=a/path/to +- RCH_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-host.1 +-> installed col-host.1 +Done. +### opam env | grep "RCH_ENV" +RCH_ENVSET='/a/given/path'; export RCH_ENVSET; +RCH_ENVSET_STR='something'; export RCH_ENVSET_STR; +RCH_ENVSET_WITH_COL='s:mething'; export RCH_ENVSET_WITH_COL; +RCH_ENVSET_ADD='/a/given/path:a/path/to'; export RCH_ENVSET_ADD; +RCH_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted"'; export RCH_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCH_ENV +RCH_ENVSET = /a/given/path : host Updated\ by\ package\ col-host +RCH_ENVSET_STR = something : host Updated\ by\ package\ col-host +RCH_ENVSET_WITH_COL = s:mething : host Updated\ by\ package\ col-host +RCH_ENVSET_ADD += /a/given/path : host Updated\ by\ package\ col-host +RCH_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : host Updated\ by\ package\ col-host +### ::::::::::::::::::::::: +### : Colon & host-quoted : +### ::::::::::::::::::::::: +### RCHQ_ENVSET_ADD=a/path/to +### RCHQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCHQ_ENVBUILD_ADD=a/path/to +### RCHQ_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCHQ_ENVSET = "/a/given/path" ] + [ RCHQ_ENVSET_STR = "something" ] + [ RCHQ_ENVSET_WITH_COL = "s:mething" ] + [ RCHQ_ENVSET_ADD += "/a/given/path" ] + [ RCHQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCHQ_ENVBUILD = "/a/given/path" ] + [ RCHQ_ENVBUILD_STR = "something" ] + [ RCHQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RCHQ_ENVBUILD_ADD += "/a/given/path" ] + [ RCHQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCHQ_ENV" ] +x-env-path-rewrite: [ + [ RCHQ_ENVSET ":" "host-quoted" ] + [ RCHQ_ENVSET_STR ":" "host-quoted" ] + [ RCHQ_ENVSET_WITH_COL ":" "host-quoted" ] + [ RCHQ_ENVSET_ADD ":" "host-quoted" ] + [ RCHQ_ENVSET_ADD_WITH_COL ":" "host-quoted" ] + + [ RCHQ_ENVBUILD ":" "host-quoted" ] + [ RCHQ_ENVBUILD_STR ":" "host-quoted" ] + [ RCHQ_ENVBUILD_WITH_COL ":" "host-quoted" ] + [ RCHQ_ENVBUILD_ADD ":" "host-quoted" ] + [ RCHQ_ENVBUILD_ADD_WITH_COL ":" "host-quoted" ] +] +### opam install col-host-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-host-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-host-quoted: sh env | grep RCHQ_ENV] ++ sh "-c" "env | grep RCHQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-host-quoted.1) +- RCHQ_ENVBUILD=/a/given/path +- RCHQ_ENVBUILD_ADD=/a/given/path:a/path/to +- RCHQ_ENVBUILD_ADD_WITH_COL="a:/nother/gi;ven/path":/a/path/to:"t:/his/is/quoted" +- RCHQ_ENVBUILD_STR=something +- RCHQ_ENVBUILD_WITH_COL="s:mething" +- RCHQ_ENVSET_ADD=a/path/to +- RCHQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-host-quoted.1 +-> installed col-host-quoted.1 +Done. +### opam env | grep "RCHQ_ENV" +RCHQ_ENVSET='/a/given/path'; export RCHQ_ENVSET; +RCHQ_ENVSET_STR='something'; export RCHQ_ENVSET_STR; +RCHQ_ENVSET_WITH_COL='"s:mething"'; export RCHQ_ENVSET_WITH_COL; +RCHQ_ENVSET_ADD='/a/given/path:a/path/to'; export RCHQ_ENVSET_ADD; +RCHQ_ENVSET_ADD_WITH_COL='"a:/nother/gi;ven/path":/a/path/to:"t:/his/is/quoted"'; export RCHQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCHQ_ENV +RCHQ_ENVSET = /a/given/path : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_STR = something : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_WITH_COL = s:mething : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_ADD += /a/given/path : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : host-quoted Updated\ by\ package\ col-host-quoted +### RST_ENVSET_ADD=a/path/to +### RST_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RST_ENVBUILD_ADD=a/path/to +### RST_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RST_ENVSET = "/a/given/path" ] + [ RST_ENVSET_STR = "something" ] + [ RST_ENVSET_WITH_COL = "s:mething" ] + [ RST_ENVSET_ADD += "/a/given/path" ] + [ RST_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RST_ENVBUILD = "/a/given/path" ] + [ RST_ENVBUILD_STR = "something" ] + [ RST_ENVBUILD_WITH_COL = "s:mething" ] + [ RST_ENVBUILD_ADD += "/a/given/path" ] + [ RST_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RST_ENV" ] +x-env-path-rewrite: [ + [ RST_ENVSET ";" "target" ] + [ RST_ENVSET_STR ";" "target" ] + [ RST_ENVSET_WITH_COL ";" "target" ] + [ RST_ENVSET_ADD ";" "target" ] + [ RST_ENVSET_ADD_WITH_COL ";" "target" ] + + [ RST_ENVBUILD ";" "target" ] + [ RST_ENVBUILD_STR ";" "target" ] + [ RST_ENVBUILD_WITH_COL ";" "target" ] + [ RST_ENVBUILD_ADD ";" "target" ] + [ RST_ENVBUILD_ADD_WITH_COL ";" "target" ] +] +### opam install semicol-target -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-target 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-target: sh env | grep RST_ENV] ++ sh "-c" "env | grep RST_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-target.1) +- RST_ENVBUILD=/a/given/path +- RST_ENVBUILD_ADD=/a/given/path;a/path/to +- RST_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted" +- RST_ENVBUILD_STR=something +- RST_ENVBUILD_WITH_COL=s:mething +- RST_ENVSET_ADD=a/path/to +- RST_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-target.1 +-> installed semicol-target.1 +Done. +### opam env | grep "RST_ENV" +RST_ENVSET='/a/given/path'; export RST_ENVSET; +RST_ENVSET_STR='something'; export RST_ENVSET_STR; +RST_ENVSET_WITH_COL='s:mething'; export RST_ENVSET_WITH_COL; +RST_ENVSET_ADD='/a/given/path;a/path/to'; export RST_ENVSET_ADD; +RST_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted"'; export RST_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RST_ENV +RST_ENVSET = /a/given/path ; target Updated\ by\ package\ semicol-target +RST_ENVSET_STR = something ; target Updated\ by\ package\ semicol-target +RST_ENVSET_WITH_COL = s:mething ; target Updated\ by\ package\ semicol-target +RST_ENVSET_ADD += /a/given/path ; target Updated\ by\ package\ semicol-target +RST_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; target Updated\ by\ package\ semicol-target +### ::::::::::::::::::::::::::::: +### : SemiColon & target-quoted : +### ::::::::::::::::::::::::::::: +### RSTQ_ENVSET_ADD=a/path/to +### RSTQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSTQ_ENVBUILD_ADD=a/path/to +### RSTQ_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSTQ_ENVSET = "/a/given/path" ] + [ RSTQ_ENVSET_STR = "something" ] + [ RSTQ_ENVSET_WITH_COL = "s:mething" ] + [ RSTQ_ENVSET_ADD += "/a/given/path" ] + [ RSTQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSTQ_ENVBUILD = "/a/given/path" ] + [ RSTQ_ENVBUILD_STR = "something" ] + [ RSTQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RSTQ_ENVBUILD_ADD += "/a/given/path" ] + [ RSTQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSTQ_ENV" ] +x-env-path-rewrite: [ + [ RSTQ_ENVSET ";" "target-quoted" ] + [ RSTQ_ENVSET_STR ";" "target-quoted" ] + [ RSTQ_ENVSET_WITH_COL ";" "target-quoted" ] + [ RSTQ_ENVSET_ADD ";" "target-quoted" ] + [ RSTQ_ENVSET_ADD_WITH_COL ";" "target-quoted" ] + + [ RSTQ_ENVBUILD ";" "target-quoted" ] + [ RSTQ_ENVBUILD_STR ";" "target-quoted" ] + [ RSTQ_ENVBUILD_WITH_COL ";" "target-quoted" ] + [ RSTQ_ENVBUILD_ADD ";" "target-quoted" ] + [ RSTQ_ENVBUILD_ADD_WITH_COL ";" "target-quoted" ] +] +### opam install semicol-target-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-target-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-target-quoted: sh env | grep RSTQ_ENV] ++ sh "-c" "env | grep RSTQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-target-quoted.1) +- RSTQ_ENVBUILD=/a/given/path +- RSTQ_ENVBUILD_ADD=/a/given/path;a/path/to +- RSTQ_ENVBUILD_ADD_WITH_COL="a:/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted" +- RSTQ_ENVBUILD_STR=something +- RSTQ_ENVBUILD_WITH_COL=s:mething +- RSTQ_ENVSET_ADD=a/path/to +- RSTQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-target-quoted.1 +-> installed semicol-target-quoted.1 +Done. +### opam env | grep "RSTQ_ENV" +RSTQ_ENVSET='/a/given/path'; export RSTQ_ENVSET; +RSTQ_ENVSET_STR='something'; export RSTQ_ENVSET_STR; +RSTQ_ENVSET_WITH_COL='s:mething'; export RSTQ_ENVSET_WITH_COL; +RSTQ_ENVSET_ADD='/a/given/path;a/path/to'; export RSTQ_ENVSET_ADD; +RSTQ_ENVSET_ADD_WITH_COL='"a:/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted"'; export RSTQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSTQ_ENV +RSTQ_ENVSET = /a/given/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_STR = something ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_WITH_COL = s:mething ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_ADD += /a/given/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +### :::::::::::::::::::: +### : SemiColon & host : +### :::::::::::::::::::: +### RSH_ENVSET_ADD=a/path/to +### RSH_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSH_ENVBUILD_ADD=a/path/to +### RSH_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSH_ENVSET = "/a/given/path" ] + [ RSH_ENVSET_STR = "something" ] + [ RSH_ENVSET_WITH_COL = "s:mething" ] + [ RSH_ENVSET_ADD += "/a/given/path" ] + [ RSH_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSH_ENVBUILD = "/a/given/path" ] + [ RSH_ENVBUILD_STR = "something" ] + [ RSH_ENVBUILD_WITH_COL = "s:mething" ] + [ RSH_ENVBUILD_ADD += "/a/given/path" ] + [ RSH_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSH_ENV" ] +x-env-path-rewrite: [ + [ RSH_ENVSET ";" "host" ] + [ RSH_ENVSET_STR ";" "host" ] + [ RSH_ENVSET_WITH_COL ";" "host" ] + [ RSH_ENVSET_ADD ";" "host" ] + [ RSH_ENVSET_ADD_WITH_COL ";" "host" ] + + [ RSH_ENVBUILD ";" "host" ] + [ RSH_ENVBUILD_STR ";" "host" ] + [ RSH_ENVBUILD_WITH_COL ";" "host" ] + [ RSH_ENVBUILD_ADD ";" "host" ] + [ RSH_ENVBUILD_ADD_WITH_COL ";" "host" ] +] +### opam install semicol-host -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-host 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-host: sh env | grep RSH_ENV] ++ sh "-c" "env | grep RSH_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-host.1) +- RSH_ENVBUILD=/a/given/path +- RSH_ENVBUILD_ADD=/a/given/path;a/path/to +- RSH_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted" +- RSH_ENVBUILD_STR=something +- RSH_ENVBUILD_WITH_COL=s:mething +- RSH_ENVSET_ADD=a/path/to +- RSH_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-host.1 +-> installed semicol-host.1 +Done. +### opam env | grep "RSH_ENV" +RSH_ENVSET='/a/given/path'; export RSH_ENVSET; +RSH_ENVSET_STR='something'; export RSH_ENVSET_STR; +RSH_ENVSET_WITH_COL='s:mething'; export RSH_ENVSET_WITH_COL; +RSH_ENVSET_ADD='/a/given/path;a/path/to'; export RSH_ENVSET_ADD; +RSH_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted"'; export RSH_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSH_ENV +RSH_ENVSET = /a/given/path ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_STR = something ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_WITH_COL = s:mething ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_ADD += /a/given/path ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; host Updated\ by\ package\ semicol-host +### ::::::::::::::::::::::::::: +### : SemiColon & host-quoted : +### ::::::::::::::::::::::::::: +### RSHQ_ENVSET_ADD=a/path/to +### RSHQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSHQ_ENVBUILD_ADD=a/path/to +### RSHQ_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSHQ_ENVSET = "/a/given/path" ] + [ RSHQ_ENVSET_STR = "something" ] + [ RSHQ_ENVSET_WITH_COL = "s:mething" ] + [ RSHQ_ENVSET_ADD += "/a/given/path" ] + [ RSHQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSHQ_ENVBUILD = "/a/given/path" ] + [ RSHQ_ENVBUILD_STR = "something" ] + [ RSHQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RSHQ_ENVBUILD_ADD += "/a/given/path" ] + [ RSHQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSHQ_ENV" ] +x-env-path-rewrite: [ + [ RSHQ_ENVSET ";" "host-quoted" ] + [ RSHQ_ENVSET_STR ";" "host-quoted" ] + [ RSHQ_ENVSET_WITH_COL ";" "host-quoted" ] + [ RSHQ_ENVSET_ADD ";" "host-quoted" ] + [ RSHQ_ENVSET_ADD_WITH_COL ";" "host-quoted" ] + + [ RSHQ_ENVBUILD ";" "host-quoted" ] + [ RSHQ_ENVBUILD_STR ";" "host-quoted" ] + [ RSHQ_ENVBUILD_WITH_COL ";" "host-quoted" ] + [ RSHQ_ENVBUILD_ADD ";" "host-quoted" ] + [ RSHQ_ENVBUILD_ADD_WITH_COL ";" "host-quoted" ] +] +### opam install semicol-host-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-host-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-host-quoted: sh env | grep RSHQ_ENV] ++ sh "-c" "env | grep RSHQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-host-quoted.1) +- RSHQ_ENVBUILD=/a/given/path +- RSHQ_ENVBUILD_ADD=/a/given/path;a/path/to +- RSHQ_ENVBUILD_ADD_WITH_COL="a:/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted" +- RSHQ_ENVBUILD_STR=something +- RSHQ_ENVBUILD_WITH_COL=s:mething +- RSHQ_ENVSET_ADD=a/path/to +- RSHQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-host-quoted.1 +-> installed semicol-host-quoted.1 +Done. +### opam env | grep "RSHQ_ENV" +RSHQ_ENVSET='/a/given/path'; export RSHQ_ENVSET; +RSHQ_ENVSET_STR='something'; export RSHQ_ENVSET_STR; +RSHQ_ENVSET_WITH_COL='s:mething'; export RSHQ_ENVSET_WITH_COL; +RSHQ_ENVSET_ADD='/a/given/path;a/path/to'; export RSHQ_ENVSET_ADD; +RSHQ_ENVSET_ADD_WITH_COL='"a:/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted"'; export RSHQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSHQ_ENV +RSHQ_ENVSET = /a/given/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_STR = something ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_WITH_COL = s:mething ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_ADD += /a/given/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +### ::::::::: +### : False : +### ::::::::: +### RF_ENVSET_ADD=a/path/to +### RF_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RF_ENVBUILD_ADD=a/path/to +### RF_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RF_ENVSET = "/a/given/path" ] + [ RF_ENVSET_STR = "something" ] + [ RF_ENVSET_WITH_COL = "s:mething" ] + [ RF_ENVSET_ADD += "/a/given/path" ] + [ RF_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RF_ENVBUILD = "/a/given/path" ] + [ RF_ENVBUILD_STR = "something" ] + [ RF_ENVBUILD_WITH_COL = "s:mething" ] + [ RF_ENVBUILD_ADD += "/a/given/path" ] + [ RF_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RF_ENV" ] +x-env-path-rewrite: [ + [ RF_ENVSET false ] + [ RF_ENVSET_STR false ] + [ RF_ENVSET_WITH_COL false ] + [ RF_ENVSET_ADD false ] + [ RF_ENVSET_ADD_WITH_COL false ] + + [ RF_ENVBUILD false ] + [ RF_ENVBUILD_STR false ] + [ RF_ENVBUILD_WITH_COL false ] + [ RF_ENVBUILD_ADD false ] + [ RF_ENVBUILD_ADD_WITH_COL false ] +] +### opam install false -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install false 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [false: sh env | grep RF_ENV] ++ sh "-c" "env | grep RF_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/false.1) +- RF_ENVBUILD=/a/given/path +- RF_ENVBUILD_ADD=/a/given/path:a/path/to +- RF_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted" +- RF_ENVBUILD_STR=something +- RF_ENVBUILD_WITH_COL=s:mething +- RF_ENVSET_ADD=a/path/to +- RF_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled false.1 +-> installed false.1 +Done. +### opam env | grep "RF_ENV" +RF_ENVSET='/a/given/path'; export RF_ENVSET; +RF_ENVSET_STR='something'; export RF_ENVSET_STR; +RF_ENVSET_WITH_COL='s:mething'; export RF_ENVSET_WITH_COL; +RF_ENVSET_ADD='/a/given/path:a/path/to'; export RF_ENVSET_ADD; +RF_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted"'; export RF_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RF_ENV +RF_ENVSET = /a/given/path norewrite Updated\ by\ package\ false +RF_ENVSET_STR = something norewrite Updated\ by\ package\ false +RF_ENVSET_WITH_COL = s:mething norewrite Updated\ by\ package\ false +RF_ENVSET_ADD += /a/given/path norewrite Updated\ by\ package\ false +RF_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path norewrite Updated\ by\ package\ false +### :::::::::::: +### : Complete : +### :::::::::::: +### RO_ENVSET_COL_TARGET=a/path/to +### RO_ENVSET_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +### RO_ENVBUILD_COL_TARGET=a/path/to +### RO_ENVBUILD_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +### +opam-version: "2.0" +setenv: [ + [ RO_ENVSET = "/a/given/path" ] + [ RO_ENVSET_STR = "something" ] + [ RO_ENVSET_STR_WS = "something/else" ] + [ RO_ENVSET_COL = "s:mething" ] + [ RO_ENVSET_COL_TARGET += "a:/nother/gi;ven/path" ] + [ RO_ENVSET_COL_TARGET_QUOTED += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RO_ENVBUILD = "/another/given/path" ] + [ RO_ENVBUILD_STR = "something" ] + [ RO_ENVBUILD_COL = "s:mething" ] + [ RO_ENVBUILD_COL_TARGET += "a:/nother/gi;ven/path" ] + [ RO_ENVBUILD_COL_TARGET_QUOTED += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RO_ENV" ] +x-env-path-rewrite: [ + [ RO_ENVSET ":" "target" ] + [ RO_ENVSET_STR_WS false ] + [ RO_ENVSET_COL ":" "target-quoted" ] + [ RO_ENVSET_COL_TARGET ";" "host" ] + [ RO_ENVSET_COL_TARGET_QUOTED ":" "host-quoted" ] + + [ RO_ENVBUILD ":" "target" ] + [ RO_ENVBUILD_STR_WS false ] + [ RO_ENVBUILD_COL ":" "target" ] + [ RO_ENVBUILD_COL_TARGET ";" "host" ] + [ RO_ENVBUILD_COL_TARGET_QUOTED ":" "host-quoted" ] +] +### cat OPAM/rewriting/.opam-switch/environment | grep RO_ENV +### opam install rewrite -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install rewrite 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [rewrite: sh env | grep RO_ENV] ++ sh "-c" "env | grep RO_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/rewrite.1) +- RO_ENVBUILD=/another/given/path +- RO_ENVBUILD_COL=s:mething +- RO_ENVBUILD_COL_TARGET=a:/nother/gi;ven/path;a/path/to +- RO_ENVBUILD_COL_TARGET_QUOTED="a:/nother/gi;ven/path":a/path/to:"this/i:s/quoted" +- RO_ENVBUILD_STR=something +- RO_ENVSET_COL_TARGET=a/path/to +- RO_ENVSET_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +-> compiled rewrite.1 +-> installed rewrite.1 +Done. +### opam env | grep "RO_ENV" +RO_ENVSET='/a/given/path'; export RO_ENVSET; +RO_ENVSET_STR='something'; export RO_ENVSET_STR; +RO_ENVSET_STR_WS='something/else'; export RO_ENVSET_STR_WS; +RO_ENVSET_COL='"s:mething"'; export RO_ENVSET_COL; +RO_ENVSET_COL_TARGET='a:/nother/gi;ven/path;a/path/to'; export RO_ENVSET_COL_TARGET; +RO_ENVSET_COL_TARGET_QUOTED='"a:/nother/gi;ven/path":a/path/to:"this/i:s/quoted"'; export RO_ENVSET_COL_TARGET_QUOTED; +### cat OPAM/rewriting/.opam-switch/environment | grep RO_ENV +RO_ENVSET = /a/given/path : target Updated\ by\ package\ rewrite +RO_ENVSET_STR = something Updated\ by\ package\ rewrite +RO_ENVSET_STR_WS = something/else norewrite Updated\ by\ package\ rewrite +RO_ENVSET_COL = s:mething : target-quoted Updated\ by\ package\ rewrite +RO_ENVSET_COL_TARGET += a:/nother/gi;ven/path ; host Updated\ by\ package\ rewrite +RO_ENVSET_COL_TARGET_QUOTED += a:/nother/gi;ven/path : host-quoted Updated\ by\ package\ rewrite +### :::::::::::::::: +### : All formulae : +### :::::::::::::::: +### +opam-version: "2.0" +setenv: [ + [ RAF_ENVSET_TRUE = "/is/true" ] + [ RAF_ENVSET_FALSE = "/is/false" ] + [ RAF_ENVSET_ATOM = "/is/atom" ] + [ RAF_ENVSET_UNRES = "/is/unresolved" ] + [ RAF_ENVSET_RES = "/is/resolved" ] + [ RAF_ENVSET_DBL += "fir/st" ] + [ RAF_ENVSET_DBL += "sec/ond" ] +] +build: [ "sh" "-c" "env | grep RAF_ENV" ] +build-env: [ + [ RAF_ENVBUILD_TRUE = "/is/true" ] + [ RAF_ENVBUILD_FALSE = "/is/false" ] + [ RAF_ENVBUILD_ATOM = "/is/atom" ] + [ RAF_ENVBUILD_UNRES = "/is/unresolved" ] + [ RAF_ENVBUILD_RES = "/is/resolved" ] +] +x-env-path-rewrite: [ + [ RAF_ENVBUILD_TRUE true ] + [ RAF_ENVBUILD_FALSE false ] + [ RAF_ENVBUILD_ATOM ":" ("target-quoted") ] + [ RAF_ENVBUILD_UNRES ":" | ";" ("host" | "target-quoted")] + [ RAF_ENVBUILD_RES + (":" { os = "some-os" } | ";" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | ";" ) + ("target" { os = "some-os" } | "host" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | "host" ) + ] + + [ RAF_ENVSET_TRUE true ] + [ RAF_ENVSET_FALSE false ] + [ RAF_ENVSET_ATOM ":" ("target-quoted") ] + [ RAF_ENVSET_UNRES ":" | ";" ("host" | "target-quoted")] + [ RAF_ENVSET_RES + (":" { os = "some-os" } | ";" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | ";" ) + ("target" { os = "some-os" } | "host" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | "host" ) + ] +] +### opam install all-formulae -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install all-formulae 1 +[ERROR] Formula can't be completely resolved : RAF_ENVBUILD_UNRES ":" true | ";" true. Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVBUILD_UNRES ("host" true | "target-quoted" true). Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ':' 'target'. +Processing 2/3: [all-formulae: sh env | grep RAF_ENV] ++ sh "-c" "env | grep RAF_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/all-formulae.1) +- RAF_ENVBUILD_ATOM=/is/atom +- RAF_ENVBUILD_FALSE=/is/false +- RAF_ENVBUILD_RES=/is/resolved +- RAF_ENVBUILD_TRUE=/is/true +- RAF_ENVBUILD_UNRES=/is/unresolved +-> compiled all-formulae.1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +-> installed all-formulae.1 +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ':' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ':' 'target'. +Done. +### opam env | grep "RAF_ENV" +RAF_ENVSET_TRUE='/is/true'; export RAF_ENVSET_TRUE; +RAF_ENVSET_FALSE='/is/false'; export RAF_ENVSET_FALSE; +RAF_ENVSET_ATOM='/is/atom'; export RAF_ENVSET_ATOM; +RAF_ENVSET_UNRES='/is/unresolved'; export RAF_ENVSET_UNRES; +RAF_ENVSET_RES='/is/resolved'; export RAF_ENVSET_RES; +RAF_ENVSET_DBL='sec/ond:fir/st'; export RAF_ENVSET_DBL; +### cat OPAM/rewriting/.opam-switch/environment | grep RAF_ENV +RAF_ENVSET_TRUE = /is/true Updated\ by\ package\ all-formulae +RAF_ENVSET_FALSE = /is/false norewrite Updated\ by\ package\ all-formulae +RAF_ENVSET_ATOM = /is/atom : target-quoted Updated\ by\ package\ all-formulae +RAF_ENVSET_UNRES = /is/unresolved Updated\ by\ package\ all-formulae +RAF_ENVSET_RES = /is/resolved ; host Updated\ by\ package\ all-formulae +RAF_ENVSET_DBL += fir/st Updated\ by\ package\ all-formulae +RAF_ENVSET_DBL += sec/ond Updated\ by\ package\ all-formulae diff --git a/tests/reftests/env.win32.test b/tests/reftests/env.win32.test index 93328aa3053..44e4fc06ee1 100644 --- a/tests/reftests/env.win32.test +++ b/tests/reftests/env.win32.test @@ -1,16 +1,763 @@ N0REP0 -### +### : setenv & build env rewriting : +### opam switch create rewriting --empty +### ::::::::::::::::::: +### : Column & target : +### ::::::::::::::::::: +### RCT_ENVSET_ADD=a/path/to +### RCT_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCT_ENVBUILD_ADD=a/path/to +### RCT_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### opam-version: "2.0" -setenv: [ Foo += "bar" ] -### opam switch create --empty test -### FOO=foo -### opam install vne +setenv: [ + [ RCT_ENVSET = "/a/given/path" ] + [ RCT_ENVSET_STR = "something" ] + [ RCT_ENVSET_WITH_COL = "s:mething" ] + [ RCT_ENVSET_ADD += "/a/given/path" ] + [ RCT_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCT_ENVBUILD = "/a/given/path" ] + [ RCT_ENVBUILD_STR = "something" ] + [ RCT_ENVBUILD_WITH_COL = "s:mething" ] + [ RCT_ENVBUILD_ADD += "/a/given/path" ] + [ RCT_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCT_ENV" ] +x-env-path-rewrite: [ + [ RCT_ENVSET ":" "target" ] + [ RCT_ENVSET_STR ":" "target" ] + [ RCT_ENVSET_WITH_COL ":" "target" ] + [ RCT_ENVSET_ADD ":" "target" ] + [ RCT_ENVSET_ADD_WITH_COL ":" "target" ] + + [ RCT_ENVBUILD ":" "target" ] + [ RCT_ENVBUILD_STR ":" "target" ] + [ RCT_ENVBUILD_WITH_COL ":" "target" ] + [ RCT_ENVBUILD_ADD ":" "target" ] + [ RCT_ENVBUILD_ADD_WITH_COL ":" "target" ] +] +### opam install col-target -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-target 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-target: sh env | grep RCT_ENV] ++ sh "-c" "env | grep RCT_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-target.1) +- RCT_ENVBUILD=\a\given\path +- RCT_ENVBUILD_ADD=\a\given\path:a/path/to +- RCT_ENVBUILD_ADD_WITH_COL=a:\nother\gi;ven\path:/a/path/to:"t:/his/is/quoted" +- RCT_ENVBUILD_STR=something +- RCT_ENVBUILD_WITH_COL=s:mething +- RCT_ENVSET_ADD=a/path/to +- RCT_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-target.1 +-> installed col-target.1 +Done. +### opam env | grep "RCT_ENV" +RCT_ENVSET='\a\given\path'; export RCT_ENVSET; +RCT_ENVSET_STR='something'; export RCT_ENVSET_STR; +RCT_ENVSET_WITH_COL='s:mething'; export RCT_ENVSET_WITH_COL; +RCT_ENVSET_ADD='\a\given\path:a/path/to'; export RCT_ENVSET_ADD; +RCT_ENVSET_ADD_WITH_COL='a:\nother\gi;ven\path:/a/path/to:"t:/his/is/quoted"'; export RCT_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCT_ENV +RCT_ENVSET = /a/given/path : target Updated\ by\ package\ col-target +RCT_ENVSET_STR = something : target Updated\ by\ package\ col-target +RCT_ENVSET_WITH_COL = s:mething : target Updated\ by\ package\ col-target +RCT_ENVSET_ADD += /a/given/path : target Updated\ by\ package\ col-target +RCT_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : target Updated\ by\ package\ col-target +### :::::::::::::::::::::::::: +### : Column & target-quoted : +### :::::::::::::::::::::::::: +### RCTQ_ENVSET_ADD=a/path/to +### RCTQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCTQ_ENVBUILD_ADD=a/path/to +### RCTQ_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCTQ_ENVSET = "/a/given/path" ] + [ RCTQ_ENVSET_STR = "something" ] + [ RCTQ_ENVSET_WITH_COL = "s:mething" ] + [ RCTQ_ENVSET_ADD += "/a/given/path" ] + [ RCTQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCTQ_ENVBUILD = "/a/given/path" ] + [ RCTQ_ENVBUILD_STR = "something" ] + [ RCTQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RCTQ_ENVBUILD_ADD += "/a/given/path" ] + [ RCTQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCTQ_ENV" ] +x-env-path-rewrite: [ + [ RCTQ_ENVSET ":" "target-quoted" ] + [ RCTQ_ENVSET_STR ":" "target-quoted" ] + [ RCTQ_ENVSET_WITH_COL ":" "target-quoted" ] + [ RCTQ_ENVSET_ADD ":" "target-quoted" ] + [ RCTQ_ENVSET_ADD_WITH_COL ":" "target-quoted" ] + + [ RCTQ_ENVBUILD ":" "target-quoted" ] + [ RCTQ_ENVBUILD_STR ":" "target-quoted" ] + [ RCTQ_ENVBUILD_WITH_COL ":" "target-quoted" ] + [ RCTQ_ENVBUILD_ADD ":" "target-quoted" ] + [ RCTQ_ENVBUILD_ADD_WITH_COL ":" "target-quoted" ] +] +### opam install col-target-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-target-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-target-quoted: sh env | grep RCTQ_ENV] ++ sh "-c" "env | grep RCTQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-target-quoted.1) +- RCTQ_ENVBUILD=\a\given\path +- RCTQ_ENVBUILD_ADD=\a\given\path:a/path/to +- RCTQ_ENVBUILD_ADD_WITH_COL="a:\nother\gi;ven\path":/a/path/to:"t:/his/is/quoted" +- RCTQ_ENVBUILD_STR=something +- RCTQ_ENVBUILD_WITH_COL="s:mething" +- RCTQ_ENVSET_ADD=a/path/to +- RCTQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-target-quoted.1 +-> installed col-target-quoted.1 +Done. +### opam env | grep "RCTQ_ENV" +RCTQ_ENVSET='\a\given\path'; export RCTQ_ENVSET; +RCTQ_ENVSET_STR='something'; export RCTQ_ENVSET_STR; +RCTQ_ENVSET_WITH_COL='"s:mething"'; export RCTQ_ENVSET_WITH_COL; +RCTQ_ENVSET_ADD='\a\given\path:a/path/to'; export RCTQ_ENVSET_ADD; +RCTQ_ENVSET_ADD_WITH_COL='"a:\nother\gi;ven\path":/a/path/to:"t:/his/is/quoted"'; export RCTQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCTQ_ENV +RCTQ_ENVSET = /a/given/path : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_STR = something : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_WITH_COL = s:mething : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_ADD += /a/given/path : target-quoted Updated\ by\ package\ col-target-quoted +RCTQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : target-quoted Updated\ by\ package\ col-target-quoted +### ::::::::::::::::: +### : Column & host : +### ::::::::::::::::: +### RCH_ENVSET_ADD=a/path/to +### RCH_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCH_ENVBUILD_ADD=a/path/to +### RCH_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCH_ENVSET = "/a/given/path" ] + [ RCH_ENVSET_STR = "something" ] + [ RCH_ENVSET_WITH_COL = "s:mething" ] + [ RCH_ENVSET_ADD += "/a/given/path" ] + [ RCH_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCH_ENVBUILD = "/a/given/path" ] + [ RCH_ENVBUILD_STR = "something" ] + [ RCH_ENVBUILD_WITH_COL = "s:mething" ] + [ RCH_ENVBUILD_ADD += "/a/given/path" ] + [ RCH_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCH_ENV" ] +x-env-path-rewrite: [ + [ RCH_ENVSET ":" "host" ] + [ RCH_ENVSET_STR ":" "host" ] + [ RCH_ENVSET_WITH_COL ":" "host" ] + [ RCH_ENVSET_ADD ":" "host" ] + [ RCH_ENVSET_ADD_WITH_COL ":" "host" ] + + [ RCH_ENVBUILD ":" "host" ] + [ RCH_ENVBUILD_STR ":" "host" ] + [ RCH_ENVBUILD_WITH_COL ":" "host" ] + [ RCH_ENVBUILD_ADD ":" "host" ] + [ RCH_ENVBUILD_ADD_WITH_COL ":" "host" ] +] +### opam install col-host -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-host 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-host: sh env | grep RCH_ENV] ++ sh "-c" "env | grep RCH_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-host.1) +- RCH_ENVBUILD=/a/given/path +- RCH_ENVBUILD_ADD=/a/given/path:a/path/to +- RCH_ENVBUILD_ADD_WITH_COL=/cygdrive/a/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted" +- RCH_ENVBUILD_STR=something +- RCH_ENVBUILD_WITH_COL=s:mething +- RCH_ENVSET_ADD=a/path/to +- RCH_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-host.1 +-> installed col-host.1 +Done. +### opam env | grep "RCH_ENV" +RCH_ENVSET='/a/given/path'; export RCH_ENVSET; +RCH_ENVSET_STR='something'; export RCH_ENVSET_STR; +RCH_ENVSET_WITH_COL='s:mething'; export RCH_ENVSET_WITH_COL; +RCH_ENVSET_ADD='/a/given/path:a/path/to'; export RCH_ENVSET_ADD; +RCH_ENVSET_ADD_WITH_COL='/cygdrive/a/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted"'; export RCH_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCH_ENV +RCH_ENVSET = /a/given/path : host Updated\ by\ package\ col-host +RCH_ENVSET_STR = something : host Updated\ by\ package\ col-host +RCH_ENVSET_WITH_COL = s:mething : host Updated\ by\ package\ col-host +RCH_ENVSET_ADD += /a/given/path : host Updated\ by\ package\ col-host +RCH_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : host Updated\ by\ package\ col-host +### :::::::::::::::::::::::: +### : Column & host-quoted : +### :::::::::::::::::::::::: +### RCHQ_ENVSET_ADD=a/path/to +### RCHQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RCHQ_ENVBUILD_ADD=a/path/to +### RCHQ_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RCHQ_ENVSET = "/a/given/path" ] + [ RCHQ_ENVSET_STR = "something" ] + [ RCHQ_ENVSET_WITH_COL = "s:mething" ] + [ RCHQ_ENVSET_ADD += "/a/given/path" ] + [ RCHQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RCHQ_ENVBUILD = "/a/given/path" ] + [ RCHQ_ENVBUILD_STR = "something" ] + [ RCHQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RCHQ_ENVBUILD_ADD += "/a/given/path" ] + [ RCHQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RCHQ_ENV" ] +x-env-path-rewrite: [ + [ RCHQ_ENVSET ":" "host-quoted" ] + [ RCHQ_ENVSET_STR ":" "host-quoted" ] + [ RCHQ_ENVSET_WITH_COL ":" "host-quoted" ] + [ RCHQ_ENVSET_ADD ":" "host-quoted" ] + [ RCHQ_ENVSET_ADD_WITH_COL ":" "host-quoted" ] + + [ RCHQ_ENVBUILD ":" "host-quoted" ] + [ RCHQ_ENVBUILD_STR ":" "host-quoted" ] + [ RCHQ_ENVBUILD_WITH_COL ":" "host-quoted" ] + [ RCHQ_ENVBUILD_ADD ":" "host-quoted" ] + [ RCHQ_ENVBUILD_ADD_WITH_COL ":" "host-quoted" ] +] +### opam install col-host-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install col-host-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [col-host-quoted: sh env | grep RCHQ_ENV] ++ sh "-c" "env | grep RCHQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/col-host-quoted.1) +- RCHQ_ENVBUILD=/a/given/path +- RCHQ_ENVBUILD_ADD=/a/given/path:a/path/to +- RCHQ_ENVBUILD_ADD_WITH_COL=/cygdrive/a/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted" +- RCHQ_ENVBUILD_STR=something +- RCHQ_ENVBUILD_WITH_COL="s:mething" +- RCHQ_ENVSET_ADD=a/path/to +- RCHQ_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled col-host-quoted.1 +-> installed col-host-quoted.1 +Done. +### opam env | grep "RCHQ_ENV" +RCHQ_ENVSET='/a/given/path'; export RCHQ_ENVSET; +RCHQ_ENVSET_STR='something'; export RCHQ_ENVSET_STR; +RCHQ_ENVSET_WITH_COL='"s:mething"'; export RCHQ_ENVSET_WITH_COL; +RCHQ_ENVSET_ADD='/a/given/path:a/path/to'; export RCHQ_ENVSET_ADD; +RCHQ_ENVSET_ADD_WITH_COL='/cygdrive/a/nother/gi;ven/path:/a/path/to:"t:/his/is/quoted"'; export RCHQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RCHQ_ENV +RCHQ_ENVSET = /a/given/path : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_STR = something : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_WITH_COL = s:mething : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_ADD += /a/given/path : host-quoted Updated\ by\ package\ col-host-quoted +RCHQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path : host-quoted Updated\ by\ package\ col-host-quoted +### ::::::::::::::::::::::: +### : SemiColumn & target : +### ::::::::::::::::::::::: +### RST_ENVSET_ADD=a/path/to +### RST_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RST_ENVBUILD_ADD=a/path/to +### RST_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RST_ENVSET = "/a/given/path" ] + [ RST_ENVSET_STR = "something" ] + [ RST_ENVSET_WITH_COL = "s:mething" ] + [ RST_ENVSET_ADD += "/a/given/path" ] + [ RST_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RST_ENVBUILD = "/a/given/path" ] + [ RST_ENVBUILD_STR = "something" ] + [ RST_ENVBUILD_WITH_COL = "s:mething" ] + [ RST_ENVBUILD_ADD += "/a/given/path" ] + [ RST_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RST_ENV" ] +x-env-path-rewrite: [ + [ RST_ENVSET ";" "target" ] + [ RST_ENVSET_STR ";" "target" ] + [ RST_ENVSET_WITH_COL ";" "target" ] + [ RST_ENVSET_ADD ";" "target" ] + [ RST_ENVSET_ADD_WITH_COL ";" "target" ] + + [ RST_ENVBUILD ";" "target" ] + [ RST_ENVBUILD_STR ";" "target" ] + [ RST_ENVBUILD_WITH_COL ";" "target" ] + [ RST_ENVBUILD_ADD ";" "target" ] + [ RST_ENVBUILD_ADD_WITH_COL ";" "target" ] +] +### opam install semicol-target -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-target 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-target: sh env | grep RST_ENV] ++ sh "-c" "env | grep RST_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-target.1) +- RST_ENVBUILD=\a\given\path +- RST_ENVBUILD_ADD=\a\given\path;a/path/to +- RST_ENVBUILD_ADD_WITH_COL=a:\nother\gi;ven\path;/a/path/to;"t:/his/is/quoted" +- RST_ENVBUILD_STR=something +- RST_ENVBUILD_WITH_COL=s:mething +- RST_ENVSET_ADD=a/path/to +- RST_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-target.1 +-> installed semicol-target.1 +Done. +### opam env | grep "RST_ENV" +RST_ENVSET='\a\given\path'; export RST_ENVSET; +RST_ENVSET_STR='something'; export RST_ENVSET_STR; +RST_ENVSET_WITH_COL='s:mething'; export RST_ENVSET_WITH_COL; +RST_ENVSET_ADD='\a\given\path;a/path/to'; export RST_ENVSET_ADD; +RST_ENVSET_ADD_WITH_COL='a:\nother\gi;ven\path;/a/path/to;"t:/his/is/quoted"'; export RST_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RST_ENV +RST_ENVSET = /a/given/path ; target Updated\ by\ package\ semicol-target +RST_ENVSET_STR = something ; target Updated\ by\ package\ semicol-target +RST_ENVSET_WITH_COL = s:mething ; target Updated\ by\ package\ semicol-target +RST_ENVSET_ADD += /a/given/path ; target Updated\ by\ package\ semicol-target +RST_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; target Updated\ by\ package\ semicol-target +### :::::::::::::::::::::::::::::: +### : SemiColumn & target-quoted : +### :::::::::::::::::::::::::::::: +### RSTQ_ENVSET_ADD=a/path/to +### RSTQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSTQ_ENVBUILD_ADD=a/path/to +### RSTQ_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSTQ_ENVSET = "/a/given/path" ] + [ RSTQ_ENVSET_STR = "something" ] + [ RSTQ_ENVSET_WITH_COL = "s:mething" ] + [ RSTQ_ENVSET_ADD += "/a/given/path" ] + [ RSTQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSTQ_ENVBUILD = "/a/given/path" ] + [ RSTQ_ENVBUILD_STR = "something" ] + [ RSTQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RSTQ_ENVBUILD_ADD += "/a/given/path" ] + [ RSTQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSTQ_ENV" ] +x-env-path-rewrite: [ + [ RSTQ_ENVSET ";" "target-quoted" ] + [ RSTQ_ENVSET_STR ";" "target-quoted" ] + [ RSTQ_ENVSET_WITH_COL ";" "target-quoted" ] + [ RSTQ_ENVSET_ADD ";" "target-quoted" ] + [ RSTQ_ENVSET_ADD_WITH_COL ";" "target-quoted" ] + + [ RSTQ_ENVBUILD ";" "target-quoted" ] + [ RSTQ_ENVBUILD_STR ";" "target-quoted" ] + [ RSTQ_ENVBUILD_WITH_COL ";" "target-quoted" ] + [ RSTQ_ENVBUILD_ADD ";" "target-quoted" ] + [ RSTQ_ENVBUILD_ADD_WITH_COL ";" "target-quoted" ] +] +### opam install semicol-target-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-target-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-target-quoted: sh env | grep RSTQ_ENV] ++ sh "-c" "env | grep RSTQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-target-quoted.1) +- RSTQ_ENVBUILD=\a\given\path +- RSTQ_ENVBUILD_ADD=\a\given\path;a/path/to +- RSTQ_ENVBUILD_ADD_WITH_COL="a:\nother\gi;ven\path";/a/path/to;"t:/his/is/quoted" +- RSTQ_ENVBUILD_STR=something +- RSTQ_ENVBUILD_WITH_COL=s:mething +- RSTQ_ENVSET_ADD=a/path/to +- RSTQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-target-quoted.1 +-> installed semicol-target-quoted.1 +Done. +### opam env | grep "RSTQ_ENV" +RSTQ_ENVSET='\a\given\path'; export RSTQ_ENVSET; +RSTQ_ENVSET_STR='something'; export RSTQ_ENVSET_STR; +RSTQ_ENVSET_WITH_COL='s:mething'; export RSTQ_ENVSET_WITH_COL; +RSTQ_ENVSET_ADD='\a\given\path;a/path/to'; export RSTQ_ENVSET_ADD; +RSTQ_ENVSET_ADD_WITH_COL='"a:\nother\gi;ven\path";/a/path/to;"t:/his/is/quoted"'; export RSTQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSTQ_ENV +RSTQ_ENVSET = /a/given/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_STR = something ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_WITH_COL = s:mething ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_ADD += /a/given/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +RSTQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; target-quoted Updated\ by\ package\ semicol-target-quoted +### ::::::::::::::::::::: +### : SemiColumn & host : +### ::::::::::::::::::::: +### RSH_ENVSET_ADD=a/path/to +### RSH_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSH_ENVBUILD_ADD=a/path/to +### RSH_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSH_ENVSET = "/a/given/path" ] + [ RSH_ENVSET_STR = "something" ] + [ RSH_ENVSET_WITH_COL = "s:mething" ] + [ RSH_ENVSET_ADD += "/a/given/path" ] + [ RSH_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSH_ENVBUILD = "/a/given/path" ] + [ RSH_ENVBUILD_STR = "something" ] + [ RSH_ENVBUILD_WITH_COL = "s:mething" ] + [ RSH_ENVBUILD_ADD += "/a/given/path" ] + [ RSH_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSH_ENV" ] +x-env-path-rewrite: [ + [ RSH_ENVSET ";" "host" ] + [ RSH_ENVSET_STR ";" "host" ] + [ RSH_ENVSET_WITH_COL ";" "host" ] + [ RSH_ENVSET_ADD ";" "host" ] + [ RSH_ENVSET_ADD_WITH_COL ";" "host" ] + + [ RSH_ENVBUILD ";" "host" ] + [ RSH_ENVBUILD_STR ";" "host" ] + [ RSH_ENVBUILD_WITH_COL ";" "host" ] + [ RSH_ENVBUILD_ADD ";" "host" ] + [ RSH_ENVBUILD_ADD_WITH_COL ";" "host" ] +] +### opam install semicol-host -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-host 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-host: sh env | grep RSH_ENV] ++ sh "-c" "env | grep RSH_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-host.1) +- RSH_ENVBUILD=/a/given/path +- RSH_ENVBUILD_ADD=/a/given/path;a/path/to +- RSH_ENVBUILD_ADD_WITH_COL=/cygdrive/a/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted" +- RSH_ENVBUILD_STR=something +- RSH_ENVBUILD_WITH_COL=s:mething +- RSH_ENVSET_ADD=a/path/to +- RSH_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-host.1 +-> installed semicol-host.1 +Done. +### opam env | grep "RSH_ENV" +RSH_ENVSET='/a/given/path'; export RSH_ENVSET; +RSH_ENVSET_STR='something'; export RSH_ENVSET_STR; +RSH_ENVSET_WITH_COL='s:mething'; export RSH_ENVSET_WITH_COL; +RSH_ENVSET_ADD='/a/given/path;a/path/to'; export RSH_ENVSET_ADD; +RSH_ENVSET_ADD_WITH_COL='/cygdrive/a/nother/gi;ven/path;/a/path/to;"t:/his/is/quoted"'; export RSH_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSH_ENV +RSH_ENVSET = /a/given/path ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_STR = something ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_WITH_COL = s:mething ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_ADD += /a/given/path ; host Updated\ by\ package\ semicol-host +RSH_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; host Updated\ by\ package\ semicol-host +### :::::::::::::::::::::::::::: +### : SemiColumn & host-quoted : +### :::::::::::::::::::::::::::: +### RSHQ_ENVSET_ADD=a/path/to +### RSHQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### RSHQ_ENVBUILD_ADD=a/path/to +### RSHQ_ENVBUILD_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RSHQ_ENVSET = "/a/given/path" ] + [ RSHQ_ENVSET_STR = "something" ] + [ RSHQ_ENVSET_WITH_COL = "s:mething" ] + [ RSHQ_ENVSET_ADD += "/a/given/path" ] + [ RSHQ_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RSHQ_ENVBUILD = "/a/given/path" ] + [ RSHQ_ENVBUILD_STR = "something" ] + [ RSHQ_ENVBUILD_WITH_COL = "s:mething" ] + [ RSHQ_ENVBUILD_ADD += "/a/given/path" ] + [ RSHQ_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RSHQ_ENV" ] +x-env-path-rewrite: [ + [ RSHQ_ENVSET ";" "host-quoted" ] + [ RSHQ_ENVSET_STR ";" "host-quoted" ] + [ RSHQ_ENVSET_WITH_COL ";" "host-quoted" ] + [ RSHQ_ENVSET_ADD ";" "host-quoted" ] + [ RSHQ_ENVSET_ADD_WITH_COL ";" "host-quoted" ] + + [ RSHQ_ENVBUILD ";" "host-quoted" ] + [ RSHQ_ENVBUILD_STR ";" "host-quoted" ] + [ RSHQ_ENVBUILD_WITH_COL ";" "host-quoted" ] + [ RSHQ_ENVBUILD_ADD ";" "host-quoted" ] + [ RSHQ_ENVBUILD_ADD_WITH_COL ";" "host-quoted" ] +] +### opam install semicol-host-quoted -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install semicol-host-quoted 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [semicol-host-quoted: sh env | grep RSHQ_ENV] ++ sh "-c" "env | grep RSHQ_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/semicol-host-quoted.1) +- RSHQ_ENVBUILD=/a/given/path +- RSHQ_ENVBUILD_ADD=/a/given/path;a/path/to +- RSHQ_ENVBUILD_ADD_WITH_COL="/cygdrive/a/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted" +- RSHQ_ENVBUILD_STR=something +- RSHQ_ENVBUILD_WITH_COL=s:mething +- RSHQ_ENVSET_ADD=a/path/to +- RSHQ_ENVSET_ADD_WITH_COL=/a/path/to;"t:/his/is/quoted" +-> compiled semicol-host-quoted.1 +-> installed semicol-host-quoted.1 +Done. +### opam env | grep "RSHQ_ENV" +RSHQ_ENVSET='/a/given/path'; export RSHQ_ENVSET; +RSHQ_ENVSET_STR='something'; export RSHQ_ENVSET_STR; +RSHQ_ENVSET_WITH_COL='s:mething'; export RSHQ_ENVSET_WITH_COL; +RSHQ_ENVSET_ADD='/a/given/path;a/path/to'; export RSHQ_ENVSET_ADD; +RSHQ_ENVSET_ADD_WITH_COL='"/cygdrive/a/nother/gi;ven/path";/a/path/to;"t:/his/is/quoted"'; export RSHQ_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RSHQ_ENV +RSHQ_ENVSET = /a/given/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_STR = something ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_WITH_COL = s:mething ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_ADD += /a/given/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +RSHQ_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path ; host-quoted Updated\ by\ package\ semicol-host-quoted +### ::::::::: +### : False : +### ::::::::: +### RF_ENVSET_ADD=a/path/to +### RF_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### RF_ENVBUILD_ADD=a/path/to +### RF_ENVBUILD_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +### +opam-version: "2.0" +setenv: [ + [ RF_ENVSET = "/a/given/path" ] + [ RF_ENVSET_STR = "something" ] + [ RF_ENVSET_WITH_COL = "s:mething" ] + [ RF_ENVSET_ADD += "/a/given/path" ] + [ RF_ENVSET_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RF_ENVBUILD = "/a/given/path" ] + [ RF_ENVBUILD_STR = "something" ] + [ RF_ENVBUILD_WITH_COL = "s:mething" ] + [ RF_ENVBUILD_ADD += "/a/given/path" ] + [ RF_ENVBUILD_ADD_WITH_COL += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RF_ENV" ] +x-env-path-rewrite: [ + [ RF_ENVSET false ] + [ RF_ENVSET_STR false ] + [ RF_ENVSET_WITH_COL false ] + [ RF_ENVSET_ADD false ] + [ RF_ENVSET_ADD_WITH_COL false ] + + [ RF_ENVBUILD false ] + [ RF_ENVBUILD_STR false ] + [ RF_ENVBUILD_WITH_COL false ] + [ RF_ENVBUILD_ADD false ] + [ RF_ENVBUILD_ADD_WITH_COL false ] +] +### opam install false -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install false 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [false: sh env | grep RF_ENV] ++ sh "-c" "env | grep RF_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/false.1) +- RF_ENVBUILD=/a/given/path +- RF_ENVBUILD_ADD=/a/given/path;a/path/to +- RF_ENVBUILD_ADD_WITH_COL=a:/nother/gi;ven/path;/a/path/to:"t:/his/is/quoted" +- RF_ENVBUILD_STR=something +- RF_ENVBUILD_WITH_COL=s:mething +- RF_ENVSET_ADD=a/path/to +- RF_ENVSET_ADD_WITH_COL=/a/path/to:"t:/his/is/quoted" +-> compiled false.1 +-> installed false.1 +Done. +### opam env | grep "RF_ENV" +RF_ENVSET='/a/given/path'; export RF_ENVSET; +RF_ENVSET_STR='something'; export RF_ENVSET_STR; +RF_ENVSET_WITH_COL='s:mething'; export RF_ENVSET_WITH_COL; +RF_ENVSET_ADD='/a/given/path;a/path/to'; export RF_ENVSET_ADD; +RF_ENVSET_ADD_WITH_COL='a:/nother/gi;ven/path;/a/path/to:"t:/his/is/quoted"'; export RF_ENVSET_ADD_WITH_COL; +### cat OPAM/rewriting/.opam-switch/environment | grep RF_ENV +RF_ENVSET = /a/given/path norewrite Updated\ by\ package\ false +RF_ENVSET_STR = something norewrite Updated\ by\ package\ false +RF_ENVSET_WITH_COL = s:mething norewrite Updated\ by\ package\ false +RF_ENVSET_ADD += /a/given/path norewrite Updated\ by\ package\ false +RF_ENVSET_ADD_WITH_COL += a:/nother/gi;ven/path norewrite Updated\ by\ package\ false +### :::::::::::: +### : Complete : +### :::::::::::: +### RO_ENVSET_COL_TARGET=a/path/to +### RO_ENVSET_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +### RO_ENVBUILD_COL_TARGET=a/path/to +### RO_ENVBUILD_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +### +opam-version: "2.0" +setenv: [ + [ RO_ENVSET = "/a/given/path" ] + [ RO_ENVSET_STR = "something" ] + [ RO_ENVSET_STR_WS = "something/else" ] + [ RO_ENVSET_STR_WS2 = "something/else" ] + [ RO_ENVSET_COL = "s:mething" ] + [ RO_ENVSET_COL_TARGET += "a:/nother/gi;ven/path" ] + [ RO_ENVSET_COL_TARGET_QUOTED += "a:/nother/gi;ven/path" ] +] +build-env: [ + [ RO_ENVBUILD = "/another/given/path" ] + [ RO_ENVBUILD_STR = "something" ] + [ RO_ENVBUILD_COL = "s:mething" ] + [ RO_ENVBUILD_COL_TARGET += "a:/nother/gi;ven/path" ] + [ RO_ENVBUILD_COL_TARGET_QUOTED += "a:/nother/gi;ven/path" ] +] +build: [ "sh" "-c" "env | grep RO_ENV" ] +x-env-path-rewrite: [ + [ RO_ENVSET ":" "target" ] + [ RO_ENVSET_STR_WS false ] + [ RO_ENVSET_STR_WS2 true ] + [ RO_ENVSET_COL ":" "target-quoted" ] + [ RO_ENVSET_COL_TARGET ";" "host" ] + [ RO_ENVSET_COL_TARGET_QUOTED ":" "host-quoted" ] + + [ RO_ENVBUILD ":" "target" ] + [ RO_ENVBUILD_STR_WS false ] + [ RO_ENVBUILD_COL ":" "target" ] + [ RO_ENVBUILD_COL_TARGET ";" "host" ] + [ RO_ENVBUILD_COL_TARGET_QUOTED ":" "host-quoted" ] +] +### cat OPAM/rewriting/.opam-switch/environment | grep RO_ENV +### opam install rewrite -v | sed-cmd sh | unordered +The following actions will be performed: +=== install 1 package + - install rewrite 1 + +<><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> +Processing 2/3: [rewrite: sh env | grep RO_ENV] ++ sh "-c" "env | grep RO_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/rewrite.1) +- RO_ENVBUILD=\another\given\path +- RO_ENVBUILD_COL=s:mething +- RO_ENVBUILD_COL_TARGET=/cygdrive/a/nother/gi;ven/path;a/path/to +- RO_ENVBUILD_COL_TARGET_QUOTED=/cygdrive/a/nother/gi;ven/path:a/path/to:"this/i:s/quoted" +- RO_ENVBUILD_STR=something +- RO_ENVSET_COL_TARGET=a/path/to +- RO_ENVSET_COL_TARGET_QUOTED=a/path/to:"this/i:s/quoted" +-> compiled rewrite.1 +-> installed rewrite.1 +Done. +### opam env | grep "RO_ENV" +RO_ENVSET='\a\given\path'; export RO_ENVSET; +RO_ENVSET_STR='something'; export RO_ENVSET_STR; +RO_ENVSET_STR_WS='something/else'; export RO_ENVSET_STR_WS; +RO_ENVSET_STR_WS2='something/else'; export RO_ENVSET_STR_WS2; +RO_ENVSET_COL='"s:mething"'; export RO_ENVSET_COL; +RO_ENVSET_COL_TARGET='/cygdrive/a/nother/gi;ven/path;a/path/to'; export RO_ENVSET_COL_TARGET; +RO_ENVSET_COL_TARGET_QUOTED='/cygdrive/a/nother/gi;ven/path:a/path/to:"this/i:s/quoted"'; export RO_ENVSET_COL_TARGET_QUOTED; +### cat OPAM/rewriting/.opam-switch/environment | grep RO_ENV +RO_ENVSET = /a/given/path : target Updated\ by\ package\ rewrite +RO_ENVSET_STR = something Updated\ by\ package\ rewrite +RO_ENVSET_STR_WS = something/else norewrite Updated\ by\ package\ rewrite +RO_ENVSET_STR_WS2 = something/else Updated\ by\ package\ rewrite +RO_ENVSET_COL = s:mething : target-quoted Updated\ by\ package\ rewrite +RO_ENVSET_COL_TARGET += a:/nother/gi;ven/path ; host Updated\ by\ package\ rewrite +RO_ENVSET_COL_TARGET_QUOTED += a:/nother/gi;ven/path : host-quoted Updated\ by\ package\ rewrite +### :::::::::::::::: +### : All formulae : +### :::::::::::::::: +### +opam-version: "2.0" +setenv: [ + [ RAF_ENVSET_TRUE = "/is/true" ] + [ RAF_ENVSET_FALSE = "/is/false" ] + [ RAF_ENVSET_ATOM = "/is/atom" ] + [ RAF_ENVSET_UNRES = "/is/unresolved" ] + [ RAF_ENVSET_RES = "/is/resolved" ] + [ RAF_ENVSET_DBL += "fir/st" ] + [ RAF_ENVSET_DBL += "sec/ond" ] +] +build: [ "sh" "-c" "env | grep RAF_ENV" ] +build-env: [ + [ RAF_ENVBUILD_TRUE = "/is/true" ] + [ RAF_ENVBUILD_FALSE = "/is/false" ] + [ RAF_ENVBUILD_ATOM = "/is/atom" ] + [ RAF_ENVBUILD_UNRES = "/is/unresolved" ] + [ RAF_ENVBUILD_RES = "/is/resolved" ] +] +x-env-path-rewrite: [ + [ RAF_ENVBUILD_TRUE true ] + [ RAF_ENVBUILD_FALSE false ] + [ RAF_ENVBUILD_ATOM ":" ("target-quoted") ] + [ RAF_ENVBUILD_UNRES ":" | ";" ("host" | "target-quoted")] + [ RAF_ENVBUILD_RES + (":" { os = "some-os" } | ";" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | ";" ) + ("target" { os = "some-os" } | "host" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | "host" ) + ] + + [ RAF_ENVSET_TRUE true ] + [ RAF_ENVSET_FALSE false ] + [ RAF_ENVSET_ATOM ":" ("target-quoted") ] + [ RAF_ENVSET_UNRES ":" | ";" ("host" | "target-quoted")] + [ RAF_ENVSET_RES + (":" { os = "some-os" } | ";" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | ";" ) + ("target" { os = "some-os" } | "host" { ! os = "linux" & arch = "arch" | os-version = "4.2" } | "host" ) + ] +] +### opam install all-formulae -v | sed-cmd sh | unordered The following actions will be performed: === install 1 package - - install vne 1 + - install all-formulae 1 +[ERROR] Formula can't be completely resolved : RAF_ENVBUILD_UNRES ":" true | ";" true. Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVBUILD_UNRES ("host" true | "target-quoted" true). Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ';' 'target'. +Processing 2/3: [all-formulae: sh env | grep RAF_ENV] ++ sh "-c" "env | grep RAF_ENV" (CWD=${BASEDIR}/OPAM/rewriting/.opam-switch/build/all-formulae.1) +- RAF_ENVBUILD_ATOM=\is\atom +- RAF_ENVBUILD_FALSE=/is/false +- RAF_ENVBUILD_RES=/is/resolved +- RAF_ENVBUILD_TRUE=/is/true +- RAF_ENVBUILD_UNRES=/is/unresolved +-> compiled all-formulae.1 <><> Processing actions <><><><><><><><><><><><><><><><><><><><><><><><><><><><> --> installed vne.1 +-> installed all-formulae.1 +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ":" true | ";" true. Using default ';' 'target'. +[ERROR] Formula can't be completely resolved : RAF_ENVSET_UNRES ("host" true | "target-quoted" true). Using default ';' 'target'. Done. -### opam env | grep 'Foo|FOO' | "SET " -> "" | "'" -> "" | '; .*' -> "" -FOO=bar;foo +### opam env | grep "RAF_ENV" +RAF_ENVSET_TRUE='/is/true'; export RAF_ENVSET_TRUE; +RAF_ENVSET_FALSE='/is/false'; export RAF_ENVSET_FALSE; +RAF_ENVSET_ATOM='\is\atom'; export RAF_ENVSET_ATOM; +RAF_ENVSET_UNRES='/is/unresolved'; export RAF_ENVSET_UNRES; +RAF_ENVSET_RES='/is/resolved'; export RAF_ENVSET_RES; +RAF_ENVSET_DBL='sec/ond;fir/st'; export RAF_ENVSET_DBL; +### cat OPAM/rewriting/.opam-switch/environment | grep RAF_ENV +RAF_ENVSET_TRUE = /is/true Updated\ by\ package\ all-formulae +RAF_ENVSET_FALSE = /is/false norewrite Updated\ by\ package\ all-formulae +RAF_ENVSET_ATOM = /is/atom : target-quoted Updated\ by\ package\ all-formulae +RAF_ENVSET_UNRES = /is/unresolved Updated\ by\ package\ all-formulae +RAF_ENVSET_RES = /is/resolved ; host Updated\ by\ package\ all-formulae +RAF_ENVSET_DBL += fir/st Updated\ by\ package\ all-formulae +RAF_ENVSET_DBL += sec/ond Updated\ by\ package\ all-formulae