Set up environment before post-fetch actions

src/alire/alire-environment-formatting.adb

@@ -1,9 +1,6 @@
 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
 
@@ -54,9 +51,8 @@ package body Alire.Environment.Formatting is
    -- Format --
    ------------
 
-   function Format (Rel             : Releases.Release;
-                    Value           : String;
-                    Is_Root_Release : Boolean)
+   function Format (Release_Dir : Any_Path;
+                    Value       : String)
                     return String
    is
       -------------
@@ -66,12 +62,7 @@ package body Alire.Environment.Formatting is
       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
@@ -80,12 +71,7 @@ package body Alire.Environment.Formatting is
          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));
+               Release_Dir);
 
          elsif Id = "_ALIRE_TEST_" then
             --  This is used to test the env var formatting feature

src/alire/alire-environment-formatting.ads

@@ -2,11 +2,10 @@ with Alire.Releases;
 
 package Alire.Environment.Formatting is
 
-   function Format (Rel             : Releases.Release;
-                    Value           : String;
-                    Is_Root_Release : Boolean)
+   function Format (Release_Dir : Any_Path;
+                    Value       : String)
                     return String;
-   --  Format the environment variable falue with ${} replacement patterns
+   --  Format the environment variable value with ${} replacement patterns
 
    Unknown_Formatting_Key : exception;
 

src/alire/alire-environment.adb

@@ -2,15 +2,23 @@ with GNAT.OS_Lib;
 
 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 
+with Alire_Early_Elaboration;
 with Alire.Properties.Environment; use Alire.Properties.Environment;
 with Alire.Properties.Scenarios;
 with Alire.OS_Lib;
 with Alire.GPR;
+with Alire.Roots;
+with Alire.Solutions;
 with Alire.Utils;
 with Alire.Environment.Formatting;
+with Alire.Utils.TTY;
+
+with GNAT.IO;
 
 package body Alire.Environment is
 
+   package TTY renames Utils.TTY;
+
    ---------
    -- Add --
    ---------
@@ -62,20 +70,71 @@ package body Alire.Environment is
    -- Load --
    ----------
 
+   procedure Load (This : in out Context;
+                   Root :        Alire.Roots.Root)
+   is
+      Solution : constant Solutions.Solution := Root.Solution;
+   begin
+
+      --  Warnings when setting up an incomplete environment
+
+      if not Solution.Is_Complete then
+         Trace.Debug ("Generating incomplete environment"
+                      & " because of missing dependencies");
+
+         --  Normally we would generate a warning, but since that will pollute
+         --  the output making it unusable, for once we write directly to
+         --  stderr (unless quiet is in effect):
+
+         if not Alire_Early_Elaboration.Switch_Q then
+            GNAT.IO.Put_Line
+              (GNAT.IO.Standard_Error,
+               TTY.Warn ("warn:") & " Generating incomplete environment"
+               & " because of missing dependencies");
+         end if;
+      end if;
+
+      --  Project paths for all releases in the solution, implicitly defined by
+      --  supplied project files.
+
+      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
+               This.Append ("GPR_PROJECT_PATH", Path, "crates");
+            end loop;
+         end if;
+      end;
+
+      --  Custom definitions provided by each release
+
+      for Rel of Solution.Releases.Including (Root.Release) loop
+         This.Load (Root            => Root,
+                    Crate           => Rel.Name);
+      end loop;
+
+      This.Set ("ALIRE", "True", "Alire");
+   end Load;
+
+   ----------
+   -- Load --
+   ----------
+
    procedure Load (This            : in out Context;
-                   Rel             : Alire.Releases.Release;
-                   Prop            : Alire.Properties.Vector;
-                   Is_Root_Release : Boolean)
+                   Root            : Roots.Root;
+                   Crate           : Crate_Name)
    is
+      Rel    : constant Releases.Release := Root.Release (Crate);
       Origin : constant String := Rel.Name_Str;
    begin
 
-      --  Enviromemnt variables defined in the crate manifest
-      for Act of Rel.Environment (Prop) loop
+      --  Environment variables defined in the crate manifest
+      for Act of Rel.Environment (Root.Environment) loop
          begin
             declare
                Value : constant String :=
-                 Formatting.Format (Rel, Act.Value, Is_Root_Release);
+                 Formatting.Format (Root.Release_Base (Rel.Name), Act.Value);
             begin
                case Act.Action is
 
@@ -102,7 +161,7 @@ package body Alire.Environment is
       end loop;
 
       --  Environment variables for GPR external scenario variables
-      for Property of Rel.On_Platform_Properties (Prop) loop
+      for Property of Rel.On_Platform_Properties (Root.Environment) loop
          if Property in Alire.Properties.Scenarios.Property'Class then
             declare
                use all type Alire.GPR.Variable_Kinds;
@@ -216,7 +275,8 @@ package body Alire.Environment is
 
             when Properties.Environment.Set =>
                Raise_Checked_Error
-                 ("Trying to set an alredy defined environment variable");
+                 ("Trying to set an alredy defined environment variable: "
+                  & (+Key) & " is already defined as " & (+Value));
 
             when Properties.Environment.Append =>
                Value := Value & Separator & Act.Value;

src/alire/alire-environment.ads

@@ -3,6 +3,7 @@ with Ada.Strings.Unbounded;
 with Alire.Releases;
 with Alire.Properties;
 with Alire.Platforms;
+limited with Alire.Roots;
 
 private with Ada.Strings.Unbounded.Hash;
 private with Ada.Containers.Vectors;
@@ -29,19 +30,17 @@ package Alire.Environment is
    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 Load (This : in out Context;
+                   Root :        Alire.Roots.Root);
+   --  Load the environment variables of a releases found in the workspace
+   --  Solution (GPR_PROJECT_PATH and custom variables) in the context.
 
    procedure Export (This : Context);
-   --  Export the enviroment variables built from the variables previously
+   --  Export the environment 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
+   --  Print the shell commands that can be used to export the environment
    --  variables.
 
    procedure Print_Details (This : Context);
@@ -58,7 +57,7 @@ private
    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
+   --  Return an array of environment variable key/value built from the
    --  variables previously loaded and defined in the context.
 
    type Env_Action is record
@@ -84,4 +83,10 @@ private
 
    procedure Add (This : in out Context; Name : String; Action : Env_Action);
 
+   procedure Load (This            : in out Context;
+                   Root            : Roots.Root;
+                   Crate           : Crate_Name);
+   --  Load the environment variables of a release (GPR_PROJECT_PATH and custom
+   --  variables) in the context.
+
 end Alire.Environment;

src/alire/alire-releases.adb

@@ -426,7 +426,10 @@ package body Alire.Releases is
          for File of Files loop
             if Contains (File, "/") then
                Paths.Include
-                 (File (File'First .. Fixed.Index (File, "/", Backward)));
+                 (File (File'First .. Fixed.Index (File, "/", Backward) - 1));
+               --  To match the output of root crate paths and Ada.Directories
+               --  full path normalization, a path separator in the last
+               --  position is not included.
             end if;
          end loop;
       end return;