Merge remote-tracking branch 'alire/master' into fix/msys-path

doc/catalog-format-spec.md

@@ -316,6 +316,10 @@ static, i.e. they cannot depend on the context.
    PATH.append = "${DISTRIB_ROOT}/usr/bin"
    ```
 
+   Path fragments in this table must use portable format, that is, '/' for path
+   separation. Alire will take care of using the native separator when setting
+   these variables.
+
    Predefined variables are provided by Alire and will be replaced in the
    value:
 
@@ -325,6 +329,9 @@ static, i.e. they cannot depend on the context.
      be the `msys2` installation directory (e.g.
      `C:\Users\user_name\.cache\alire\msys2`).
 
+   The escaping `"\$"` can be used to prevent the expansion of a
+   dollar-bracketed expression.
+
    Environment entries can use dynamic expressions:
 
    ```toml
@@ -870,11 +877,14 @@ available.'case(toolchain)'.user = false
 
 ## Parameters
 
- - `os`: name of the OS. Currently supported values are: `linux`, `macos` and
-   `windows`.
+ - `os`: name of the OS. Currently supported values are: `freebsd`, `linux`,
+   `macos`, `windows`, and `os-unknown`.
 
- - `distribution`: name of the Linux distribution, or `none` if running on a
-   different OS. Currently supported values are: `debian`, `ubuntu`.
+ - `distribution`: name of the Linux distribution or name of the software
+   distribution platform if running on a different OS. Currently supported
+   values are: `arch`, `centos`, `debian`, `fedora`,
+   `homebrew`, `macports`, `msys2`, `rhel`, `suse`, `ubuntu`, and
+   `distribution-unknown`.
 
  - `toolchain`: takes `system` value in distributions with the system Ada
    compiler first in PATH (GNAT FSF in Debian/Ubuntu), `user` otherwise (GNAT

src/alire/alire-environment-formatting.adb

@@ -1,5 +1,6 @@
 with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
 
+with Alire.OS_Lib;
 with Alire.Platforms.Current;
 
 package body Alire.Environment.Formatting is
@@ -81,6 +82,23 @@ package body Alire.Environment.Formatting is
          end if;
       end Replace;
 
+      ---------------
+      -- To_Native --
+      ---------------
+      --  Replace forward slashes with native slashes on Windows, unless they
+      --  are an escape sequence.
+      function To_Native (S : String) return String is
+      begin
+         case OS_Lib.Dir_Separator is
+            when '/' => return S;
+            when '\' => null;
+            when others => raise Unimplemented with
+                 "Unknown OS with dir separator: " & OS_Lib.Dir_Separator;
+         end case;
+
+         return AAA.Strings.Replace (S, "/", "" & OS_Lib.Dir_Separator);
+      end To_Native;
+
       Result : Unbounded_String := To_Unbounded_String (Value);
       From   : Natural := 1;
       To     : Natural;
@@ -107,7 +125,8 @@ package body Alire.Environment.Formatting is
          From := 1;
       end loop;
 
-      return To_String (Result);
+      --  For final usage, we use the native separator
+      return To_Native (+Result);
    end Format;
 
 end Alire.Environment.Formatting;

src/alire/alire-externals-from_system.adb

@@ -160,7 +160,8 @@ package body Alire.Externals.From_System is
          --  We show either the requested Distro only, or all distros, which is
          --  signaled by Distro = Unknown.
 
-         if Concrete_Distro = Distro or else Distro = Platforms.Distro_Unknown
+         if Concrete_Distro = Distro or else
+            Distro = Platforms.Distribution_Unknown
          then
             declare
                On_Distro : constant Conditional_Packages.Tree :=

src/alire/alire-os_lib-subprocess.adb

@@ -10,8 +10,6 @@ with GNAT.OS_Lib;
 
 package body Alire.OS_Lib.Subprocess is
 
-   use AAA.Strings;
-
    function To_Argument_List
      (Args : AAA.Strings.Vector)
       return GNAT.OS_Lib.Argument_List_Access;

src/alire/alire-os_lib.ads

@@ -1,3 +1,7 @@
+private with AAA.Strings;
+
+with GNATCOLL.OS.Constants;
+
 package Alire.OS_Lib with Preelaborate is
 
    function "/" (L, R : String) return String;
@@ -20,4 +24,58 @@ package Alire.OS_Lib with Preelaborate is
    --  Return the location of an executable if found on PATH, or "" otherwise.
    --  On Windows, no need to append ".exe" as it will be found without it.
 
+   Forbidden_Dir_Separator : constant Character :=
+                               (case GNATCOLL.OS.Constants.Dir_Sep is
+                                   when '/' => '\',
+                                   when '\' => '/',
+                                   when others =>
+                                      raise Unimplemented
+                                        with "Unknown dir separator");
+
+   --  For things that may contain path fragments but are not proper paths
+
+   Dir_Separator : Character renames GNATCOLL.OS.Constants.Dir_Sep;
+
+   subtype Native_Path_Like is String
+     with Dynamic_Predicate =>
+       (for all Char of Native_Path_Like => Char /= Forbidden_Dir_Separator)
+     or else raise Ada.Assertions.Assertion_Error
+       with "Not a native-path-like: " & Native_Path_Like;
+
+   subtype Portable_Path_Like is String
+     with Dynamic_Predicate =>
+       (for all Char of Portable_Path_Like => Char /= '\')
+     or else raise Ada.Assertions.Assertion_Error
+       with "Not a portable-path-like: " & Portable_Path_Like;
+
+   function To_Portable (Path : Any_Path) return Portable_Path_Like;
+   --  Path is Any_Path and not Native_Path_Like because some Windows native
+   --  programs return mixed style paths such as "C:/blah/blah".
+
+   function To_Native (Path : Portable_Path_Like) return Native_Path_Like;
+
+private
+
+   use AAA.Strings;
+   use all type GNATCOLL.OS.OS_Type;
+
+   ----------------------
+   -- To_Portable_Like --
+   ----------------------
+
+   function To_Portable (Path : Any_Path)
+                              return Portable_Path_Like
+   is (case GNATCOLL.OS.Constants.OS is
+          when MacOS | Unix => Path,
+          when Windows      => Replace (Path, "\", "/"));
+
+   --------------------
+   -- To_Native_Like --
+   --------------------
+
+   function To_Native (Path : Portable_Path_Like) return Native_Path_Like
+   is (case GNATCOLL.OS.Constants.OS is
+          when MacOS | Unix => Path,
+          when Windows      => Replace (String (Path), "/", "\"));
+
 end Alire.OS_Lib;

src/alire/alire-platforms-current.ads

@@ -54,7 +54,7 @@ package Alire.Platforms.Current is
    --  via config.
 
    function Distribution_Is_Known return Boolean is
-     (Platforms."/=" (Distribution, Platforms.Distro_Unknown));
+     (Platforms."/=" (Distribution, Platforms.Distribution_Unknown));
 
    function Host_Architecture return Platforms.Architectures;
 
@@ -76,7 +76,7 @@ private
 
    function Distribution return Platforms.Distributions
    is (if Disable_Distribution_Detection
-       then Platforms.Distro_Unknown
+       then Platforms.Distribution_Unknown
        else Detected_Distribution);
 
    -----------------------
@@ -112,7 +112,7 @@ private
    ---------------
 
    function Toolchain return Platforms.Toolchains is
-     (if Distribution /= Distro_Unknown
+     (if Distribution /= Distribution_Unknown
          and then
          Alire.OS_Lib.Subprocess.Locate_In_Path ("gprconfig") =
            "/usr/bin/gprconfig"

src/alire/alire-platforms.ads

@@ -43,7 +43,7 @@ package Alire.Platforms with Preelaborate is
                           Suse,
                           Homebrew,
                           Macports,
-                          Distro_Unknown);
+                          Distribution_Unknown);
 
    subtype Known_Distributions is
      Distributions range Distributions'First ..
@@ -70,7 +70,7 @@ package Alire.Platforms with Preelaborate is
       Suse            => Zypper,
       Homebrew        => Homebrew,
       Macports        => Macports,
-      Distro_Unknown  => Packager_Unknown);
+      Distribution_Unknown  => Packager_Unknown);
 
    type Toolchains is (System,
                        --  Provided through system packages, able to use other

src/alire/alire-properties-environment.adb

@@ -71,6 +71,24 @@ package body Alire.Properties.Environment is
       use type Conditional.Properties;
       use TOML;
       Env : TOML_Value;
+
+      ----------------
+      -- Path_Check --
+      ----------------
+
+      procedure Path_Check (Var, S : String) is
+      begin
+         --  We expect something resembling a portable path, but we admit "\$"
+         --  as an escape sequence.
+         for I in S'Range loop
+            if S (I) = '\' and then (I = S'Last or else S (I + 1) /= '$') then
+               Raise_Checked_Error
+                 (Var & ": forbidden '\' character in environment path; "
+                  & "use '/' instead");
+            end if;
+         end loop;
+      end Path_Check;
+
    begin
       if From.Unwrap.Kind /= TOML_Table then
          From.Checked_Error
@@ -87,7 +105,7 @@ package body Alire.Properties.Environment is
          for Name of Env.Keys loop
             declare
                Var  : Variable;   -- The env. var. being parsed
-               Val  : TOML_Value; -- The env. var. value
+               Val  : TOML_Value; -- The env. var. action. value
             begin
                Var.Name := Name;
 
@@ -109,8 +127,10 @@ package body Alire.Properties.Environment is
                           Actions_Suggestion (Action_Image));
                end;
 
-               --  Value (already type checked in previous pop)
+               --  We consider values as possibly containing paths, so we check
+               --  that path separators are portable
 
+               Path_Check (+Name, Val.As_String);
                Var.Value := +Val.As_String;
 
                --  Pop entry to avoid upper "unexpected key" errors

src/alire/alire-properties-environment.ads

@@ -41,7 +41,7 @@ private
    type Variable is new Property with record
       Action : Actions;
       Name   : UString;
-      Value  : UString;
+      Value  : UString; -- Value with portable path separators
    end record;
 
 end Alire.Properties.Environment;

src/alire/alire-publish.adb

@@ -25,15 +25,14 @@ with Alire.TOML_Index;
 with Alire.TOML_Keys;
 with Alire.TOML_Load;
 with Alire.User_Pins.Maps;
+with Alire.Utils.Tools;
 with Alire.Utils.TTY;
 with Alire.Utils.User_Input.Query_Config;
 with Alire.VCSs.Git;
 with Alire.VFS;
 
 with CLIC.User_Input;
 
-with GNATCOLL.OS.Constants;
-
 with Semantic_Versioning;
 
 with TOML.File_IO;
@@ -631,12 +630,10 @@ package body Alire.Publish is
                                                With_Extension => False);
       Git        : constant VCSs.Git.VCS := VCSs.Git.Handler;
       Is_Repo    : constant Boolean := Git.Is_Repository (Base_Path (Context));
-      Archive    : constant Relative_Path :=
-                     Target_Dir
-                       / (Milestone
-                          & (if Is_Repo
-                             then ".tgz"
-                             else ".tbz2"));
+      Archive    : constant Relative_Path := Target_Dir / (Milestone & ".tgz");
+      --  We used to use tbz2 for locally tar'ed files, but that has an implicit
+      --  dependency on bzip2 that we are not managing yet, so for now we err on
+      --  the safe side of built-in tar gzip capabilities.
 
       -----------------
       -- Git_Archive --
@@ -669,14 +666,15 @@ package body Alire.Publish is
          OS_Lib.Subprocess.Checked_Spawn
            ("tar",
             Empty_Vector
-            & "cfj"
+            & "cfz"
             & Archive --  Destination file at alire/archives/crate-version.tbz2
 
             & String'("--exclude=./alire")
             --  Exclude top-level alire folder, before applying prefix
 
-            --  exclude .git and the like, with workaround for macOS bsd tar
-            & (if GNATCOLL.OS.Constants.OS in GNATCOLL.OS.MacOS
+            --  exclude .git and the like, with workaround for bsdtar used by
+            --  macOS and Windows without MSYS2
+            & (if Utils.Tools.Is_BSD_Tar
                then Empty_Vector
                     & "--exclude=./.git"
                     & "--exclude=./.hg"
@@ -1096,7 +1094,6 @@ package body Alire.Publish is
                         then Ada.Directories.Full_Name (Path)
                         else Ada.Directories.Full_Name (Root.Value.Path));
       begin
-
          if not Git.Is_Repository (Root_Path) then
             Git_Error ("no git repository found", Root_Path);
          end if;

src/alire/alire-toml_adapters.adb

@@ -263,8 +263,8 @@ package body Alire.TOML_Adapters is
    ----------------------
 
    function Pop_Single_Table (Queue : Key_Queue;
-                              Value : out TOML.TOML_Value;
-                              Kind  : TOML.Any_Value_Kind) return String
+                              Value : out TOML.TOML_Value)
+                              return String
    is
       use TOML;
    begin
@@ -280,14 +280,28 @@ package body Alire.TOML_Adapters is
 
       Value := Queue.Value.Get (Queue.Value.Keys (1));
 
+      return Key : constant String := +Queue.Value.Keys (1) do
+         Queue.Value.Unset (Queue.Value.Keys (1));
+      end return;
+   end Pop_Single_Table;
+
+   ----------------------
+   -- Pop_Single_Table --
+   ----------------------
+
+   function Pop_Single_Table (Queue : Key_Queue;
+                              Value : out TOML.TOML_Value;
+                              Kind  : TOML.Any_Value_Kind) return String
+   is
+      use TOML;
+      Key : constant String := Queue.Pop_Single_Table (Value);
+   begin
       if Value.Kind /= Kind then
          Queue.Checked_Error ("expected a single entry of type "
                               & Kind'Img & ", but got a " & Value.Kind'Img);
       end if;
 
-      return Key : constant String := +Queue.Value.Keys (1) do
-         Queue.Value.Unset (Queue.Value.Keys (1));
-      end return;
+      return Key;
    end Pop_Single_Table;
 
    -----------------------

src/alire/alire-toml_adapters.ads

@@ -98,8 +98,16 @@ package Alire.TOML_Adapters with Preelaborate is
    --  intended use is to process keys beginning with "case(" in the table.
 
    function Pop_Single_Table (Queue : Key_Queue;
-                              Value : out TOML.TOML_Value;
-                              Kind  : TOML.Any_Value_Kind) return String;
+                              Value : out TOML.TOML_Value)
+                              return String;
+   --  For constructions like [parent.child.grandchild], where only one child
+   --  is allowed. Child is returned as String, and Value is set to granchild.
+   --  Raises Checked_Error if Queue is not a table, or it doesn't contain
+   --  exactly one key.
+
+   function Pop_Single_Table (Queue  : Key_Queue;
+                              Value  : out TOML.TOML_Value;
+                              Kind   : TOML.Any_Value_Kind) return String;
    --  For constructions like [parent.child.grandchild], where we known that
    --  only one child can exist. Will raise Checked_Error if any of these
    --  happens: Queue is not a table; Queue doesn't have exactly one key; Value