Merge branch 'master' into feat/improve-uri-recognition

alire.toml

@@ -74,7 +74,7 @@ commit = "56bbdc008e16996b6f76e443fd0165a240de1b13"
 
 [pins.den]
 url    = "https://github.com/mosteo/den"
-commit = "b12e8461bf41e2cfe199c8196b45fa4fc213a6aa"
+commit = "653a4c9ba4469d7e1a8896088789b6514ecdf834"
 
 [pins.dirty_booleans]
 url    = "https://github.com/mosteo/dirty_booleans"

src/alire/alire-directories.adb

@@ -14,6 +14,7 @@ with Alire.VFS;
 with Alire.Utils;
 
 with Den.Filesystem;
+with Den.Iterators;
 with Den.Walk;
 
 with GNAT.String_Hash;
@@ -105,62 +106,44 @@ package body Alire.Directories is
    ----------
 
    procedure Copy (Src_Folder, Dst_Parent_Folder : String;
-                   Excluding                     : String := "") is
-      use Ada.Directories;
-      Search : Search_Type;
-      Item   : Directory_Entry_Type;
+                   Excluding                     : String := "")
+   is
+      use all type Den.Kinds;
    begin
-      Start_Search (Search, Src_Folder, "*");
-      while More_Entries (Search) loop
-         Get_Next_Entry (Search, Item);
-         if Simple_Name (Item) /= Excluding then
-            --  Recurse for subdirectories
-            if Kind (Item) = Directory and then
-              Simple_Name (Item) /= "." and then Simple_Name (Item) /= ".."
-            then
-               declare
-                  Subfolder : constant String :=
-                                Compose (Dst_Parent_Folder,
-                                         Simple_Name (Item));
-               begin
-                  if not Exists (Subfolder) then
-                     Ada.Directories.Create_Directory (Subfolder);
-                  end if;
-                  Copy (Full_Name (Item), Subfolder, Excluding);
-               end;
-
-            --  Copy for files
-            elsif Kind (Item) = Ordinary_File then
-               Copy_File (Full_Name (Item),
-                          Compose (Dst_Parent_Folder, Simple_Name (Item)));
+      for Simple_Item of Den.Iterators.Iterate (Src_Folder) loop
+         declare
+            Full_Item : constant Den.Path := Src_Folder / Simple_Item;
+         begin
+            if Simple_Item /= Excluding then
+               --  Recurse for subdirectories
+               if Den.Kind (Full_Item) = Den.Directory then
+                  declare
+                     Subfolder : constant String :=
+                                   Dst_Parent_Folder / Simple_Item;
+                  begin
+                     if not Den.Exists (Subfolder) then
+                        Den.Filesystem.Create_Directory (Subfolder);
+                     end if;
+                     Copy (Full_Item, Subfolder, Excluding);
+                  end;
+
+                  --  Copy for files/links
+               elsif Den.Kind (Full_Item) in File | Softlink then
+                  Den.Filesystem.Copy
+                    (Full_Item,
+                     Dst_Parent_Folder / Simple_Item);
+
+               else
+                  Raise_Checked_Error
+                    ("Cannot copy item of kind " & Den.Kind (Full_Item)'Image
+                     & ": " & Full_Item);
+
+               end if;
             end if;
-         end if;
+         end;
       end loop;
-      End_Search (Search);
    end Copy;
 
-   ---------------
-   -- Copy_Link --
-   ---------------
-
-   procedure Copy_Link (Src, Dst : Any_Path) is
-      use AAA.Strings;
-      use all type Platforms.Operating_Systems;
-      Keep_Links : constant String
-        := (case Platforms.Current.Operating_System is
-               when Linux           => "-d",
-               when FreeBSD | OpenBSD | MacOS => "-R",
-               when others          =>
-                  raise Program_Error with "Unsupported operation");
-   begin
-      --  Given that we are here because Src is indeed a link, we should be in
-      --  a Unix-like platform able to do this.
-      OS_Lib.Subprocess.Checked_Spawn
-        ("cp",
-         To_Vector (Keep_Links)
-         & Src & Dst);
-   end Copy_Link;
-
    -----------------
    -- Create_Tree --
    -----------------
@@ -443,41 +426,6 @@ package body Alire.Directories is
                                  Den.Scrub (Child));
    end Find_Relative_Path;
 
