From 6d420b7059944a6f09d37a35851f68348d7976fe Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 23 Mar 2021 15:53:33 +0100 Subject: [PATCH] Store relative pins as such (#711) * Store relative pins when given as such * Ensure pinned dirs use portable paths when relative * Adjustments in testsuite for new relative links --- src/alire/alire-externals-softlinks.adb | 53 ++++++++++++++++++------- src/alire/alire-externals-softlinks.ads | 12 ++++-- src/alire/alire-publish.adb | 4 +- src/alire/alire-roots.adb | 3 +- src/alire/alire-toml_index.adb | 3 +- src/alire/alire-vfs.ads | 37 +++++++++++++++-- src/alire/alire.ads | 2 +- testsuite/tests/pin/change-type/test.py | 2 +- testsuite/tests/pin/pin-dir/test.py | 2 +- 9 files changed, 90 insertions(+), 28 deletions(-) diff --git a/src/alire/alire-externals-softlinks.adb b/src/alire/alire-externals-softlinks.adb index 703973a9..39a69658 100644 --- a/src/alire/alire-externals-softlinks.adb +++ b/src/alire/alire-externals-softlinks.adb @@ -3,16 +3,20 @@ with Ada.Directories; with Alire.URI; with Alire.Utils.TTY; +with GNATCOLL.VFS; + package body Alire.Externals.Softlinks is + package Adirs renames Ada.Directories; use TOML; package Keys is -- TOML Keys used locally - Kind : constant String := "kind"; - Path : constant String := "path"; + Kind : constant String := "kind"; + Path : constant String := "path"; + Relative : constant String := "relative"; end Keys; @@ -48,16 +52,30 @@ package body Alire.Externals.Softlinks is & Utils.TTY.Emph (Path)); end if; - -- Store the path as absolute, so later usage does not depend on the - -- exact location the user is using these paths + -- Store the path as a minimal relative path, so cloning a monorepo + -- will work as-is, when originally given as a relative path declare - Absolute : constant Absolute_Path := - Ada.Directories.Full_Name (Path); + use GNATCOLL.VFS; + Target : constant Filesystem_String := + (if Check_Absolute_Path (Path) + then +Path + else GNATCOLL.VFS.Relative_Path + (File => Create (+Adirs.Full_Name (Path)), + From => Create (+Adirs.Current_Directory))); + begin - return (Externals.External with - Path_Length => Absolute'Length, - Path => Absolute); + if Check_Absolute_Path (Path) then + return (Externals.External with + Relative => False, + Path_Length => Path'Length, + Abs_Path => Path); + else + return (Externals.External with + Relative => True, + Path_Length => Target'Length, + Rel_Path => Alire.VFS.To_Portable (+Target)); + end if; end; end; end New_Softlink; @@ -72,11 +90,18 @@ package body Alire.Externals.Softlinks is begin Table.Set (Keys.Kind, Create_String (Utils.To_Lower_Case (Softlink'Img))); - - Table.Set (Keys.Path, - Create_String ("file:" & This.Path)); - -- Ensure file: is there so absolute paths on Windows do not report the - -- drive letter as the scheme (file:C:\\ is correct, C:\\ is not). + Table.Set (Keys.Relative, + Create_Boolean (This.Relative)); + + if This.Relative then + Table.Set (Keys.Path, + Create_String ("file:" & String (This.Rel_Path))); + else + Table.Set (Keys.Path, + Create_String ("file:" & This.Abs_Path)); + end if; + -- "file:" is there so absolute paths on Windows do not report the drive + -- letter as the scheme (file:C:\\ is correct, C:\\ is not). return Table; end To_TOML; diff --git a/src/alire/alire-externals-softlinks.ads b/src/alire/alire-externals-softlinks.ads index 69c3f8a6..78a6ecc3 100644 --- a/src/alire/alire-externals-softlinks.ads +++ b/src/alire/alire-externals-softlinks.ads @@ -1,5 +1,6 @@ with Alire.Interfaces; with Alire.TOML_Adapters; +private with Alire.VFS; with TOML; @@ -50,10 +51,13 @@ package Alire.Externals.Softlinks is private - type External (Path_Length : Positive) is + type External (Relative : Boolean; Path_Length : Positive) is new Externals.External and Interfaces.Tomifiable with record - Path : Any_Path (1 .. Path_Length); + case Relative is + when True => Rel_Path : Portable_Path (1 .. Path_Length); + when False => Abs_Path : Absolute_Path (1 .. Path_Length); + end case; end record; ----------- @@ -76,7 +80,9 @@ private ---------- function Path (This : External) return Any_Path - is (This.Path); + is (if This.Relative + then VFS.To_Native (This.Rel_Path) + else This.Abs_Path); ------------------- -- Project_Paths -- diff --git a/src/alire/alire-publish.adb b/src/alire/alire-publish.adb index 32889714..2f594541 100644 --- a/src/alire/alire-publish.adb +++ b/src/alire/alire-publish.adb @@ -454,14 +454,14 @@ package body Alire.Publish is & Index.Community_Repo_Name & "/upload/" & Index.Community_Branch & "/" - & TOML_Index.Manifest_Path (Name)) + & String (TOML_Index.Manifest_Path (Name))) & " to create a pull request against the community index."); else Log_Info ("Please create a pull request against the community index at " & TTY.URL (Utils.Tail (Index.Community_Repo, '+')) & " including this file at " - & TTY.URL (TOML_Index.Manifest_Path (Name))); + & TTY.URL (String (TOML_Index.Manifest_Path (Name)))); end if; exception diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb index 702eee2d..0c9a9d53 100644 --- a/src/alire/alire-roots.adb +++ b/src/alire/alire-roots.adb @@ -451,6 +451,7 @@ package body Alire.Roots is Crate : Crate_Name) return Any_Path is + package Adirs renames Ada.Directories; Deps_Dir : constant Any_Path := This.Dependencies_Dir; begin if This.Release.Element.Name = Crate then @@ -458,7 +459,7 @@ package body Alire.Roots is elsif This.Solution.State (Crate).Is_Solved then return Deps_Dir / Release (This, Crate).Unique_Folder; elsif This.Solution.State (Crate).Is_Linked then - return This.Solution.State (Crate).Link.Path; + return Adirs.Full_Name (This.Solution.State (Crate).Link.Path); else raise Program_Error with "release must be either solved or linked"; end if; diff --git a/src/alire/alire-toml_index.adb b/src/alire/alire-toml_index.adb index 0983c0e1..b4285a5e 100644 --- a/src/alire/alire-toml_index.adb +++ b/src/alire/alire-toml_index.adb @@ -476,7 +476,8 @@ package body Alire.TOML_Index is function Manifest_Path (Crate : Crate_Name) return Portable_Path is Name : constant String := +Crate; begin - return "index/" & Name (Name'First .. Name'First + 1) & "/" & Name; + return Portable_Path + ("index/" & Name (Name'First .. Name'First + 1) & "/" & Name); end Manifest_Path; end Alire.TOML_Index; diff --git a/src/alire/alire-vfs.ads b/src/alire/alire-vfs.ads index b198df80..dcf66b95 100644 --- a/src/alire/alire-vfs.ads +++ b/src/alire/alire-vfs.ads @@ -1,17 +1,23 @@ with Ada.Containers.Vectors; +private with Alire.Utils; + +private with GNATCOLL.OS.Constants; with GNATCOLL.VFS; package Alire.VFS is + -- Portable paths are relative and use forward slashes. Absolute paths + -- cannot be portable. + + function To_Portable (Path : Relative_Path) return Portable_Path; + + function To_Native (Path : Portable_Path) return Relative_Path; + -- Wrapper types on top of GNATCOLL.VFS that hide pointers/deallocations. -- Some types are renamed here to be able to rely on this spec without -- needing to mix both Alire.VFS and GNATCOLL.VFS. - -- TODO: progressively migrate use of plain Strings in Alire for filesystem - -- strings to Filesystem_String/Virtual_File. Likewise for the mix of - -- Platform_Independent_Path, Absolute/Relative_Path, and related chaos. - -- Basic types: subtype Filesystem_String is GNATCOLL.VFS.Filesystem_String; @@ -58,4 +64,27 @@ package Alire.VFS is Special : Boolean := True) return Virtual_File_Vector; -- As GNATCOLL's one, plus if not Special, omit "." and "..". +private + + use all type GNATCOLL.OS.OS_Type; + + ----------------- + -- To_Portable -- + ----------------- + + function To_Portable (Path : Relative_Path) return Portable_Path + is (case GNATCOLL.OS.Constants.OS is + when MacOS | Unix => Portable_Path (Path), + when Windows => Portable_Path (Utils.Replace (Path, "\", "/"))); + + --------------- + -- To_Native -- + --------------- + + function To_Native (Path : Portable_Path) return Relative_Path + is (case GNATCOLL.OS.Constants.OS is + when MacOS | Unix => Relative_Path (Path), + when Windows => Relative_Path + (Utils.Replace (String (Path), "/", "\"))); + end Alire.VFS; diff --git a/src/alire/alire.ads b/src/alire/alire.ads index 9dce34e2..b4b6243d 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -113,7 +113,7 @@ package Alire with Preelaborate is -- Base type for paths in Alire. These paths are always platform-dependent -- and can be used directly with filesystem functions. - subtype Portable_Path is String with + type Portable_Path is new String with Dynamic_Predicate => (for all Char of Portable_Path => Char /= '\'); -- A portable path always uses forward slashes. For use in the current -- platform, it should be adapted first. diff --git a/testsuite/tests/pin/change-type/test.py b/testsuite/tests/pin/change-type/test.py index 71d1d9ac..7b12e490 100644 --- a/testsuite/tests/pin/change-type/test.py +++ b/testsuite/tests/pin/change-type/test.py @@ -36,7 +36,7 @@ p = run_alr('show', '--solve') s = re.escape(dir_separator()) # platform-dependent assert_match('.*Dependencies \(external\):.*' 'libhello\^1 \(direct,linked' - ',pin=.*' + s + 'pin__change-type' + s + + ',pin=..' + s + # relative link should be preserved 'crates' + s + 'libhello_1.0.0\).*', p.out, flags=re.S) diff --git a/testsuite/tests/pin/pin-dir/test.py b/testsuite/tests/pin/pin-dir/test.py index b9810668..dfab92df 100644 --- a/testsuite/tests/pin/pin-dir/test.py +++ b/testsuite/tests/pin/pin-dir/test.py @@ -32,7 +32,7 @@ p = run_alr('with', '--solve') s = re.escape(dir_separator()) # platform-dependent assert_match('.*Dependencies \(external\):.*' 'libhello\^1.0.0 \(direct,linked' - ',pin=.*' + s + 'pin__pin-dir' + s + + ',pin=..' + s + # check that relative path is preserved 'crates' + s + 'libhello_1.0.0\).*', p.out, flags=re.S) -- 2.39.5