diff --git a/alire.toml b/alire.toml index b853e5fa8..b5da93505 100644 --- a/alire.toml +++ b/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" diff --git a/deps/den b/deps/den index b12e8461b..653a4c9ba 160000 --- a/deps/den +++ b/deps/den @@ -1 +1 @@ -Subproject commit b12e8461bf41e2cfe199c8196b45fa4fc213a6aa +Subproject commit 653a4c9ba4469d7e1a8896088789b6514ecdf834 diff --git a/src/alire/alire-directories.adb b/src/alire/alire-directories.adb index 8824cd6d8..38249592e 100644 --- a/src/alire/alire-directories.adb +++ b/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 diff --git a/src/alire/alire-directories.ads b/src/alire/alire-directories.ads index 250b4b709..f32920938 100644 --- a/src/alire/alire-directories.ads +++ b/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 diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/.emptydir b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/.emptydir new file mode 100644 index 000000000..e69de29bb diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/.gitignore b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/.gitignore new file mode 100644 index 000000000..5866d7bfa --- /dev/null +++ b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/.gitignore @@ -0,0 +1,4 @@ +/obj/ +/bin/ +/alire/ +/config/ diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/alire.toml b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/alire.toml new file mode 100644 index 000000000..18d2d0821 --- /dev/null +++ b/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 "] +maintainers-logins = ["mosteo"] +licenses = "MIT OR Apache-2.0 WITH LLVM-exception" +website = "" +tags = [] + +executables = ["crate"] diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/crate.gpr b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/crate.gpr new file mode 100644 index 000000000..29bbd90b8 --- /dev/null +++ b/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; diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/myscript.sh b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/myscript.sh new file mode 100755 index 000000000..eeca002cf --- /dev/null +++ b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/myscript.sh @@ -0,0 +1 @@ +echo "SCRIPT RUN" \ No newline at end of file diff --git a/testsuite/tests/cache/sync-attrs/my_index/crates/crate/src/crate.adb b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/src/crate.adb new file mode 100644 index 000000000..27b9f460a --- /dev/null +++ b/testsuite/tests/cache/sync-attrs/my_index/crates/crate/src/crate.adb @@ -0,0 +1,4 @@ +procedure Crate is +begin + null; +end Crate; diff --git a/testsuite/tests/cache/sync-attrs/my_index/index/cr/crate/crate-1.0.0.toml b/testsuite/tests/cache/sync-attrs/my_index/index/cr/crate/crate-1.0.0.toml new file mode 100644 index 000000000..cb71c1928 --- /dev/null +++ b/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 = ["any@bo.dy"] +maintainers-logins = ["someone"] + +[[actions]] +command = ["sh", "-c", "./myscript.sh"] +type = "pre-build" + +[origin] +url = "file:../../../crates/crate" diff --git a/testsuite/tests/cache/sync-attrs/my_index/index/index.toml b/testsuite/tests/cache/sync-attrs/my_index/index/index.toml new file mode 100644 index 000000000..c2a2c7dbc --- /dev/null +++ b/testsuite/tests/cache/sync-attrs/my_index/index/index.toml @@ -0,0 +1 @@ +version = "1.2" diff --git a/testsuite/tests/cache/sync-attrs/test.py b/testsuite/tests/cache/sync-attrs/test.py new file mode 100644 index 000000000..afad4a5fd --- /dev/null +++ b/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") diff --git a/testsuite/tests/cache/sync-attrs/test.yaml b/testsuite/tests/cache/sync-attrs/test.yaml new file mode 100644 index 000000000..79bbf3107 --- /dev/null +++ b/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 \ No newline at end of file