-   ----------------------
-   -- Find_Single_File --
-   ----------------------
-
-   function Find_Single_File (Path      : String;
-                              Extension : String)
-                              return String
-   is
-      use Ada.Directories;
-      Search : Search_Type;
-      File   : Directory_Entry_Type;
-   begin
-      Start_Search (Search    => Search,
-                    Directory => Path,
-                    Pattern   => "*" & Extension,
-                    Filter    => (Ordinary_File => True, others => False));
-      if More_Entries (Search) then
-         Get_Next_Entry (Search, File);
-         return Name : constant String :=
-           (if More_Entries (Search)
-            then ""
-            else Full_Name (File))
-         do
-            End_Search (Search);
-         end return;
-      else
-         End_Search (Search);
-         return "";
-      end if;
-   exception
-      when Name_Error =>
-         Trace.Debug ("Search path does not exist: " & Path);
-         return "";
-   end Find_Single_File;
-
    ----------------
    -- Initialize --
    ----------------
@@ -876,39 +824,9 @@ package body Alire.Directories is
             end if;
          end if;
 
-         --  We use GNAT.OS_Lib here as some binary packages contain softlinks
-         --  to .so libs that we must copy too, and these are troublesome
-         --  with regular Ada.Directories (that has no concept of softlink).
-         --  Also, some of these softlinks are broken and although they are
-         --  presumably safe to discard, let's just go for an identical copy.
-
-         if GNAT.OS_Lib.Is_Symbolic_Link (Src) then
-            Trace.Debug ("   Merge (softlink): " & Src);
-
-            Copy_Link (Src, Dst);
-            if not GNAT.OS_Lib.Is_Symbolic_Link (Dst) then
-               Raise_Checked_Error ("Failed to copy softlink: "
-                                    & TTY.URL (Src)
-                                    & " to " & TTY.URL (Dst)
-                                    & " (dst not a link)");
-            end if;
-         else
-            begin
-               Adirs.Copy_File (Source_Name => Src,
-                                Target_Name => Dst,
-                                Form        => "preserve=all_attributes");
-            exception
-               when E : others =>
-                  Trace.Error
-                    ("When copying " & Src & " (" & Den.Kind (Src)'Image
-                     & ") --> " & Dst & ": ");
-                  Trace.Error
-                    ("Src item was: "
-                     & Item & " (" & Den.Kind (Item)'Image & ")");
-                  Log_Exception (E, Error);
-                  raise;
-            end;
-         end if;
+         Den.Filesystem.Copy (Src, Dst);
+         --  This copy should preserve both softlinks and attributes
+
       end Merge;
 
    begin

src/alire/alire-directories.ads

@@ -32,10 +32,6 @@ package Alire.Directories is
    --  equivalent to "cp -r src/* dst/". Excluding may be a single name that
    --  will not be copied (if file) or recursed into (if folder).
 
-   procedure Copy_Link (Src, Dst : Any_Path)
-     with Pre => GNAT.OS_Lib.Is_Symbolic_Link (Src);
-   --  Copy a softlink into a new place preserving its relative path to target
-
    function Current return String renames Ada.Directories.Current_Directory;
 
    function Parent (Path : Any_Path) return String
@@ -79,12 +75,6 @@ package Alire.Directories is
    function Find_Relative_Path_To (Path : Any_Path) return Any_Path;
    --  Same as Find_Relative_Path (Parent => Current, Child => Path)
 
-   function Find_Single_File (Path      : String;
-                              Extension : String)
-                              return String;
-   --  Finds a single file in a folder with the given extension and return its
-   --  absolute path.  If more than one, or none, returns "".
-
    function Is_Directory (Path : Any_Path) return Boolean;
    --  Returns false for non-existing paths too
 

src/alire/alire-platforms-common.adb

@@ -1,4 +1,5 @@
 with AAA.Enum_Tools;
+with GNAT.OS_Lib;
 
 with Alire.OS_Lib.Subprocess;
 
@@ -71,4 +72,27 @@ package body Alire.Platforms.Common is
       end Detect;
    end Machine_Hardware_Name;
 
+   ----------------------
+   -- Unix_Home_Folder --
+   ----------------------
+
+   function Unix_Home_Folder return String
+   is
+      Home_Var      : constant String  := OS_Lib.Getenv ("HOME", "unset");
+      Maybe_Windows : constant Boolean := Home_Var = "unset"
+         and then GNAT.OS_Lib.Directory_Separator = '\';
+   begin
+      if Maybe_Windows then
+         raise Checked_Error with
+            "$HOME is not set, you might be running an"
+            & " `alr` built for a non-Windows OS";
+      elsif Home_Var = "unset" or else
+       not GNAT.OS_Lib.Is_Write_Accessible_File (Home_Var)
+      then
+         return "/tmp";
+      else
+         return Home_Var;
+      end if;
+   end Unix_Home_Folder;
+
 end Alire.Platforms.Common;

src/alire/alire-platforms-common.ads

@@ -19,15 +19,7 @@ private package Alire.Platforms.Common is
    -- Unix_Home_Folder --
    ---------------------
 
-   function Unix_Home_Folder return String
-   is (if OS_Lib.Getenv ("HOME", "unset") = "unset" and then
-       GNAT.OS_Lib.Directory_Separator = '\'
-       then
-          raise Checked_Error with
-            "$HOME is not set, you might be running an"
-       & " `alr` built for a non-Windows OS"
-       else
-          OS_Lib.Getenv ("HOME", Default => "/tmp"));
+   function Unix_Home_Folder return String;
 
    ----------------------
    -- Unix_Temp_Folder --

src/alr/alr-commands-version.adb

@@ -98,6 +98,7 @@ package body Alr.Commands.Version is
 
       Add ("");
       Add ("CONFIGURATION");
+      Add ("home folder:",     Alire.Platforms.Folders.Home);
       Add ("settings folder:", Alire.Settings.Edit.Path);
       Add ("cache folder:",    Alire.Cache.Path);
       Add ("vault folder:",    Paths.Vault.Path);

testsuite/tests/cache/sync-attrs/my_index/crates/crate/.gitignore

@@ -0,0 +1,4 @@
+/obj/
+/bin/
+/alire/
+/config/

testsuite/tests/cache/sync-attrs/my_index/crates/crate/alire.toml

@@ -0,0 +1,12 @@
+name = "crate"
+description = "Sample crate with an action"
+version = "0.1.0-dev"
+
+authors = ["Alejandro R. Mosteo"]
+maintainers = ["Alejandro R. Mosteo <[email protected]>"]
+maintainers-logins = ["mosteo"]
+licenses = "MIT OR Apache-2.0 WITH LLVM-exception"
+website = ""
+tags = []
+
+executables = ["crate"]

testsuite/tests/cache/sync-attrs/my_index/crates/crate/crate.gpr

@@ -0,0 +1,22 @@
+with "config/crate_config.gpr";
+project Crate is
+
+   for Source_Dirs use ("src/", "config/");
+   for Object_Dir use "obj/" & Crate_Config.Build_Profile;
+   for Create_Missing_Dirs use "True";
+   for Exec_Dir use "bin";
+   for Main use ("crate.adb");
+
+   package Compiler is
+      for Default_Switches ("Ada") use Crate_Config.Ada_Compiler_Switches;
+   end Compiler;
+
+   package Binder is
+      for Switches ("Ada") use ("-Es"); --  Symbolic traceback
+   end Binder;
+
+   package Install is
+      for Artifacts (".") use ("share");
+   end Install;
+
+end Crate;

testsuite/tests/cache/sync-attrs/my_index/crates/crate/myscript.sh

@@ -0,0 +1 @@
+echo "SCRIPT RUN"

testsuite/tests/cache/sync-attrs/my_index/crates/crate/src/crate.adb

@@ -0,0 +1,4 @@
+procedure Crate is
+begin
+   null;
+end Crate;

testsuite/tests/cache/sync-attrs/my_index/index/cr/crate/crate-1.0.0.toml

@@ -0,0 +1,13 @@
+description = "Sample crate"
+name = "crate"
+version = "1.0.0"
+licenses = []
+maintainers = ["[email protected]"]
+maintainers-logins = ["someone"]
+
+[[actions]]
+command = ["sh", "-c", "./myscript.sh"]
+type = "pre-build"
+
+[origin]
+url = "file:../../../crates/crate"

testsuite/tests/cache/sync-attrs/my_index/index/index.toml

@@ -0,0 +1 @@
+version = "1.2"

testsuite/tests/cache/sync-attrs/test.py

@@ -0,0 +1,19 @@
+"""
+Check that executable attributes are synchronized correctly. We have a
+dependency which launches a shell script in its pre-build step; this fails
+unless the script is executable, which it should be after syncing.
+"""
+
+from drivers.alr import run_alr, init_local_crate, alr_with
+from drivers.asserts import assert_eq
+
+# Init a crate that will have the test crate as a dependency, thus causing its
+# syncing.
+
+init_local_crate()
+alr_with("crate", manual=False, update=False)   # Delay syncing to capture output
+p = run_alr("build", "--stop-after=pre-build")  # Gain some testing time by not building
+
+assert_eq(p.out, "SCRIPT RUN\n")
+
+print("SUCCESS")

testsuite/tests/cache/sync-attrs/test.yaml

@@ -0,0 +1,8 @@
+driver: python-script
+build_mode: shared
+control:
+    - [SKIP, "skip_unix", "Test is Unix-only"]
+indexes:
+    compiler_only_index: {}
+    my_index:
+        in_fixtures: false