From 2c5a4f8a86d99021067a44ed013f62ca1b8e986a Mon Sep 17 00:00:00 2001 From: Fabien Chouteau Date: Mon, 6 Jul 2020 10:38:01 +0200 Subject: [PATCH] Alire.Environment: new handling of env variables (#452) * Alire.Environment: implement new handling of env variables Including using the variables defined in the crate. * Alire.Environment: implement string format for env vars in releases For instance replacing "${DISTIB_ROOT}" by "/". * Alire.Platform: implement msys2 root detection * Alire.Environment: remove already defined function Already in alire.ads --- src/alire/alire-environment-formatting.adb | 127 +++++++++ src/alire/alire-environment-formatting.ads | 13 + src/alire/alire-environment.adb | 260 ++++++++++++++++++ src/alire/alire-environment.ads | 79 +++++- src/alire/alire-paths.ads | 13 +- src/alire/alire-platform.ads | 3 + src/alire/alire-platforms.ads | 2 + src/alire/alire-releases.adb | 1 - src/alire/os_linux/alire-platform.adb | 7 + src/alire/os_macos/alire-platform.adb | 7 + src/alire/os_windows/alire-platform.adb | 35 +++ src/alr/alr-build_env.adb | 166 ++++------- src/alr/alr-build_env.ads | 15 +- src/alr/alr-commands-build.adb | 2 +- src/alr/alr-commands-clean.adb | 2 +- src/alr/alr-commands-setenv.adb | 64 ++++- src/alr/alr-commands-setenv.ads | 12 +- .../environment/my_index/index/he/hello.toml | 8 +- testsuite/tests/index/environment/test.py | 26 +- testsuite/tests/setenv/basic/test.py | 8 +- testsuite/tests/setenv/with-external/test.py | 3 +- 21 files changed, 699 insertions(+), 154 deletions(-) create mode 100644 src/alire/alire-environment-formatting.adb create mode 100644 src/alire/alire-environment-formatting.ads create mode 100644 src/alire/alire-environment.adb diff --git a/src/alire/alire-environment-formatting.adb b/src/alire/alire-environment-formatting.adb new file mode 100644 index 00000000..c2f81eed --- /dev/null +++ b/src/alire/alire-environment-formatting.adb @@ -0,0 +1,127 @@ +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +with Alire.OS_Lib; +with Alire.Directories; +with Alire.Platform; +with Alire.Paths; + +package body Alire.Environment.Formatting is + + ---------------- + -- Find_Start -- + ---------------- + + function Find_Start (Str : Unbounded_String; + From : Positive) + return Natural + is + Loc : Natural := From; + begin + + loop + Loc := Index (Str, "${", Loc); + + exit when Loc = 0; + + -- Check for escape character before the pattern + if Loc = 1 or else Element (Str, Loc - 1) /= '\' then + return Loc; + else + + -- Pattern found but with an escape character + Loc := Loc + 2; + end if; + end loop; + + return Loc; + end Find_Start; + + -------------- + -- Find_End -- + -------------- + + function Find_End (Str : Unbounded_String; + From : Positive) + return Natural + is + begin + -- There is not possible escape character between the start and + -- the end of the formating pattern. + return Index (Str, "}", From); + end Find_End; + + ------------ + -- Format -- + ------------ + + function Format (Rel : Releases.Release; + Value : String; + Is_Root_Release : Boolean) + return String + is + ------------- + -- Replace -- + ------------- + + procedure Replace (Str : in out Unbounded_String; + From, To : Positive) + is + use Alire.OS_Lib; + + Id : constant String := Slice (Str, From + 2, To - 1); + + Working_Folder : constant Alire.Absolute_Path := + Alire.Directories.Current; + begin + + if Id = "DISTRIB_ROOT" then + Replace_Slice (Str, From, To, Platform.Distribution_Root); + + elsif Id = "CRATE_ROOT" then + Replace_Slice + (Str, From, To, + Working_Folder / + (if Is_Root_Release + then ".." + else Alire.Paths.Working_Folder_Inside_Root + / Alire.Paths.Dependency_Dir_Inside_Working_Folder + / Rel.Unique_Folder)); + + elsif Id = "_ALIRE_TEST_" then + -- This is used to test the env var formatting feature + Replace_Slice (Str, From, To, "TEST"); + else + raise Unknown_Formatting_Key; + end if; + end Replace; + + Result : Unbounded_String := To_Unbounded_String (Value); + From : Natural := 1; + To : Natural; + begin + loop + From := Find_Start (Result, From); + + if From = 0 then + -- All patterns are replaced, if any + exit; + end if; + + To := Find_End (Result, From); + + if To = 0 then + -- All patterns are replaced, if any + exit; + end if; + + -- A pattern is found + Replace (Result, From, To); + + -- Start again from the beginning of the string + From := 1; + end loop; + + return To_String (Result); + end Format; + +end Alire.Environment.Formatting; diff --git a/src/alire/alire-environment-formatting.ads b/src/alire/alire-environment-formatting.ads new file mode 100644 index 00000000..860d9bcb --- /dev/null +++ b/src/alire/alire-environment-formatting.ads @@ -0,0 +1,13 @@ +with Alire.Releases; + +package Alire.Environment.Formatting is + + function Format (Rel : Releases.Release; + Value : String; + Is_Root_Release : Boolean) + return String; + -- Format the environment variable falue with ${} replacement patterns + + Unknown_Formatting_Key : exception; + +end Alire.Environment.Formatting; diff --git a/src/alire/alire-environment.adb b/src/alire/alire-environment.adb new file mode 100644 index 00000000..8d887f4a --- /dev/null +++ b/src/alire/alire-environment.adb @@ -0,0 +1,260 @@ +with GNAT.OS_Lib; + +with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; + +with Alire.Properties.Environment; use Alire.Properties.Environment; +with Alire.Properties.Scenarios; +with Alire.OS_Lib; +with Alire.GPR; +with Alire.Utils; +with Alire.Environment.Formatting; + +package body Alire.Environment is + + --------- + -- Add -- + --------- + + procedure Add (This : in out Context; Name : String; Action : Env_Action) is + begin + if not This.Actions.Contains (+Name) then + declare + Empty_Vect : Action_Vectors.Vector; + begin + This.Actions.Include (+Name, Empty_Vect); + end; + end if; + + This.Actions.Reference (+Name).Append (Action); + end Add; + + --------- + -- Set -- + --------- + + procedure Set (This : in out Context; Name, Value, Origin : String) is + Action : constant Env_Action := (Set, +Value, +Origin); + begin + This.Add (Name, Action); + end Set; + + ------------ + -- Append -- + ------------ + + procedure Append (This : in out Context; Name, Value, Origin : String) is + Action : constant Env_Action := (Append, +Value, +Origin); + begin + This.Add (Name, Action); + end Append; + + ------------- + -- Prepend -- + ------------- + + procedure Prepend (This : in out Context; Name, Value, Origin : String) is + Action : constant Env_Action := (Prepend, +Value, +Origin); + begin + This.Add (Name, Action); + end Prepend; + + ---------- + -- Load -- + ---------- + + procedure Load (This : in out Context; + Rel : Alire.Releases.Release; + Prop : Alire.Properties.Vector; + Is_Root_Release : Boolean) + is + Origin : constant String := Rel.Name_Str; + begin + + -- Enviromemnt variables defined in the crate manifest + for Act of Rel.Environment (Prop) loop + begin + declare + Value : constant String := + Formatting.Format (Rel, Act.Value, Is_Root_Release); + begin + case Act.Action is + + when Properties.Environment.Set => + + This.Set (Act.Name, Value, Origin & " (env)"); + + when Properties.Environment.Append => + + This.Append (Act.Name, Value, Origin & " (env)"); + + when Properties.Environment.Prepend => + + This.Prepend (Act.Name, Value, Origin & " (env)"); + + end case; + end; + exception + when Formatting.Unknown_Formatting_Key => + Raise_Checked_Error + ("Unknown environment variable formatting key in var '" & + Act.Name & " of '" & Origin & "'"); + end; + end loop; + + -- Environment variables for GPR external scenario variables + for Property of Rel.On_Platform_Properties (Prop) loop + if Property in Alire.Properties.Scenarios.Property'Class then + declare + use all type Alire.GPR.Variable_Kinds; + Variable : constant Alire.GPR.Variable := + Alire.Properties.Scenarios.Property (Property).Value; + begin + if Variable.Kind = External then + This.Set (Variable.Name, Variable.External_Value, + Origin & " (gpr ext)"); + end if; + end; + end if; + end loop; + end Load; + + ----------------- + -- Print_Shell -- + ----------------- + + procedure Print_Shell (This : Context; Kind : Platforms.Shells) is + begin + -- TODO: PowerShell or CMD version for Windows. Is it possible to detect + -- the kind of shell we are runnning in? + for Elt of This.Compile loop + case Kind is + when Platforms.Unix => + Trace.Always (To_String ("export " & Elt.Key & "=""" & + Elt.Value & """")); + when Platforms.PowerShell => + Trace.Always (To_String ("$env:" & Elt.Key & " = """ & + Elt.Value & """")); + when Platforms.WinCmd => + Trace.Always (To_String ("set " & Elt.Key & "=" & Elt.Value)); + end case; + end loop; + end Print_Shell; + + ------------------- + -- Print_Details -- + ------------------- + + procedure Print_Details (This : Context) is + begin + for C in This.Actions.Iterate loop + declare + Key : constant String := To_String (Action_Maps.Key (C)); + begin + Trace.Always (" - variable: '" & Key & "'"); + for Act of This.Actions (C) loop + case Act.Kind is + when Properties.Environment.Set => + Trace.Always (" - Set to '" & To_String (Act.Value) & + "' by '" & To_String (Act.Origin) & "'"); + + when Properties.Environment.Append => + Trace.Always (" - Appended with '" & + To_String (Act.Value) & + "' by '" & To_String (Act.Origin) & "'"); + + when Properties.Environment.Prepend => + Trace.Always (" - Prepended with '" & + To_String (Act.Value) & + "' by '" & To_String (Act.Origin) & "'"); + + end case; + end loop; + end; + end loop; + end Print_Details; + + ------------- + -- Compile -- + ------------- + + function Compile (Key : Unbounded_String; + Vect : Action_Vectors.Vector) + return Var + is + Existing : constant String := OS_Lib.Getenv (+Key); + + Separator : constant Character := GNAT.OS_Lib.Path_Separator; + + Value : Unbounded_String := +Existing; + begin + + for Act of Vect loop + + -- Print some helpful details to inspect a conflict + case Act.Kind is + when Properties.Environment.Set => + Trace.Detail + (+("Env: " & Act.Origin & + " sets '" & Act.Value & "' to '" & Key & "'")); + + when Properties.Environment.Append => + + Trace.Detail + (+("Env: " & Act.Origin & + " appends '" & Act.Value & "' to '" & Key & "'")); + + when Properties.Environment.Prepend => + Trace.Detail + (+("Env: " & Act.Origin & + " prepends '" & Act.Value & "' to '" & Key & "'")); + end case; + + if Length (Value) = 0 then + Value := Act.Value; + else + case Act.Kind is + + when Properties.Environment.Set => + Raise_Checked_Error + ("Trying to set an alredy defined environment variable"); + + when Properties.Environment.Append => + Value := Value & Separator & Act.Value; + + when Properties.Environment.Prepend => + Value := Act.Value & Separator & Value; + end case; + end if; + end loop; + + return (Key => Key, Value => Value); + end Compile; + + ------------- + -- Compile -- + ------------- + + function Compile (This : Context) return Var_Array is + Result : Var_Array (1 .. Natural (This.Actions.Length)); + Index : Natural := Result'First; + begin + for C in This.Actions.Iterate loop + Result (Index) := Compile (Action_Maps.Key (C), This.Actions (C)); + Index := Index + 1; + end loop; + + return Result; + end Compile; + + ------------ + -- Export -- + ------------ + + procedure Export (This : Context) is + begin + for Var of This.Compile loop + OS_Lib.Setenv (+Var.Key, +Var.Value); + end loop; + end Export; + +end Alire.Environment; diff --git a/src/alire/alire-environment.ads b/src/alire/alire-environment.ads index def708ad..28b8d09e 100644 --- a/src/alire/alire-environment.ads +++ b/src/alire/alire-environment.ads @@ -1,4 +1,15 @@ -package Alire.Environment with Preelaborate is +with Ada.Strings.Unbounded; + +with Alire.Releases; +with Alire.Properties; +with Alire.Platforms; + +private with Ada.Strings.Unbounded.Hash; +private with Ada.Containers.Vectors; +private with Ada.Containers.Hashed_Maps; +private with Alire.Properties.Environment; + +package Alire.Environment is Config : constant String := "ALR_CONFIG"; -- Folder where current alr will look for configuration @@ -7,4 +18,70 @@ package Alire.Environment with Preelaborate is -- Folder that overrides where alr sources are checked out -- Intended to help developers by pointing it to their sources + type Context is tagged limited private; + + procedure Set (This : in out Context; Name, Value, Origin : String); + -- Set a variable in the context + + procedure Append (This : in out Context; Name, Value, Origin : String); + -- Append a value to a variable in the context + + procedure Prepend (This : in out Context; Name, Value, Origin : String); + -- Prepend a value to a variable in the context + + procedure Load (This : in out Context; + Rel : Alire.Releases.Release; + Prop : Alire.Properties.Vector; + Is_Root_Release : Boolean); + -- Load the enviroment variables of a release (GPR_PROJECT_PATH and custom + -- variables) in the context. + + procedure Export (This : Context); + -- Export the enviroment variables built from the variables previously + -- loaded and defined in the context. + + procedure Print_Shell (This : Context; Kind : Platforms.Shells); + -- Print the shell commands that can be used to export the enviroment + -- variables. + + procedure Print_Details (This : Context); + -- Print details about the environement context. What are the variables + -- definitions and their origin. + +private + + type Var is record + Key : Ada.Strings.Unbounded.Unbounded_String; + Value : Ada.Strings.Unbounded.Unbounded_String; + end record; + + type Var_Array is array (Natural range <>) of Var; + + function Compile (This : Context) return Var_Array; + -- Return an array of enviroment variable key/value built from the + -- variables previously loaded and defined in the context. + + type Env_Action is record + Kind : Alire.Properties.Environment.Actions; + Value : Ada.Strings.Unbounded.Unbounded_String; + Origin : Ada.Strings.Unbounded.Unbounded_String; + end record; + + package Action_Vectors is new Ada.Containers.Vectors + (Index_Type => Natural, + Element_Type => Env_Action); + + package Action_Maps is new Ada.Containers.Hashed_Maps + (Key_Type => Ada.Strings.Unbounded.Unbounded_String, + Element_Type => Action_Vectors.Vector, + Hash => Ada.Strings.Unbounded.Hash, + Equivalent_Keys => Ada.Strings.Unbounded."=", + "=" => Action_Vectors."="); + + type Context is tagged limited record + Actions : Action_Maps.Map; + end record; + + procedure Add (This : in out Context; Name : String; Action : Env_Action); + end Alire.Environment; diff --git a/src/alire/alire-paths.ads b/src/alire/alire-paths.ads index e961e3fd..929e0c6c 100644 --- a/src/alire/alire-paths.ads +++ b/src/alire/alire-paths.ads @@ -5,8 +5,14 @@ package Alire.Paths with Preelaborate is Crate_File_Extension_With_Dot : constant String; -- Until we decide a name, going to use crate per Amiard's suggestion - Working_Folder_Inside_Root : constant Relative_Path; - -- This is the folder inside a crate where all alire products are created + function Working_Folder_Inside_Root return Relative_Path + is ("alire"); + -- Folder within a working release that will contain metadata/build files, + -- dependency releases, and session. + + function Cache_Dir_Inside_Working_Folder return Relative_Path; + -- Folder inside the working folder with transient files (can be safely + -- deleted). function Dependency_Dir_Inside_Working_Folder return Relative_Path; -- Relative path from Working_Folder to deployed dependencies @@ -21,7 +27,8 @@ private Crate_File_Extension_With_Dot : constant String := ".toml"; - Working_Folder_Inside_Root : constant Relative_Path := "alire"; + function Cache_Dir_Inside_Working_Folder return Relative_Path + is ("cache"); function Dependency_Dir_Inside_Working_Folder return Relative_Path is ("cache" / "dependencies"); diff --git a/src/alire/alire-platform.ads b/src/alire/alire-platform.ads index 3663b2a8..cb66c6ae 100644 --- a/src/alire/alire-platform.ads +++ b/src/alire/alire-platform.ads @@ -12,6 +12,9 @@ package Alire.Platform is function Distribution return Platforms.Distributions; + function Distribution_Root return Absolute_Path; + -- Root directory of the distribution + -------------------------------- -- Portable derived utilities -- -------------------------------- diff --git a/src/alire/alire-platforms.ads b/src/alire/alire-platforms.ads index e61698b5..9c993ad6 100644 --- a/src/alire/alire-platforms.ads +++ b/src/alire/alire-platforms.ads @@ -42,4 +42,6 @@ package Alire.Platforms with Preelaborate is -- Provided by the user ); + type Shells is (Unix, PowerShell, WinCmd); + end Alire.Platforms; diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index ef312975..89643b35 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -1,6 +1,5 @@ with Ada.Strings.Fixed; --- with Alire.Platform; with Alire.Defaults; with Alire.Requisites.Booleans; with Alire.TOML_Load; diff --git a/src/alire/os_linux/alire-platform.adb b/src/alire/os_linux/alire-platform.adb index de579c49..80e2a048 100644 --- a/src/alire/os_linux/alire-platform.adb +++ b/src/alire/os_linux/alire-platform.adb @@ -67,4 +67,11 @@ package body Alire.Platform is return Distro_Unknown; end Distribution; + ----------------------- + -- Distribution_Root -- + ----------------------- + + function Distribution_Root return Absolute_Path + is ("/"); + end Alire.Platform; diff --git a/src/alire/os_macos/alire-platform.adb b/src/alire/os_macos/alire-platform.adb index 2cc54b48..40a2c4b4 100644 --- a/src/alire/os_macos/alire-platform.adb +++ b/src/alire/os_macos/alire-platform.adb @@ -22,4 +22,11 @@ package body Alire.Platform is function Distribution return Platforms.Distributions is (Platforms.Distro_Unknown); + ----------------------- + -- Distribution_Root -- + ----------------------- + + function Distribution_Root return Absolute_Path + is ("/"); + end Alire.Platform; diff --git a/src/alire/os_windows/alire-platform.adb b/src/alire/os_windows/alire-platform.adb index d168d891..a9536296 100644 --- a/src/alire/os_windows/alire-platform.adb +++ b/src/alire/os_windows/alire-platform.adb @@ -1,3 +1,6 @@ +with Ada.Directories; +with GNAT.OS_Lib; + with Alire.Utils; with Alire.OS_Lib; use Alire.OS_Lib; with Alire.OS_Lib.Subprocess; @@ -33,6 +36,21 @@ package body Alire.Platform is return False; end Detect_Msys2; + ----------------------- + -- Detect_Msys2_Root -- + ----------------------- + + function Detect_Msys2_Root return Absolute_Path is + Result : constant String := OS_Lib.Subprocess.Locate_In_Path ("pacman"); + begin + if Result /= "" then + return GNAT.OS_Lib.Normalize_Pathname + (Ada.Directories.Containing_Directory (Result) / ".." / ".."); + else + Raise_Checked_Error ("Cannot locate pacman in msys2 distrib"); + end if; + end Detect_Msys2_Root; + --------------------------- -- Default_Config_Folder -- --------------------------- @@ -71,4 +89,21 @@ package body Alire.Platform is return Distrib; end Distribution; + ----------------------- + -- Distribution_Root -- + ----------------------- + + function Distribution_Root return Absolute_Path is + begin + case Distribution is + + when Platforms.Msys2 => + return Detect_Msys2_Root; + + when others => + return OS_Lib.Getenv ("HOMEDRIVE"); + + end case; + end Distribution_Root; + end Alire.Platform; diff --git a/src/alr/alr-build_env.adb b/src/alr/alr-build_env.adb index 217d0eff..94271066 100644 --- a/src/alr/alr-build_env.adb +++ b/src/alr/alr-build_env.adb @@ -1,72 +1,30 @@ -with Ada.Strings.Unbounded; -with Ada.Text_IO; - with GNAT.IO; -with GNAT.OS_Lib; with Alire_Early_Elaboration; + with Alire.GPR; -with Alire.Properties.Scenarios; with Alire.Solutions; with Alire.Solver; with Alire.Utils.TTY; with Alire.Utils; +with Alire.Environment; +with Alire.Properties; +with Alire.Releases; -with Alr.OS_Lib; with Alr.Platform; package body Alr.Build_Env is - package Query renames Alire.Solver; package TTY renames Alire.Utils.TTY; - type Env_Var_Action_Callback is access procedure (Key, Val : String); - - Path_Separator : constant Character := GNAT.OS_Lib.Path_Separator; - ------------------ - -- Project_Path -- + -- Load_Context -- ------------------ - function Project_Path (Root : Alire.Roots.Root) - return String - is - use Ada.Strings.Unbounded; - - Result : Unbounded_String; - Sorted_Paths : constant Alire.Utils.String_Set := Root.Project_Paths; - - First : Boolean := True; - begin - - if not Sorted_Paths.Is_Empty then - for Path of Sorted_Paths loop - - if First then - Result := Result & Path; - First := False; - else - Result := Result & Path_Separator & Path; - end if; - - end loop; - end if; - - return To_String (Result); - end Project_Path; - - ------------- - -- Gen_Env -- - ------------- - - procedure Gen_Env (Root : Alire.Roots.Root; - Action : not null Env_Var_Action_Callback) + procedure Load_Context (Ctx : in out Alire.Environment.Context; + Root : Alire.Roots.Root) is - Needed : constant Query.Solution := Root.Solution; - - Existing_Project_Path : GNAT.OS_Lib.String_Access; - - Full_Instance : Alire.Solutions.Release_Map; + Needed : constant Alire.Solver.Solution := Root.Solution; begin if not Needed.Is_Complete then Trace.Debug ("Generating incomplete environment" @@ -84,86 +42,60 @@ package body Alr.Build_Env is end if; end if; - -- GPR_PROJECT_PATH - Existing_Project_Path := GNAT.OS_Lib.Getenv ("GPR_PROJECT_PATH"); - - if Existing_Project_Path.all'Length = 0 then - - -- The variable is not already defined - Action ("GPR_PROJECT_PATH", Project_Path (Root)); - else - - -- Append to the existing variable - Action ("GPR_PROJECT_PATH", - Existing_Project_Path.all & Path_Separator & - Project_Path (Root)); - end if; + declare + Sorted_Paths : constant Alire.Utils.String_Set := Root.Project_Paths; + begin + if not Sorted_Paths.Is_Empty then + for Path of Sorted_Paths loop + Ctx.Append ("GPR_PROJECT_PATH", Path, "crates"); + end loop; + end if; + end; - GNAT.OS_Lib.Free (Existing_Project_Path); - - Full_Instance := Needed.Releases.Including (Root.Release); - - -- Externals - -- - -- FIXME: what to do with duplicates? at a minimum research what - -- gprbuild does (err, ignore...). - for Release of Full_Instance loop - for Prop of Release.On_Platform_Properties (Platform.Properties) loop - if Prop in Alire.Properties.Scenarios.Property'Class then - declare - use all type Alire.GPR.Variable_Kinds; - Variable : constant Alire.GPR.Variable := - Alire.Properties.Scenarios.Property (Prop).Value; - begin - if Variable.Kind = External then - Action (Variable.Name, Variable.External_Value); - end if; - end; - end if; - end loop; + for Rel of Needed.Releases.Including (Root.Release) loop + Ctx.Load (Rel, + Platform.Properties, + Is_Root_Release => Rel.Name = Root.Release.Name); end loop; - Action ("ALIRE", "True"); - end Gen_Env; - - --------------- - -- Print_Var -- - --------------- + Ctx.Set ("ALIRE", "True", "Alire"); + end Load_Context; - procedure Print_Var (Key, Value : String) is - begin - Ada.Text_IO.Put_Line ("export " & Key & "=""" & Value & """"); - end Print_Var; - - ------------- - -- Set_Var -- - ------------- + ------------ + -- Export -- + ------------ - procedure Set_Var (Key, Value : String) is + procedure Export (Root : Alire.Roots.Root) + is + Ctx : Alire.Environment.Context; begin - Alire.Trace.Detail ("Set environment variable: " & - Key & "=""" & Value & """"); - OS_Lib.Setenv (Key, Value); - end Set_Var; + Load_Context (Ctx, Root); + Ctx.Export; + end Export; - --------- - -- Set -- - --------- + ------------------- + -- Print_Details -- + ------------------- - procedure Set (Root : Alire.Roots.Root) + procedure Print_Details (Root : Alire.Roots.Root) is + Ctx : Alire.Environment.Context; begin - Gen_Env (Root, Set_Var'Access); - end Set; + Load_Context (Ctx, Root); + Ctx.Print_Details; + end Print_Details; - ----------- - -- Print -- - ----------- + ----------------- + -- Print_Shell -- + ----------------- - procedure Print (Root : Alire.Roots.Root) + procedure Print_Shell (Root : Alire.Roots.Root; + Kind : Alire.Platforms.Shells) is + Ctx : Alire.Environment.Context; begin - Gen_Env (Root, Print_Var'Access); - end Print; + Load_Context (Ctx, Root); + Ctx.Print_Shell (Kind); + end Print_Shell; end Alr.Build_Env; diff --git a/src/alr/alr-build_env.ads b/src/alr/alr-build_env.ads index 841bdfb4..d9b7b520 100644 --- a/src/alr/alr-build_env.ads +++ b/src/alr/alr-build_env.ads @@ -1,11 +1,18 @@ with Alire.Roots; +with Alire.Platforms; package Alr.Build_Env is - procedure Set (Root : Alire.Roots.Root); - -- Set the build environment (PATH, GPR_PROJECT_PATH) of the given root + procedure Export (Root : Alire.Roots.Root); + -- Export the build environment (PATH, GPR_PROJECT_PATH) of the given root - procedure Print (Root : Alire.Roots.Root); - -- Print the build environment (PATH, GPR_PROJECT_PATH) of the given root + procedure Print_Shell (Root : Alire.Roots.Root; + Kind : Alire.Platforms.Shells); + -- Print the shell commands that can be used to export the enviroment + -- variables of the given root. + + procedure Print_Details (Root : Alire.Roots.Root); + -- Print details about the environement variables (PATH, GPR_PROJECT_PATH) + -- of the given root. end Alr.Build_Env; diff --git a/src/alr/alr-commands-build.adb b/src/alr/alr-commands-build.adb index 19a3fa9b..c6a912da 100644 --- a/src/alr/alr-commands-build.adb +++ b/src/alr/alr-commands-build.adb @@ -20,7 +20,7 @@ package body Alr.Commands.Build is Requires_Valid_Session; - Alr.Build_Env.Set (Alr.Root.Current); + Alr.Build_Env.Export (Alr.Root.Current); -- COMPILATION begin diff --git a/src/alr/alr-commands-clean.adb b/src/alr/alr-commands-clean.adb index 3daa518c..3a81b391 100644 --- a/src/alr/alr-commands-clean.adb +++ b/src/alr/alr-commands-clean.adb @@ -29,7 +29,7 @@ package body Alr.Commands.Clean is Requires_Valid_Session; - Alr.Build_Env.Set (Alr.Root.Current); + Alr.Build_Env.Export (Alr.Root.Current); Trace.Detail ("Cleaning project and dependencies..."); diff --git a/src/alr/alr-commands-setenv.adb b/src/alr/alr-commands-setenv.adb index bd45b598..898e67d7 100644 --- a/src/alr/alr-commands-setenv.adb +++ b/src/alr/alr-commands-setenv.adb @@ -1,3 +1,5 @@ +with Alire.Platforms; + with Alr.Root; with Alr.Build_Env; @@ -8,23 +10,34 @@ package body Alr.Commands.Setenv is ------------- overriding procedure Execute (Cmd : in out Command) is - pragma Unreferenced (Cmd); + Enabled : Natural := 0; begin - Requires_Full_Index; + -- Check no multi-action + Enabled := Enabled + (if Cmd.Details then 1 else 0); + Enabled := Enabled + (if Cmd.Unix_Shell then 1 else 0); + Enabled := Enabled + (if Cmd.Power_Shell then 1 else 0); + Enabled := Enabled + (if Cmd.Cmd_Shell then 1 else 0); - Requires_Valid_Session; + if Enabled > 1 then + Reportaise_Wrong_Arguments ("Specify at most one subcommand"); + end if; - Alr.Build_Env.Print (Alr.Root.Current); - end Execute; + Requires_Full_Index; - ------------- - -- Execute -- - ------------- + Requires_Valid_Session; - procedure Execute is - Cmd : Command; - begin - Execute (Cmd); + if Cmd.Details then + Alr.Build_Env.Print_Details (Alr.Root.Current); + elsif Cmd.Power_Shell then + Alr.Build_Env.Print_Shell (Alr.Root.Current, + Alire.Platforms.PowerShell); + elsif Cmd.Cmd_Shell then + Alr.Build_Env.Print_Shell (Alr.Root.Current, + Alire.Platforms.WinCmd); + else + Alr.Build_Env.Print_Shell (Alr.Root.Current, + Alire.Platforms.Unix); + end if; end Execute; ---------------------- @@ -37,7 +50,12 @@ package body Alr.Commands.Setenv is (Alire.Utils.Empty_Vector .Append ("Print the environment variables used to build the crate." & " This command can be used to setup a build environment," & - " for instance before starting an IDE")); + " for instance before starting an IDE.") + .New_Line + .Append ("Examples:") + .Append (" - eval $(alr setenv --unix)") + .Append (" - alr setenv --powershell | Invoke-Expression") + ); -------------------- -- Setup_Switches -- @@ -47,9 +65,25 @@ package body Alr.Commands.Setenv is (Cmd : in out Command; Config : in out GNAT.Command_Line.Command_Line_Configuration) is - pragma Unreferenced (Cmd, Config); + use GNAT.Command_Line; begin - null; + Define_Switch (Config, + Cmd.Details'Access, + "", "--details", + "Print details about the environment variables and " & + "their origin"); + Define_Switch (Config, + Cmd.Unix_Shell'Access, + "", "--unix", + "Use a UNIX shell format for the export (default)"); + Define_Switch (Config, + Cmd.Power_Shell'Access, + "", "--powershell", + "Use a Windows PowerShell format for the export"); + Define_Switch (Config, + Cmd.Cmd_Shell'Access, + "", "--wincmd", + "Use a Windows CMD shell format for the export"); end Setup_Switches; end Alr.Commands.Setenv; diff --git a/src/alr/alr-commands-setenv.ads b/src/alr/alr-commands-setenv.ads index ddf1a7e9..50f1069d 100644 --- a/src/alr/alr-commands-setenv.ads +++ b/src/alr/alr-commands-setenv.ads @@ -1,12 +1,10 @@ package Alr.Commands.Setenv is - type Command is new Commands.Command with null record; + type Command is new Commands.Command with private; overriding procedure Execute (Cmd : in out Command); - procedure Execute; - overriding function Long_Description (Cmd : Command) return Alire.Utils.String_Vector; @@ -24,4 +22,12 @@ package Alr.Commands.Setenv is function Usage_Custom_Parameters (Cmd : Command) return String is (""); +private + + type Command is new Commands.Command with record + Details : aliased Boolean := False; + Unix_Shell : aliased Boolean := False; + Power_Shell : aliased Boolean := False; + Cmd_Shell : aliased Boolean := False; + end record; end Alr.Commands.Setenv; diff --git a/testsuite/tests/index/environment/my_index/index/he/hello.toml b/testsuite/tests/index/environment/my_index/index/he/hello.toml index 65f8a646..498bd570 100644 --- a/testsuite/tests/index/environment/my_index/index/he/hello.toml +++ b/testsuite/tests/index/environment/my_index/index/he/hello.toml @@ -8,9 +8,15 @@ maintainers-logins = ["mylogin"] VAR1.append = "abc" VAR2.prepend = "xyz" VAR3.set = "pqr" +VAR4.set = "${_ALIRE_TEST_}" +VAR5.set = "${_ALIRE_TEST_" +VAR6.set = "\\${_ALIRE_TEST_}" +VAR7.set = "abc${_ALIRE_TEST_}abc" +VAR8.set = "abc\\${_ALIRE_TEST_}abc" +VAR9.set = "${_ALIRE_TEST_}${_ALIRE_TEST_}${_ALIRE_TEST_}" [general.environment.'case(os)'.'...'] CONDVAR.set = "uvw" [1] -origin = "file://../blah.zip" +origin = "file://." diff --git a/testsuite/tests/index/environment/test.py b/testsuite/tests/index/environment/test.py index 554d1243..aa9a728e 100644 --- a/testsuite/tests/index/environment/test.py +++ b/testsuite/tests/index/environment/test.py @@ -4,9 +4,10 @@ Test proper loading of environment properties from drivers.alr import run_alr from drivers.asserts import assert_match +from glob import glob import re - +import os # With conditionals p = run_alr('show', 'hello') @@ -17,6 +18,12 @@ assert_match('.*' ' Environment: VAR1=\${VAR1}:abc\n' ' Environment: VAR2=xyz:\${VAR2}\n' ' Environment: VAR3=pqr\n' + ' Environment: VAR4=\${_ALIRE_TEST_}\n' + ' Environment: VAR5=\${_ALIRE_TEST_\n' + ' Environment: VAR6=\\\\\${_ALIRE_TEST_}\n' + ' Environment: VAR7=abc\${_ALIRE_TEST_}abc\n' + ' Environment: VAR8=abc\\\\\${_ALIRE_TEST_}abc\n' + ' Environment: VAR9=\${_ALIRE_TEST_}\${_ALIRE_TEST_}\${_ALIRE_TEST_}\n' '.*', p.out, flags=re.S) @@ -28,4 +35,21 @@ assert_match('.*' '.*', p.out, flags=re.S) +# Check environment variable formatting +run_alr('get', 'hello') +os.chdir(glob('hello*')[0]) +p = run_alr('setenv', '--unix') +assert_match('.*' + 'export VAR1="abc"\n' + 'export VAR2="xyz"\n' + 'export VAR3="pqr"\n' + 'export VAR4="TEST"\n' + 'export VAR5="\${_ALIRE_TEST_"\n' + 'export VAR6="\\\\\${_ALIRE_TEST_}"\n' + 'export VAR7="abcTESTabc"\n' + 'export VAR8="abc\\\\\${_ALIRE_TEST_}abc"\n' + 'export VAR9="TESTTESTTEST"\n' + '.*', + p.out, flags=re.S) + print('SUCCESS') diff --git a/testsuite/tests/setenv/basic/test.py b/testsuite/tests/setenv/basic/test.py index b296dc74..44f5d8dd 100644 --- a/testsuite/tests/setenv/basic/test.py +++ b/testsuite/tests/setenv/basic/test.py @@ -22,13 +22,13 @@ p = run_alr('setenv', quiet=False) assert_eq(0, p.status) if platform.system() == 'Windows': - assert_match('export GPR_PROJECT_PATH="[A-Z]:\\\\.*\\\\alire\\\\cache\\\\dependencies\\\\libhello_1\.0\.0_filesystem"\n' - 'export TEST_GPR_EXTERNAL="gpr_ext_B"\n' + assert_match('export TEST_GPR_EXTERNAL="gpr_ext_B"\n' + 'export GPR_PROJECT_PATH="[A-Z]:\\\\.*\\\\alire\\\\cache\\\\dependencies\\\\libhello_1\.0\.0_filesystem"\n' 'export ALIRE="True"\n', p.out, flags=re.S) else: - assert_match('export GPR_PROJECT_PATH="/.*/alire/cache/dependencies/libhello_1\.0\.0_filesystem"\n' - 'export TEST_GPR_EXTERNAL="gpr_ext_B"\n' + assert_match('export TEST_GPR_EXTERNAL="gpr_ext_B"\n' + 'export GPR_PROJECT_PATH="/.*/alire/cache/dependencies/libhello_1\.0\.0_filesystem"\n' 'export ALIRE="True"\n', p.out, flags=re.S) diff --git a/testsuite/tests/setenv/with-external/test.py b/testsuite/tests/setenv/with-external/test.py index 81178c8f..70553812 100644 --- a/testsuite/tests/setenv/with-external/test.py +++ b/testsuite/tests/setenv/with-external/test.py @@ -12,7 +12,7 @@ import re import platform -# Retrieve a crate with a external dependency +# Retrieve a crate with an external dependency run_alr('get', 'libhello=0.9-test_unav_native', '--force') os.chdir('libhello_0.9.0_filesystem') @@ -24,7 +24,6 @@ assert_eq(0, p.status) # Check the setenv output assert_match('warn: Generating incomplete environment' # Note: this warning is ' because of missing dependencies\n' # via stderr so it's OK - 'export GPR_PROJECT_PATH=""\n' 'export ALIRE="True"\n', p.out) -- 2.39.5