Skip to content
Browse files

Generate $name.env files containing the environments variables in the…

… directory where a package is build

This is useful when you want to build again a package, in order to get the same environment as within opam.
  • Loading branch information...
1 parent 0331597 commit 516f6cea66066e40371f5b5d7014f297b342907d @samoht samoht committed Jun 18, 2012
Showing with 99 additions and 30 deletions.
  1. +12 −1 src/client.ml
  2. +40 −3 src/file.ml
  3. +4 −1 src/file.mli
  4. +2 −0 src/file_format.ml
  5. +3 −0 src/file_format.mli
  6. +4 −0 src/path.ml
  7. +9 −0 src/path.mli
  8. +3 −7 src/run.ml
  9. +4 −17 src/types.ml
  10. +13 −0 src/utils.ml
  11. +2 −0 tests/Makefile
  12. +3 −1 tests/packages/P2/P2.config.in
View
13 src/client.ml
@@ -661,6 +661,17 @@ let proceed_tochange t nv_old nv =
let comp_f = Path.G.compiler t.global ocaml_version in
let comp = File.Comp.read comp_f in
let add_to_env = File.Comp.env comp in
+ let add_to_path = Path.C.bin t.compiler in
+
+ (* Generate an environnement file *)
+ let env_f = Path.C.build_env t.compiler nv in
+ let old_env_f = Path.C.build_old_env t.compiler nv in
+ let old_env = List.map (fun (k,v) -> k, try Sys.getenv k with _ -> "") add_to_env in
+ let old_path = "PATH", try Sys.getenv "PATH" with _ -> "" in
+ let new_path = "PATH",
+ (try (Sys.getenv "PATH")^":" with _ -> "") ^ Dirname.to_string add_to_path in
+ File.Env.write env_f (new_path :: add_to_env);
+ File.Env.write old_env_f (old_path :: old_env);
(* Call the build script and copy the output files *)
let commands = List.map (List.map (substitute_string t))
@@ -669,7 +680,7 @@ let proceed_tochange t nv_old nv =
Globals.msg "[%s] Build commands:\n %s\n"
(NV.to_string nv)
(String.concat "\n " commands_s);
- let err = Dirname.exec ~add_to_env ~add_to_path:[Path.C.bin t.compiler] p_build
+ let err = Dirname.exec ~add_to_env ~add_to_path:[add_to_path] p_build
commands in
if err = 0 then
try proceed_toinstall t nv
View
43 src/file.ml
@@ -586,21 +586,24 @@ module Dot_config = struct
type t = {
sections : s list;
variables: (variable * variable_contents) list;
+ env : (string * string) list;
}
let create variables =
- { variables; sections = [] }
+ { variables; sections = []; env = []; }
let empty = {
sections = [];
variables = [];
+ env = [];
}
let s_bytecomp = "bytecomp"
let s_asmcomp = "asmcomp"
let s_bytelink = "bytelink"
let s_asmlink = "asmlink"
let s_requires = "requires"
+ let s_env = "env"
let valid_fields = [
s_opam_version;
@@ -609,6 +612,7 @@ module Dot_config = struct
s_bytelink;
s_asmlink;
s_requires;
+ s_env;
]
let of_string filename str =
@@ -634,7 +638,8 @@ module Dot_config = struct
let syntax = assoc_sections file.contents "syntax" (parse_section "syntax") in
let sections = libraries @ syntax in
let variables = parse_variables file.contents in
- { sections; variables }
+ let env = assoc_list file.contents s_env (parse_list parse_string_pair) in
+ { sections; variables; env }
let rec to_string filename t =
let of_value = function
@@ -660,6 +665,7 @@ module Dot_config = struct
contents =
of_variables t.variables
@ List.map of_section t.sections
+ @ [ Variable (s_env, make_list make_string_pair t.env) ]
}
let variables t = List.map fst t.variables
@@ -700,6 +706,32 @@ module Dot_config = struct
module Section = MK (struct let get t = t.sections end)
end
+module Env = struct
+
+ let internal = "env"
+
+ type t = (string * string) list
+
+ let empty = []
+
+ let of_string filename s =
+ let l = Lines.of_string filename s in
+ List.fold_left (fun accu -> function
+ | [] -> accu
+ | [s] ->
+ (match Utils.cut_at s '=' with
+ | None -> failwith (s ^ ": invalid env variable")
+ | Some(k,v) -> (k, v) :: accu)
+ | x -> failwith (String.concat " " x ^ ": invalid env variable")
+ ) [] l
+
+ let to_string filename t =
+ let l = List.map (fun (k,v) -> [ k^"="^v ]) t in
+ Lines.to_string filename l
+
+end
+
+
module Comp = struct
let internal = "comp"
@@ -873,7 +905,7 @@ module Comp = struct
Variable (s_asmlink , make_list make_string s.asmlink);
Variable (s_packages , make_list (N.to_string |> make_string) s.packages);
Variable (s_requires , make_list (Section.to_string |> make_string) s.requires);
- Variable (s_env , make_list (make_pair make_string) s.env);
+ Variable (s_env , make_list make_string_pair s.env);
] @ match s.pp with
| None -> []
| Some pp -> [ Variable (s_pp, make_ppflag pp) ]
@@ -1033,3 +1065,8 @@ module Comp = struct
include Comp
include Make (Comp)
end
+
+module Env = struct
+ include Env
+ include Make (Env)
+end
View
5 src/file.mli
@@ -148,8 +148,11 @@ module Reinstall: IO_FILE with type t = NV.Set.t
(** List of updated packages: [$opam/$repo/$repo/updated] *)
module Updated: IO_FILE with type t = NV.Set.t
+(** Environement variables *)
+module Env: IO_FILE with type t = (string * string) list
+
(** Compiler version [$opam/compilers/] *)
-module Comp : sig
+module Comp: sig
include IO_FILE
View
2 src/file_format.ml
@@ -176,6 +176,8 @@ let make_option f g (v,l) = Option (f v, List.map g l)
let make_pair f (k,v) = List [f k; f v]
+let make_string_pair = make_pair make_string
+
(* Printing *)
let rec string_of_value = function
View
3 src/file_format.mli
@@ -141,6 +141,9 @@ val make_option : ('a -> value) -> ('b -> value) -> 'a * 'b list -> value
(** Create a pair *)
val make_pair: ('a -> value) -> ('a * 'a) -> value
+(** Create a pair of strings *)
+val make_string_pair: string * string -> value
+
(** {2 Printing functions} *)
(** Print a value *)
View
4 src/path.ml
@@ -115,6 +115,10 @@ module C = struct
let build t nv = build_dir t / NV.to_string nv
+ let build_env t nv = build t nv // (N.to_string (NV.name nv) ^ ".env")
+
+ let build_old_env t nv = build t nv // (N.to_string (NV.name nv) ^ ".old.env")
+
let build_ocaml t = build_dir t / "_"
let build_install t nv = build t nv // (N.to_string (NV.name nv) ^ ".install")
View
9 src/path.mli
@@ -124,6 +124,15 @@ module C: sig
(** Tempory folder: {i $opam/$OVERSION/build} *)
val build_dir: t -> dirname
+ (** A file containing the env variables in which build command are
+ processed: {i $opam/$OVERSION/build/$NAME.$VERSION/$NAME.env} *)
+ val build_env: t -> NV.t -> filename
+
+ (** A file containing a copy of the current env variables, before
+ the env variables for the build are set:
+ {i $opam/$OVERSION/build/$NAME.$VERSION/$NAME.old.env} *)
+ val build_old_env: t -> NV.t -> filename
+
(** Tempory location of install files:
{i $opam/$OVERSION/build/$NAME.$VERSION/$NAME.install} *)
val build_install: t -> NV.t -> filename
View
10 src/run.ml
@@ -161,13 +161,9 @@ let add_path bins =
let path = ref "<not set>" in
let env = Unix.environment () in
for i = 0 to Array.length env - 1 do
- let k,v =
- try
- let n = String.index env.(i) '=' in
- String.sub env.(i) 0 n,
- String.sub env.(i) (n+1) (String.length env.(i) - n - 1)
- with _ ->
- assert false in
+ let k,v = match Utils.cut_at env.(i) '=' with
+ | Some (k,v) -> k,v
+ | None -> assert false in
if k = "PATH" then
let new_path = match List.filter Sys.file_exists bins with
| [] -> v
View
21 src/types.ml
@@ -273,19 +273,6 @@ type version = V.t
module N: Abstract = Base
type name = N.t
-let cut_at_aux fn s sep =
- try
- let i = String.index s sep in
- let name = String.sub s 0 i in
- let version = String.sub s (i+1) (String.length s - i - 1) in
- Some (name, version)
- with _ ->
- None
-
-let cut_at = cut_at_aux String.index
-
-let rcut_at = cut_at_aux String.rindex
-
module NV: sig
include Abstract
val name: t -> name
@@ -312,7 +299,7 @@ end = struct
let sep = '.'
let check s =
- match cut_at s sep with
+ match Utils.cut_at s sep with
| None -> None
| Some (n, v) -> Some { name = N.of_string n; version = V.of_string v }
@@ -512,7 +499,7 @@ end = struct
let section t = t.section
let of_string str =
- match cut_at str '.' with
+ match Utils.cut_at str '.' with
| Some (n,s) ->
{ package = N.of_string n;
section = Some (Section.of_string s) }
@@ -567,14 +554,14 @@ end = struct
variable }
let of_string s =
- match rcut_at s ':' with
+ match Utils.rcut_at s ':' with
| None ->
create_global
(N.of_string Globals.default_package)
(Variable.of_string s)
| Some (p,v) ->
let v = Variable.of_string v in
- match cut_at p '.' with
+ match Utils.cut_at p '.' with
| None -> create_global (N.of_string p) v
| Some (p,s) -> create_local (N.of_string p) (Section.of_string s) v
View
13 src/utils.ml
@@ -51,3 +51,16 @@ let is_inet_address address =
let (_:Unix.inet_addr) = Unix.inet_addr_of_string address
in true
with _ -> false
+
+let cut_at_aux fn s sep =
+ try
+ let i = fn s sep in
+ let name = String.sub s 0 i in
+ let version = String.sub s (i+1) (String.length s - i - 1) in
+ Some (name, version)
+ with _ ->
+ None
+
+let cut_at = cut_at_aux String.index
+
+let rcut_at = cut_at_aux String.rindex
View
2 tests/Makefile
@@ -219,6 +219,8 @@ ifeq ($(REPOKIND), git)
else
$(CHECK) -l switch-env-packages P1.2 P2.1 P3.1~weird-version.test P4.3
endif
+# include $(OPAM_ROOT)/dummy/build/P4.3/P4.env
+# if [ x$(TEST) != "x1" ]; then echo "wrong value for TEST"; exit 1; fi
switch:
$(MAKE) fresh
View
4 tests/packages/P2/P2.config.in
@@ -4,4 +4,6 @@ library "p2" {
asmlink: ["-I" "%{lib}%/P2" "p2.cmxa"]
bytelink: ["-I" "%{lib}%/P2" "p2.cma"]
requires: ["p1"]
-}
+}
+
+env: [ ["TESTP2" "FOO"] ]

0 comments on commit 516f6ce

Please sign in to comment.
Something went wrong with that request. Please try again.