From dcd7b6605db80a8a6ea6921fa7ca141efe57991b Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Fri, 19 Jun 2020 19:01:46 +0200 Subject: [PATCH] Ability to use a local folder to fulfill a dependency (#439) * New Alire.Externals.Softlink to support WIP crates * Implement alr with --url to add/pin in one step A dependency can now be added simultaneously with a target directory that fulfils it. Minimal check of the folder existing is performed; the buildability of the whole is now the responsibility of the user. * Implement softlinks in Alr.Dependencies.States The placeholder `linked` fulfilment is now properly implemented to hold/load/save the information about a directory to be used to fulfill a dependency. * Implement softlinks in Alire.Solutions.Solution Add a Alire.Solutions.Linking subprogram that includes a linked dependency into a solution. * Modify solver to use soflinks for dependencies When a softlink for the dependency being solved exists in the starting solution, that dependency can be considered fulfilled without further ado. * Implement `alr pin --url` to pin existing dep This is the delayed counterpart to `alr with --url`; i.e., users can add the dependency normally with `alr with` and later decide to pin it to a folder with `alr pin`, without needing to remove it completely first with `alr with --del`. We present pinning to versions and to folders to users under the same idea of pinning. Internally, alr distinguishes between pinning (to versions) and linking (to URLs). Currently only local paths can be used for links, but in the future we may add remote files to fetch or repositories to clone. * New Alire.URI to centralize URL knowledge * Include pinned dirs' paths in project paths The logic of collecting all necessary paths has been moved from Alr.Build_Env to Alire.Roots.Project_Paths. A Root was already necessary to collect the paths, and furthermore the root has all the necessary information: the root release and the complete solution, which includes releases and linked dirs. To make Roots self-contained, the platform properties are copied during startup to Alire.Root. This is a temporary measure until these properties are refactored from Alr into Alire. * New tests for within/pinning to folders * Testsuite fixes for minor changes in output Information shown for external (lacking a release) dependencies is more comprehensive now, showing transitivity, pin information, hinting status. * Crate log of user-visible changes * Spelling fixes * Review: rename --url to --use --- .gitmodules | 3 + alire.gpr | 1 + alr.gpr | 1 + alr_env.gpr | 1 + deps/uri-ada | 1 + doc/user-changes.md | 24 ++++ src/alire/alire-conditional_trees.ads | 2 +- src/alire/alire-dependencies-graphs.adb | 7 +- src/alire/alire-dependencies-states.adb | 127 +++++++++++------- src/alire/alire-dependencies-states.ads | 91 ++++++++++--- src/alire/alire-externals-softlinks.adb | 84 ++++++++++++ src/alire/alire-externals-softlinks.ads | 88 ++++++++++++ src/alire/alire-externals.adb | 2 + src/alire/alire-externals.ads | 4 + src/alire/alire-pinning.adb | 22 ++- src/alire/alire-pinning.ads | 11 +- src/alire/alire-root.adb | 17 ++- src/alire/alire-root.ads | 8 ++ src/alire/alire-roots.adb | 52 +++++++ src/alire/alire-roots.ads | 30 ++++- src/alire/alire-solutions-diffs.adb | 8 +- src/alire/alire-solutions-diffs.ads | 4 +- src/alire/alire-solutions.adb | 13 +- src/alire/alire-solutions.ads | 77 ++++++++++- src/alire/alire-solver.adb | 22 ++- src/alire/alire-uri.ads | 108 +++++++++++++++ src/alire/alire-utils-tty.ads | 4 + src/alire/alire-workspace.adb | 4 +- src/alire/alire.adb | 11 ++ src/alire/alire.ads | 3 + src/alr/alr-build_env.adb | 43 +----- src/alr/alr-commands-init.adb | 5 +- src/alr/alr-commands-pin.adb | 53 +++++++- src/alr/alr-commands-pin.ads | 7 +- src/alr/alr-commands-withing.adb | 110 +++++++++++++-- src/alr/alr-commands-withing.ads | 7 +- src/alr/alr-main.adb | 12 ++ testsuite/drivers/alr.py | 2 +- testsuite/drivers/helpers.py | 37 ++++- testsuite/tests/index/external-hint/test.py | 2 +- .../crates/libhello_1.0.0/libhello.gpr | 24 ++++ .../crates/libhello_1.0.0/src/libhello.ads | 3 + .../pin/change-type/my_index/index/index.toml | 1 + .../my_index/index/li/libhello.toml | 8 ++ testsuite/tests/pin/change-type/test.py | 48 +++++++ testsuite/tests/pin/change-type/test.yaml | 4 + .../crates/libhello_1.0.0/libhello.gpr | 24 ++++ .../crates/libhello_1.0.0/src/libhello.ads | 3 + .../pin/pin-dir/my_index/index/index.toml | 1 + .../pin-dir/my_index/index/li/libhello.toml | 8 ++ testsuite/tests/pin/pin-dir/test.py | 47 +++++++ testsuite/tests/pin/pin-dir/test.yaml | 4 + testsuite/tests/with/external/test.py | 2 +- .../crates/libhello_1.0.0/libhello.gpr | 24 ++++ .../crates/libhello_1.0.0/src/libhello.ads | 3 + .../with/pin-dir/my_index/index/index.toml | 1 + .../my_index/index/libhello/libhello.toml | 8 ++ testsuite/tests/with/pin-dir/test.py | 43 ++++++ testsuite/tests/with/pin-dir/test.yaml | 4 + 59 files changed, 1206 insertions(+), 162 deletions(-) create mode 160000 deps/uri-ada create mode 100644 doc/user-changes.md create mode 100644 src/alire/alire-externals-softlinks.adb create mode 100644 src/alire/alire-externals-softlinks.ads create mode 100644 src/alire/alire-roots.adb create mode 100644 src/alire/alire-uri.ads create mode 100644 testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/libhello.gpr create mode 100644 testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/src/libhello.ads create mode 100644 testsuite/tests/pin/change-type/my_index/index/index.toml create mode 100644 testsuite/tests/pin/change-type/my_index/index/li/libhello.toml create mode 100644 testsuite/tests/pin/change-type/test.py create mode 100644 testsuite/tests/pin/change-type/test.yaml create mode 100644 testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr create mode 100644 testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads create mode 100644 testsuite/tests/pin/pin-dir/my_index/index/index.toml create mode 100644 testsuite/tests/pin/pin-dir/my_index/index/li/libhello.toml create mode 100644 testsuite/tests/pin/pin-dir/test.py create mode 100644 testsuite/tests/pin/pin-dir/test.yaml create mode 100644 testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr create mode 100644 testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads create mode 100644 testsuite/tests/with/pin-dir/my_index/index/index.toml create mode 100644 testsuite/tests/with/pin-dir/my_index/index/libhello/libhello.toml create mode 100644 testsuite/tests/with/pin-dir/test.py create mode 100644 testsuite/tests/with/pin-dir/test.yaml diff --git a/.gitmodules b/.gitmodules index 598852b2..77c6baf4 100644 --- a/.gitmodules +++ b/.gitmodules @@ -26,3 +26,6 @@ [submodule "deps/ansi"] path = deps/ansi url = https://github.com/mosteo/ansi-ada +[submodule "deps/uri-ada"] + path = deps/uri-ada + url = https://github.com/mosteo/uri-ada.git diff --git a/alire.gpr b/alire.gpr index 3170afc8..bdf9a3b1 100644 --- a/alire.gpr +++ b/alire.gpr @@ -6,6 +6,7 @@ with "ansi"; with "gnatcoll"; with "semantic_versioning"; with "simple_logging"; +with "uri"; with "xml_ez_out"; library project Alire is diff --git a/alr.gpr b/alr.gpr index 5353c45e..353ae798 100644 --- a/alr.gpr +++ b/alr.gpr @@ -5,6 +5,7 @@ with "alire_common"; with "ajunitgen"; with "semantic_versioning"; with "simple_logging"; +with "uri"; with "xml_ez_out"; project Alr is diff --git a/alr_env.gpr b/alr_env.gpr index 5368640f..3ae067e6 100644 --- a/alr_env.gpr +++ b/alr_env.gpr @@ -10,6 +10,7 @@ aggregate project Alr_Env is "deps/gnatcoll-slim", "deps/semantic_versioning", "deps/simple_logging", + "deps/uri-ada", "deps/xmlezout"); for Project_Files use ("alr.gpr"); diff --git a/deps/uri-ada b/deps/uri-ada new file mode 160000 index 00000000..e045780b --- /dev/null +++ b/deps/uri-ada @@ -0,0 +1 @@ +Subproject commit e045780bf2cacd6cb521da6b8eb8739632cdc5cd diff --git a/doc/user-changes.md b/doc/user-changes.md new file mode 100644 index 00000000..31e3ddfc --- /dev/null +++ b/doc/user-changes.md @@ -0,0 +1,24 @@ +# User-facing changes log + +This document is a development diary summarizing changes in `alr` that notably +affect the user experience. It is intended as a one-stop point for users to +stay on top of `alr` new features. + +### Use a directory to fulfill a dependency + +PR [#439](https://github.com/alire-project/alire/pull/439) + +A local path can now be used to fulfill a dependency. The path can be supplied +during initial dependency addition or afterwards during pinning, via the +`--use` switch. Such a path will be added to the environment generated by `alr +setenv`. Examples: + +```bash +$ alr with some_crate --use /some/absolute/or/relative/path +# To simultaneously add a dependency and the directory to use for its GPR file. +# The dependency needs not to exist in the loaded indexes. + +$ alr with indexed_crate +$ alr pin indexed_crate --use /path/to/gpr/containing/folder +# To pin a previously added dependency. +``` diff --git a/src/alire/alire-conditional_trees.ads b/src/alire/alire-conditional_trees.ads index 9fc8554f..ba7f4d34 100644 --- a/src/alire/alire-conditional_trees.ads +++ b/src/alire/alire-conditional_trees.ads @@ -500,7 +500,7 @@ private -- Delayed implementation to avoid freezing: function Is_Iterable (This : Tree) return Boolean is - (This.Is_Value or else This.Is_Vector); + (This.Is_Empty or else This.Is_Value or else This.Is_Vector); function Leaf_Count (This : Tree) return Natural is (if This.Is_Empty diff --git a/src/alire/alire-dependencies-graphs.adb b/src/alire/alire-dependencies-graphs.adb index 563dbe4a..052f34d2 100644 --- a/src/alire/alire-dependencies-graphs.adb +++ b/src/alire/alire-dependencies-graphs.adb @@ -38,14 +38,9 @@ package body Alire.Dependencies.Graphs is Env : Properties.Vector) return Graph is - - function Enumerate is new Alire.Conditional.For_Dependencies.Enumerate - (Alire.Containers.Dependency_Lists.List, - Alire.Containers.Dependency_Lists.Append); - begin return Result : Graph := This do - for Dep of Enumerate (R.Dependencies.Evaluate (Env)) + for Dep of Conditional.Enumerate (R.Dependencies.Evaluate (Env)) loop Result.Include (New_Dependency (R.Name, Dep.Crate)); end loop; diff --git a/src/alire/alire-dependencies-states.adb b/src/alire/alire-dependencies-states.adb index ed604294..b7e199a8 100644 --- a/src/alire/alire-dependencies-states.adb +++ b/src/alire/alire-dependencies-states.adb @@ -8,6 +8,7 @@ package body Alire.Dependencies.States is Crate : constant String := "crate"; Fulfilment : constant String := "fulfilment"; + Link : constant String := "link"; Pin_Version : constant String := "pin_version"; Pinned : constant String := "pinned"; Release : constant String := "release"; @@ -30,7 +31,56 @@ package body Alire.Dependencies.States is Versions : constant Semantic_Versioning.Extended.Version_Set := Semantic_Versioning.Extended.Value (From.Checked_Pop (Keys.Versions, - TOML_String).As_String); + TOML_String).As_String); + + --------------------- + -- Load_Fulfilment -- + --------------------- + + function Load_Fulfilment return Fulfilment_Data is + Data : Fulfilment_Data + (Fulfilments'Value + (From.Checked_Pop (Keys.Fulfilment, TOML_String).As_String)); + Crate : Crates.With_Releases.Crate := + Crates.With_Releases.New_Crate (From_TOML.Crate); + begin + + -- Load particulars + + case Data.Fulfillment is + when Hinted => null; + + when Linked => + Data.Target.Hold + (Externals.Softlinks.From_TOML + (From.Descend + (Value => From.Checked_Pop (Keys.Link, TOML_Table), + Context => Keys.Link))); + + when Missed => null; + + when Solved => + Assert (Crate.From_TOML -- Load crate + (From.Descend -- from adapter that is under 'release' + (From.Checked_Pop (Keys.Release, TOML_Table) + .Get (+Crate.Name), -- get the release top entry + "release: " & (+Crate.Name)))); + + if Crate.Releases.Length not in 1 then + Raise_Checked_Error + ("Expected one release per solved dependency" + & " in lockfile, but got:" & Crate.Releases.Length'Img); + end if; + + Data.Release := + Containers.Release_Holders.To_Holder + (Crate.Releases.First_Element); + + end case; + + return Data; + end Load_Fulfilment; + begin return This : State := New_Dependency (Crate, Versions) do @@ -56,36 +106,8 @@ package body Alire.Dependencies.States is -- Fulfilling - declare - Data : Fulfilment_Data - (Fulfilments'Value - (From.Checked_Pop (Keys.Fulfilment, TOML_String).As_String)); - Crate : Crates.With_Releases.Crate := - Crates.With_Releases.New_Crate (This.Crate); - begin + This.Fulfilled := Load_Fulfilment; - -- Load the release for a solved dependency - - if Data.Fulfilment = Solved then - Assert (Crate.From_TOML -- Load crate - (From.Descend -- from adapter that is under 'release' - (From.Checked_Pop (Keys.Release, TOML_Table) - .Get (+Crate.Name), -- get the release top entry - "release: " & (+This.Crate)))); - - if Crate.Releases.Length not in 1 then - Raise_Checked_Error - ("Expected one release per solved dependency" - & " in lockfile, but got:" & Crate.Releases.Length'Img); - end if; - - Data.Release := - Containers.Release_Holders.To_Holder - (Crate.Releases.First_Element); - end if; - - This.Fulfilled := Data; - end; end return; end From_TOML; @@ -97,6 +119,35 @@ package body Alire.Dependencies.States is is use TOML_Adapters; use Utils; + + ------------- + -- To_TOML -- + ------------- + + procedure To_TOML (Data : Fulfilment_Data; Table : TOML_Value) is + begin + Table.Set (Keys.Fulfilment, + +To_Lower_Case (This.Fulfilled.Fulfillment'Img)); + + case Data.Fulfillment is + when Hinted => null; + when Linked => + Table.Set (Keys.Link, Data.Target.Get.To_TOML); + + when Missed => null; + when Solved => + declare + Name : constant TOML_Value := Create_Table; + -- This extra table is not really necessary, but it makes + -- the output clearer and the tests simpler. + begin + Name.Set (+This.Crate, + This.Fulfilled.Release.Constant_Reference.To_TOML); + Table.Set (Keys.Release, Name); + end; + end case; + end To_TOML; + begin return Table : constant TOML_Value := Create_Table do @@ -118,22 +169,8 @@ package body Alire.Dependencies.States is -- Fulfilment - declare - Name : constant TOML_Value := Create_Table; - -- This extra table is not really necessary, but it makes the - -- output clearer and the tests simpler. - begin - Table.Set (Keys.Fulfilment, - +To_Lower_Case (This.Fulfilled.Fulfilment'Img)); - - -- Release for a solved dependency + To_TOML (This.Fulfilled, Table); - if This.Is_Solved then - Name.Set (+This.Crate, - This.Fulfilled.Release.Constant_Reference.To_TOML); - Table.Set (Keys.Release, Name); - end if; - end; end return; end To_TOML; diff --git a/src/alire/alire-dependencies-states.ads b/src/alire/alire-dependencies-states.ads index e11a920f..9d37f372 100644 --- a/src/alire/alire-dependencies-states.ads +++ b/src/alire/alire-dependencies-states.ads @@ -1,5 +1,7 @@ -private -with Alire.Containers; +private with AAA.Containers.Indefinite_Holders; + +private with Alire.Containers; +with Alire.Externals.Softlinks; with Alire.Properties; with Alire.Releases; @@ -30,6 +32,11 @@ package Alire.Dependencies.States is function Hinting (Base : State) return State; -- Change fulfilment to Hinted in copy of Base + function Linking (Base : State; + Link : Externals.Softlinks.External) + return State; + -- Returns a copy of Base fulfilled by Path + function Merging (Base : State; Versions : Semantic_Versioning.Extended.Version_Set) return State; @@ -72,6 +79,8 @@ package Alire.Dependencies.States is function Is_Indirect (This : State) return Boolean; + function Is_Linked (This : State) return Boolean; + function Is_Missing (This : State) return Boolean; function Is_Pinned (This : State) return Boolean; @@ -82,6 +91,9 @@ package Alire.Dependencies.States is function Fulfilment (This : State) return Fulfilments; + function Link (This : State) return Externals.Softlinks.External + with Pre => This.Is_Linked; + function Pin_Version (This : State) return Semantic_Versioning.Version with Pre => This.Is_Pinned; @@ -123,18 +135,22 @@ private Version : Semantic_Versioning.Version) return State; + -- Helper types + + package External_Holders is + new AAA.Containers.Indefinite_Holders (Externals.Softlinks.External); + + type Link_Holder is new External_Holders.Holder with null record; + overriding function New_Dependency (Crate : Crate_Name; Versions : Semantic_Versioning.Extended.Version_Set) return State; - ----------- - -- State -- - ----------- - - type Fulfilment_Data (Fulfilment : Fulfilments := Missed) is record - case Fulfilment is + type Fulfilment_Data (Fulfillment : Fulfilments := Missed) is record + case Fulfillment is + when Linked => Target : Link_Holder; when Solved => Release : Containers.Release_H; when others => null; end case; @@ -147,6 +163,10 @@ private end case; end record; + ----------- + -- State -- + ----------- + type State (Name_Len : Natural) is new Dependency (Name_Len) with record Fulfilled : Fulfilment_Data; Pinning : Pinning_Data; @@ -183,7 +203,7 @@ private ---------------- function Fulfilment (This : State) return Fulfilments - is (This.Fulfilled.Fulfilment); + is (This.Fulfilled.Fulfillment); ------------- -- Hinting -- @@ -192,7 +212,7 @@ private function Hinting (Base : State) return State is (Base.As_Dependency with Name_Len => Base.Name_Len, - Fulfilled => (Fulfilment => Hinted), + Fulfilled => (Fulfillment => Hinted), Pinning => Base.Pinning, Transitivity => Base.Transitivity); @@ -207,7 +227,10 @@ private (if This.Transitivity /= Unknown then This.Transitivity'Img & "," else "") - & Utils.To_Lower_Case (This.Fulfilled.Fulfilment'Img) + & Utils.To_Lower_Case (This.Fulfilled.Fulfillment'Img) + & (if This.Fulfilled.Fulfillment = Linked + then ",target=" & This.Fulfilled.Target.Get.Path + else "") & (if This.Pinning.Pinned then ",pin=" & This.Pinning.Version.Image else "") @@ -221,19 +244,43 @@ private is (This.Transitivity = Direct); function Is_Hinted (This : State) return Boolean - is (This.Fulfilled.Fulfilment = Hinted); + is (This.Fulfilled.Fulfillment = Hinted); function Is_Indirect (This : State) return Boolean is (This.Transitivity = Indirect); + function Is_Linked (This : State) return Boolean + is (This.Fulfilled.Fulfillment = Linked); + function Is_Missing (This : State) return Boolean - is (This.Fulfilled.Fulfilment = Missed); + is (This.Fulfilled.Fulfillment = Missed); function Is_Pinned (This : State) return Boolean is (This.Pinning.Pinned); function Is_Solved (This : State) return Boolean - is (This.Fulfilled.Fulfilment = Solved); + is (This.Fulfilled.Fulfillment = Solved); + + ---------- + -- Link -- + ---------- + + function Link (This : State) return Externals.Softlinks.External + is (This.Fulfilled.Target.Get); + + ------------- + -- Linking -- + ------------- + + function Linking (Base : State; + Link : Externals.Softlinks.External) + return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => (Fulfillment => Linked, + Target => To_Holder (Link)), + Pinning => Base.Pinning, + Transitivity => Base.Transitivity); ------------- -- Merging -- @@ -256,7 +303,7 @@ private function Missing (Base : State) return State is (Base.As_Dependency with Name_Len => Base.Name_Len, - Fulfilled => (Fulfilment => Missed), + Fulfilled => (Fulfillment => Missed), Pinning => Base.Pinning, Transitivity => Base.Transitivity); @@ -340,7 +387,7 @@ private return State is (Base.As_Dependency with Name_Len => Base.Name_Len, - Fulfilled => (Fulfilment => Solved, + Fulfilled => (Fulfillment => Solved, Release => Containers.Release_Holders .To_Holder (Using)), Pinning => Base.Pinning, @@ -365,10 +412,14 @@ private then This.Transitivity'Img & "," else "") & Utils.To_Lower_Case - (case This.Fulfilled.Fulfilment is - when Missed => TTY.Error (This.Fulfilled.Fulfilment'Img), - when Hinted => TTY.Warn (This.Fulfilled.Fulfilment'Img), - when others => This.Fulfilled.Fulfilment'Img) + (case This.Fulfilled.Fulfillment is + when Missed => TTY.Error (This.Fulfilled.Fulfillment'Img), + when Hinted => TTY.Warn (This.Fulfilled.Fulfillment'Img), + when others => This.Fulfilled.Fulfillment'Img) + & (if This.Fulfilled.Fulfillment = Linked + then "," & TTY.Emph ("target") & "=" + & TTY.URL (This.Fulfilled.Target.Get.Path) + else "") & (if This.Pinning.Pinned then "," & TTY.Emph ("pin") & "=" & TTY.Version (This.Pinning.Version.Image) diff --git a/src/alire/alire-externals-softlinks.adb b/src/alire/alire-externals-softlinks.adb new file mode 100644 index 00000000..703973a9 --- /dev/null +++ b/src/alire/alire-externals-softlinks.adb @@ -0,0 +1,84 @@ +with Ada.Directories; + +with Alire.URI; +with Alire.Utils.TTY; + +package body Alire.Externals.Softlinks is + + use TOML; + + package Keys is + + -- TOML Keys used locally + + Kind : constant String := "kind"; + Path : constant String := "path"; + + end Keys; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (Table : TOML_Adapters.Key_Queue) return External is + Path : constant String := + Table.Checked_Pop (Keys.Path, TOML_String).As_String; + begin + return New_Softlink (Path); + end From_TOML; + + ------------------ + -- New_Softlink -- + ------------------ + + function New_Softlink (From : URL) return External + is + begin + if URI.Scheme (From) not in URI.File_Schemes then + Raise_Checked_Error + ("Given URL does not seem to denote a local path: " + & Utils.TTY.Emph (From)); + end if; + + declare + Path : constant Any_Path := URI.Local_Path (From); + begin + if not GNAT.OS_Lib.Is_Directory (Path) then + Trace.Warning ("Given path does not exist: " + & 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 + + declare + Absolute : constant Absolute_Path := + Ada.Directories.Full_Name (Path); + begin + return (Externals.External with + Path_Length => Absolute'Length, + Path => Absolute); + end; + end; + end New_Softlink; + + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (This : External) return TOML.TOML_Value is + Table : constant TOML_Value := Create_Table; + 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). + + return Table; + end To_TOML; + +end Alire.Externals.Softlinks; diff --git a/src/alire/alire-externals-softlinks.ads b/src/alire/alire-externals-softlinks.ads new file mode 100644 index 00000000..69c3f8a6 --- /dev/null +++ b/src/alire/alire-externals-softlinks.ads @@ -0,0 +1,88 @@ +with Alire.Interfaces; +with Alire.TOML_Adapters; + +with TOML; + +package Alire.Externals.Softlinks is + + -- A do-nothing external that is used to use a dir as an in-progress crate. + -- This external provides its path to be used for GPR_INCLUDE_PATH. + + type External (<>) is + new Externals.External + and Interfaces.Tomifiable + with private; + + function New_Softlink (From : URL) return External; + + overriding + function Detect (This : External; + Unused_Name : Crate_Name) return Containers.Release_Set + is (Containers.Release_Sets.Empty_Set); + -- Never detected, as we want these crates to work as a wildcard for any + -- version. + + function Is_Valid (This : External) return Boolean; + -- Check that the pointed-to folder exists + + overriding + function Image (This : External) return String; + + overriding + function Detail (This : External; + Unused_Distro : Platforms.Distributions) + return Utils.String_Vector + is (Utils.Empty_Vector.Append ("User-provided external crate")); + + overriding + function Kind (This : External) return String is ("Symbolic link"); + + function Project_Paths (This : External) return Utils.String_Vector; + -- For now it returns the root path given by the user. We could consider + -- adding more paths at configuration time. + + function Path (This : External) return Any_Path; + + function From_TOML (Table : TOML_Adapters.Key_Queue) return External; + + overriding + function To_TOML (This : External) return TOML.TOML_Value; + +private + + type External (Path_Length : Positive) is + new Externals.External + and Interfaces.Tomifiable with record + Path : Any_Path (1 .. Path_Length); + end record; + + ----------- + -- Image -- + ----------- + + overriding + function Image (This : External) return String + is ("User-provided at " & This.Path); + + -------------- + -- Is_Valid -- + -------------- + + function Is_Valid (This : External) return Boolean + is (GNAT.OS_Lib.Is_Directory (This.Path)); + + ---------- + -- Path -- + ---------- + + function Path (This : External) return Any_Path + is (This.Path); + + ------------------- + -- Project_Paths -- + ------------------- + + function Project_Paths (This : External) return Utils.String_Vector + is (Utils.To_Vector (This.Path)); + +end Alire.Externals.Softlinks; diff --git a/src/alire/alire-externals.adb b/src/alire/alire-externals.adb index bcddc002..48fa7cf8 100644 --- a/src/alire/alire-externals.adb +++ b/src/alire/alire-externals.adb @@ -3,6 +3,7 @@ with AAA.Enum_Tools; with Alire.Crates; with Alire.Externals.From_Output; with Alire.Externals.From_System; +with Alire.Externals.Softlinks; with Alire.Externals.Unindexed; with Alire.Requisites.Booleans; with Alire.TOML_Keys; @@ -33,6 +34,7 @@ package body Alire.Externals is (case Kind is when Hint => Unindexed.External' (External with null record), + when Softlink => Softlinks.From_TOML (From), when System => From_System.From_TOML (From), when Version_Output => From_Output.From_TOML (From)); diff --git a/src/alire/alire-externals.ads b/src/alire/alire-externals.ads index 9ecda327..e248f575 100644 --- a/src/alire/alire-externals.ads +++ b/src/alire/alire-externals.ads @@ -45,6 +45,10 @@ package Alire.Externals is -- A placeholder for a knowingly-unavailable crate, that -- will hopefully be added in the future. + Softlink, + -- A directory that is used in place, with indeterminate + -- version. + System, -- A installed system package, via apt, yum, etc. diff --git a/src/alire/alire-pinning.adb b/src/alire/alire-pinning.adb index a4fd6bee..f3c7a100 100644 --- a/src/alire/alire-pinning.adb +++ b/src/alire/alire-pinning.adb @@ -35,6 +35,19 @@ package body Alire.Pinning is end if; end Pin; + ------------ + -- Pin_To -- + ------------ + + function Pin_To (URL : String; + Solution : Solutions.Solution; + Crate : Crate_Name) + return Solutions.Solution + is (Solution + .Unpinning (Crate) + .Linking (Crate, URL)); + -- Just in case it was already pinned to a version, we remove that + ----------- -- Unpin -- ----------- @@ -47,12 +60,17 @@ package body Alire.Pinning is is begin -- The unpin case is simpler since we need only to remove any previous - -- pin for the crate, and let the solver operate normally. + -- pin for the crate, and let the solver operate normally. Likewise for + -- a linked dependency. return Solver.Resolve (Dependencies, Environment, - Solution.Unpinning (Crate)); + Solutions.Solution' + (if Solution.State (Crate).Is_Linked + then Solution.Missing (Solution.Dependency (Crate)) + else Solution) + .Unpinning (Crate)); end Unpin; end Alire.Pinning; diff --git a/src/alire/alire-pinning.ads b/src/alire/alire-pinning.ads index 1471d5d5..c8820f3a 100644 --- a/src/alire/alire-pinning.ads +++ b/src/alire/alire-pinning.ads @@ -19,13 +19,22 @@ package Alire.Pinning is -- must exist in the solution. Root dependencies are given, and a previous -- solution with possibly more pins. The resulting solution may be invalid. + function Pin_To (URL : String; + Solution : Solutions.Solution; + Crate : Crate_Name) + return Solutions.Solution with + Pre => Solution.Depends_On (Crate) or else + raise Checked_Error with + "Cannot pin crate not in dependencies: " & (+Crate); + function Unpin (Crate : Crate_Name; Dependencies : Conditional.Dependencies; Environment : Properties.Vector; Solution : Solutions.Solution) return Solutions.Solution with Pre => Solution.Depends_On (Crate) and then - Solution.State (Crate).Is_Pinned; + (Solution.State (Crate).Is_Linked or else + Solution.State (Crate).Is_Pinned); -- Compute a new solution removing the pin of the given crate, that must -- be pinned and in the solution. The resulting solution might be invalid. diff --git a/src/alire/alire-root.adb b/src/alire/alire-root.adb index e522ab59..0bdc102f 100644 --- a/src/alire/alire-root.adb +++ b/src/alire/alire-root.adb @@ -5,6 +5,10 @@ with Alire.TOML_Index; package body Alire.Root is + ------------- + -- Current -- + ------------- + function Current return Roots.Root is use Alire.Directories; Path : constant String := Directories.Detect_Root_Path; @@ -18,7 +22,8 @@ package body Alire.Root is begin return Roots.New_Root (TOML_Index.Load_Release_From_File (File), - Path); + Path, + Platform_Properties); exception when E : others => Trace.Debug ("Exception while loading crate file is:"); @@ -38,4 +43,14 @@ package body Alire.Root is end if; end Current; + Environment : Properties.Vector; + + function Platform_Properties return Properties.Vector + is (Environment); + + procedure Set_Platform_Properties (Env : Properties.Vector) is + begin + Environment := Env; + end Set_Platform_Properties; + end Alire.Root; diff --git a/src/alire/alire-root.ads b/src/alire/alire-root.ads index 312b1bdb..4428c13a 100644 --- a/src/alire/alire-root.ads +++ b/src/alire/alire-root.ads @@ -1,3 +1,4 @@ +with Alire.Properties; with Alire.Roots; package Alire.Root is @@ -8,4 +9,11 @@ package Alire.Root is -- This global is a remain of when self-compilation existed -- To be removed in the short term + function Platform_Properties return Properties.Vector; + + procedure Set_Platform_Properties (Env : Properties.Vector); + -- Until we do The Big Refactor of moving platform detection from Alr into + -- Alire, this is a stopgag measure to be able to encapsulate properties in + -- the Current Root. TODO: remove during the refactor. + end Alire.Root; diff --git a/src/alire/alire-roots.adb b/src/alire/alire-roots.adb new file mode 100644 index 00000000..e5fc94f8 --- /dev/null +++ b/src/alire/alire-roots.adb @@ -0,0 +1,52 @@ +package body Alire.Roots is + + ------------------- + -- Project_Paths -- + ------------------- + + function Project_Paths (This : Root) return Utils.String_Set + is + Paths : Utils.String_Set; + Base : constant Any_Path := Path (This); + begin + + -- Add root path from every release in the solution + + for Rel of This.Solution.Releases.Including (Release (This)) loop + if Rel.Name = Release (This).Name then + null; -- The root project doesn't require its own path + else + Paths.Include (Base + / Alire.Paths.Working_Folder_Inside_Root + / Alire.Paths.Dependency_Dir_Inside_Working_Folder + / Rel.Unique_Folder); + end if; + + -- Add extra project paths + + for Path of Rel.Project_Paths (This.Environment) loop + if Rel.Name = Release (This).Name then + Paths.Include (Base / Path); + else + Paths.Include + (Base + / Alire.Paths.Working_Folder_Inside_Root + / Alire.Paths.Dependency_Dir_Inside_Working_Folder + / Rel.Unique_Folder + / Path); + end if; + end loop; + end loop; + + -- Add paths for pinned folders + + for Link of This.Solution.Links loop + for Path of This.Solution.State (Link.Crate).Link.Project_Paths loop + Paths.Include (Path); -- These are absolute + end loop; + end loop; + + return Paths; + end Project_Paths; + +end Alire.Roots; diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 31452799..22a79e07 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -3,8 +3,10 @@ private with Alire.Lockfiles; private with Alire.OS_Lib; private with Alire.Paths; +with Alire.Properties; with Alire.Releases; with Alire.Solutions; +with Alire.Utils; package Alire.Roots is @@ -42,18 +44,27 @@ package Alire.Roots is -- See Alire.Directories.Detect_Root_Path to use with the following function New_Root (Name : Crate_Name; - Path : Absolute_Path) return Root with + Path : Absolute_Path; + Env : Properties.Vector) return Root with Post => New_Root'Result.Is_Valid; -- New unreleased release (not indexed, working copy) function New_Root (R : Releases.Release; - Path : Absolute_Path) return Root; + Path : Absolute_Path; + Env : Properties.Vector) return Root; -- From existing release -- Path must point to the session folder (parent of alire metadata folder) function Path (This : Root) return Absolute_Path with Pre => This.Is_Valid; + function Project_Paths (This : Root) + return Utils.String_Set with + Pre => This.Is_Valid; + -- Return all the paths that should be set in GPR_PROJECT_PATH for the + -- solution in this root. This includes al releases' paths and any linked + -- directories. + function Release (This : Root) return Releases.Release with Pre => This.Is_Valid; @@ -80,10 +91,11 @@ private type Root (Valid : Boolean) is tagged record case Valid is when True => - Path : UString; - Release : Containers.Release_H; + Environment : Properties.Vector; + Path : UString; + Release : Containers.Release_H; when False => - Reason : UString; + Reason : UString; end case; end record; @@ -100,14 +112,18 @@ private (+This.Reason); function New_Root (Name : Crate_Name; - Path : Absolute_Path) return Root is + Path : Absolute_Path; + Env : Properties.Vector) return Root is (True, + Env, +Path, Containers.To_Release_H (Releases.New_Working_Release (Name))); function New_Root (R : Releases.Release; - Path : Absolute_Path) return Root is + Path : Absolute_Path; + Env : Properties.Vector) return Root is (True, + Env, +Path, Containers.To_Release_H (R)); diff --git a/src/alire/alire-solutions-diffs.adb b/src/alire/alire-solutions-diffs.adb index 817bd503..c67a89db 100644 --- a/src/alire/alire-solutions-diffs.adb +++ b/src/alire/alire-solutions-diffs.adb @@ -19,6 +19,7 @@ package body Alire.Solutions.Diffs is function Best_Version (Status : Crate_Status) return String is (case Status.Status is when Needed => Semantic_Versioning.Image (Status.Version), + when Linked => "file:" & (+Status.Path), when Hinted => Status.Versions.Image, when Unneeded => "unneeded", when Unsolved => "unsolved"); @@ -42,7 +43,9 @@ package body Alire.Solutions.Diffs is return (Status => Needed, Pinned => Sol.State (Crate).Is_Pinned, Version => Sol.State (Crate).Release.Version); - + elsif Sol.Links.Contains (Crate) then + return (Status => Linked, + Path => +Sol.State (Crate).Link.Path); elsif Sol.Hints.Contains (Crate) then return (Status => Hinted, Versions => Sol.Dependency (Crate).Versions); @@ -113,6 +116,7 @@ package body Alire.Solutions.Diffs is elsif Former.Version = Latter.Version then Unchanged else Downgraded) else Added), + when Linked => Pinned, when Hinted => External, when Unneeded => Removed, when Unsolved => Unsolved); @@ -232,7 +236,7 @@ package body Alire.Solutions.Diffs is -- Show most precise version available - if Latter.Status in Hinted | Needed then + if Latter.Status in Hinted | Linked | Needed then Table.Append (TTY.Version (Best_Version (Latter))); else Table.Append (TTY.Version (Best_Version (Former))); diff --git a/src/alire/alire-solutions-diffs.ads b/src/alire/alire-solutions-diffs.ads index 7834bf90..7d1c5b9d 100644 --- a/src/alire/alire-solutions-diffs.ads +++ b/src/alire/alire-solutions-diffs.ads @@ -37,7 +37,7 @@ package Alire.Solutions.Diffs is private - type Install_Status is (Unsolved, Unneeded, Hinted, Needed); + type Install_Status is (Unsolved, Unneeded, Hinted, Linked, Needed); -- Unsolved will apply to all crates when a solution is invalid. TODO: when -- reasons for solving failure are tracked, improve the diff output. @@ -46,6 +46,8 @@ private when Needed => Pinned : Boolean; Version : Semantic_Versioning.Version; + when Linked => + Path : UString; when Hinted => Versions : Semantic_Versioning.Extended.Version_Set; when Unneeded | Unsolved => diff --git a/src/alire/alire-solutions.adb b/src/alire/alire-solutions.adb index 62a328d2..092c06d3 100644 --- a/src/alire/alire-solutions.adb +++ b/src/alire/alire-solutions.adb @@ -347,11 +347,11 @@ package body Alire.Solutions is -- Show other dependencies with their status and hints - if This.Composition >= Mixed then + if (for some Dep of This.Dependencies => not Dep.Is_Solved) then Trace.Log ("Dependencies (external):", Level); for Dep of This.Dependencies loop if not This.State (Dep.Crate).Is_Solved then - Trace.Log (" " & Dep.As_Dependency.TTY_Image, Level); + Trace.Log (" " & Dep.TTY_Image, Level); -- Look for hints. If we are relying on workspace information -- the index may not be loaded, or have changed, so we need to @@ -443,11 +443,16 @@ package body Alire.Solutions is procedure Print_Pins (This : Solution) is Table : Utils.Tables.Table; begin - if This.Dependencies_That (States.Is_Pinned'Access).Is_Empty then + if This.Links.Is_Empty and then Dependency_Map'(This.Pins).Is_Empty then Trace.Always ("There are no pins"); else for Dep of This.Dependencies loop - if Dep.Is_Pinned then + if Dep.Is_Linked then + Table + .Append (TTY.Name (Dep.Crate)) + .Append (TTY.Version ("file:" & Dep.Link.Path)) + .New_Row; + elsif Dep.Is_Pinned then Table .Append (TTY.Name (Dep.Crate)) .Append (TTY.Version (Dep.Pin_Version.Image)) diff --git a/src/alire/alire-solutions.ads b/src/alire/alire-solutions.ads index fec6e54e..fa87d485 100644 --- a/src/alire/alire-solutions.ads +++ b/src/alire/alire-solutions.ads @@ -1,6 +1,7 @@ with Alire.Conditional; with Alire.Containers; with Alire.Dependencies.States.Maps; +with Alire.Externals.Softlinks; with Alire.Interfaces; with Alire.Properties; with Alire.Releases; @@ -31,8 +32,9 @@ package Alire.Solutions is -- Trivial empty solution when no dependencies are needed Releases, - -- Only proper (regular or detected) releases with a concrete version - -- and deployer; these should always build properly. + -- Proper (regular or detected) releases with a concrete version and + -- deployer, and linked directories. These solutions should build + -- properly (if the linked dependencies are correct). Mixed, -- Releases + at least one undetected hint (i.e., build success is not @@ -107,6 +109,20 @@ package Alire.Solutions is -- release is fulfilling, by default we don't create its dependency (it -- must exist previously). + function Linking (This : Solution; + Crate : Crate_Name; + Link : Externals.Softlinks.External) + return Solution + with Pre => This.Depends_On (Crate); + -- Replace the fulfilment of Crate with a "softlinked" external + + function Linking (This : Solution; + Crate : Crate_Name; + Path : Any_Path) + return Solution + with Pre => This.Depends_On (Crate); + -- As previous but giving a path for simplicity + function Missing (This : Solution; Dep : Dependencies.Dependency) return Solution; @@ -119,6 +135,12 @@ package Alire.Solutions is -- Return a copy of the solution with the given crate pinned to a version. -- If the crate was not in the original solution it will be added. + function Setting (This : Solution; + Crate : Crate_Name; + Transitivity : States.Transitivities) + return Solution; + -- Change transitivity + function Unpinning (This : Solution; Crate : Crate_Name) return Solution; @@ -183,6 +205,9 @@ package Alire.Solutions is -- A solution is complete when it fulfills all dependencies via regular -- releases, detected externals, or linked directories. + function Links (This : Solution) return Dependency_Map; + -- Return crates that are solved with a softlink + function Misses (This : Solution) return Dependency_Map; -- Return crates for which there is neither hint nor proper versions @@ -281,7 +306,9 @@ private Unsolved elsif This.Dependencies.Is_Empty then Empty - elsif (for all Dep of This.Dependencies => Dep.Is_Solved) then + elsif (for all Dep of This.Dependencies => + Dep.Is_Solved or else Dep.Is_Linked) + then Releases elsif (for all Dep of This.Dependencies => Dep.Is_Hinted) then Hints @@ -368,7 +395,36 @@ private ----------------- function Is_Complete (This : Solution) return Boolean - is (for all Dep of This.Dependencies => Dep.Is_Solved); + is (This.Composition in Empty | Releases); + + ------------- + -- Linking -- + ------------- + + function Linking (This : Solution; + Crate : Crate_Name; + Link : Externals.Softlinks.External) + return Solution + is (Solved => True, + Dependencies => + This.Dependencies.Including (This.State (Crate).Linking (Link))); + + ------------- + -- Linking -- + ------------- + + function Linking (This : Solution; + Crate : Crate_Name; + Path : Any_Path) + return Solution + is (This.Linking (Crate, Externals.Softlinks.New_Softlink (Path))); + + ----------- + -- Links -- + ----------- + + function Links (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Linked'Access)); ------------ -- Misses -- @@ -419,6 +475,19 @@ private function Required (This : Solution) return State_Map'Class is (This.Dependencies); + ------------- + -- Setting -- + ------------- + + function Setting (This : Solution; + Crate : Crate_Name; + Transitivity : States.Transitivities) + return Solution + is (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Setting (Transitivity))); + ----------- -- State -- ----------- diff --git a/src/alire/alire-solver.adb b/src/alire/alire-solver.adb index 9bf9063c..606ee892 100644 --- a/src/alire/alire-solver.adb +++ b/src/alire/alire-solver.adb @@ -345,7 +345,27 @@ package body Alire.Solver is begin - if Solution.Releases.Contains (Dep.Crate) then + if Current.Depends_On (Dep.Crate) and then + Current.State (Dep.Crate).Is_Linked + then + + -- The dependency is softlinked in the starting solution, hence + -- we need not look further for releases. + + Trace.Debug + ("SOLVER: dependency LINKED to " & + Current.State (Dep.Crate).Link.Path & + " when tree is " & + Tree'(Expanded and Target and Remaining).Image_One_Line); + + Expand (Expanded => Expanded and Dep, + Target => Remaining, + Remaining => Empty, + Solution => + Solution.Linking (Dep.Crate, + Current.State (Dep.Crate).Link)); + + elsif Solution.Releases.Contains (Dep.Crate) then -- Cut search once a crate is frozen, by checking the -- compatibility of the already frozen release: diff --git a/src/alire/alire-uri.ads b/src/alire/alire-uri.ads new file mode 100644 index 00000000..60115b79 --- /dev/null +++ b/src/alire/alire-uri.ads @@ -0,0 +1,108 @@ +with Alire.Errors; + +private with Alire.Utils; +private with URI; + +package Alire.URI is + + -- Helpers to process URLs provided by the user. Note: there's already an + -- Alire.URL type which is simply a String renaming without any additional + -- constraints. + + -- See https://tools.ietf.org/html/rfc3986 for full details. + -- + -- http://user:pass@www.here.com:80/dir1/dir2/xyz.html?p=8&x=doh#anchor + -- | | | | | | | + -- protocol host port path file parameters fragment + -- + -- foo://example.com:8042/over/there?name=ferret#nose + -- \_/ \______________/\_________/ \_________/ \__/ + -- | | | | | + -- scheme authority path query fragment + -- | _____________________|__ + -- / \ / \ + -- urn:example:animal:ferret:nose + + type Schemes is + (None, + -- For URLs without scheme (to be interpreted as local paths) + + File, + -- A file: URI + + Git, + -- Anything understood by git, expressed as git+, e.g.: + -- git+http[s], git+file + + Hg, + SVN, + -- Same considerations as for Git + + HTTP, + -- Either http or https, since we don't differentiate treatment + + Unknown + -- Anything else + ); + -- Protocols recognized by Alire + + subtype VCS_Schemes is Schemes range Git .. SVN; + + subtype File_Schemes is Schemes with + Static_Predicate => File_Schemes in None | File; + + function Scheme (This : URL) return Schemes; + -- Extract the Scheme part of a URL + + function Local_Path (This : URL) return Any_Path + with Pre => Scheme (This) in None | File + or else raise Checked_Error with Errors.Set + ("Given URL does not seem to denote a path: " & This); + -- Extract complete path from a URL intended for a local path: According to + -- the URIs RFC, we (I) are using improperly the file: scheme. An absolute + -- path should be file:/path/to/file, while a relative one should be + -- file:rel/ati/ve. By using things like file://../path/to, ".." becomes + -- the authority and "/path/to" the absolute path. This function, for use + -- with Alire, returns the authority+path as the whole path, so there's no + -- possible misinterpretation and any file:[/[/[/]]] combination should be + -- properly interpreted. TL;DR: this should work without further concerns. + -- + -- TODO: fix incorrectly emitted file:// paths in Origins so at least we + -- are not generating improper URIs. + +private + + package U renames Standard.URI; + + function L (Str : String) return String renames Utils.To_Lower_Case; + + ---------------- + -- Local_Path -- + ---------------- + + function Local_Path (This : URL) return Any_Path + is (U.Permissive_Path (This)); + + ------------ + -- Scheme -- + ------------ + + function Scheme (This : URL) return Schemes + is (if U.Scheme (This) = "" then + None + elsif L (U.Scheme (This)) = "file" then + File + elsif Utils.Starts_With (L (U.Scheme (This)), "git+") then + Git + elsif Utils.Starts_With (L (U.Scheme (This)), "hg+") then + Hg + elsif Utils.Starts_With (L (U.Scheme (This)), "svn+") then + SVN + elsif L (U.Scheme (This)) = "http" then + HTTP + elsif L (U.Scheme (This)) = "https" then + HTTP + else + Unknown); + +end Alire.URI; diff --git a/src/alire/alire-utils-tty.ads b/src/alire/alire-utils-tty.ads index e548ca54..9cba5e44 100644 --- a/src/alire/alire-utils-tty.ads +++ b/src/alire/alire-utils-tty.ads @@ -58,6 +58,8 @@ package Alire.Utils.TTY with Preelaborate is function Description (Text : String) return String; -- Not bold cyan for crate descriptions + function URL (Text : String) return String; + function Version (Text : String) return String; -- For versions/version sets, bold magenta @@ -97,6 +99,8 @@ private (Format (Text, Fore => ANSI.Light_Cyan)); + function URL (Text : String) return String renames Version; + function Version (Text : String) return String is (Format (Text, Fore => ANSI.Magenta, diff --git a/src/alire/alire-workspace.adb b/src/alire/alire-workspace.adb index c7d6c130..dac19382 100644 --- a/src/alire/alire-workspace.adb +++ b/src/alire/alire-workspace.adb @@ -187,7 +187,9 @@ package body Alire.Workspace is with Unreferenced; Root : constant Alire.Roots.Root := Alire.Roots.New_Root - (Release.Name, Ada.Directories.Current_Directory); + (Release.Name, + Ada.Directories.Current_Directory, + Env); begin Workspace.Generate_Manifest diff --git a/src/alire/alire.adb b/src/alire/alire.adb index 2ab5b25f..511634fd 100644 --- a/src/alire/alire.adb +++ b/src/alire/alire.adb @@ -74,6 +74,17 @@ package body Alire is end if; end Assert; + ------------ + -- Assert -- + ------------ + + procedure Assert (Condition : Boolean; Or_Else : String) is + begin + if not Condition then + Raise_Checked_Error (Msg => Or_Else); + end if; + end Assert; + ------------------- -- Error_In_Name -- ------------------- diff --git a/src/alire/alire.ads b/src/alire/alire.ads index 1cb2bf29..b40a3516 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -180,6 +180,9 @@ package Alire with Preelaborate is -- Does nothing for successful outcomes. Raises Checked_Error with the -- corresponding message set in Alire.Errors otherwise. + procedure Assert (Condition : Boolean; Or_Else : String); + -- Class Raise_Checked_Error (Or_Else) when Condition is false + procedure Raise_Checked_Error (Msg : String) with No_Return; -- For errors where we do not return an Outcome_Failure, we log an error -- message (Msg) and raise Checked_Error. There is no limitation on the diff --git a/src/alr/alr-build_env.adb b/src/alr/alr-build_env.adb index 80715a2e..67ceeca1 100644 --- a/src/alr/alr-build_env.adb +++ b/src/alr/alr-build_env.adb @@ -3,7 +3,6 @@ with Ada.Text_IO; with GNAT.OS_Lib; -with Alire.Directories; with Alire.GPR; with Alire.Properties.Scenarios; with Alire.Solutions; @@ -12,7 +11,6 @@ with Alire.Utils; with Alr.OS_Lib; with Alr.Platform; -with Alr.Paths; package body Alr.Build_Env is @@ -26,49 +24,16 @@ package body Alr.Build_Env is -- Project_Path -- ------------------ - function Project_Path (Releases : Alire.Solutions.Release_Map; - Root : Alire.Roots.Root) + function Project_Path (Root : Alire.Roots.Root) return String is - use Alr.OS_Lib; use Ada.Strings.Unbounded; Result : Unbounded_String; - All_Paths : Alire.Utils.String_Vector; - Sorted_Paths : Alire.Utils.String_Set; - - Working_Folder : constant Alire.Absolute_Path := - Alire.Directories.Current / Paths.Alr_Working_Folder; + Sorted_Paths : constant Alire.Utils.String_Set := Root.Project_Paths; First : Boolean := True; begin - -- First obtain all paths and then output them, if any needed - for Rel of Releases.Including (Root.Release) loop - if Rel.Name = Root.Release.Name then - -- All_Paths.Append ("."); - null; -- That's the first path in aggregate projects anyway - else - All_Paths.Append (Working_Folder / - Paths.Alr_Working_Deps_Path / - Rel.Unique_Folder); - end if; - - -- Add non-root extra project paths, always - for Path of Rel.Project_Paths (Platform.Properties) loop - All_Paths.Append - (Working_Folder / - (if Rel.Name = Root.Release.Name - then ".." - else Paths.Alr_Working_Deps_Path / Rel.Unique_Folder) / - Path); - end loop; - end loop; - - -- Sort and remove duplicates in paths (may come from extension - -- projects). - for Path of All_Paths loop - Sorted_Paths.Include (Path); - end loop; if not Sorted_Paths.Is_Empty then for Path of Sorted_Paths loop @@ -110,13 +75,13 @@ package body Alr.Build_Env is if Existing_Project_Path.all'Length = 0 then -- The variable is not already defined - Action ("GPR_PROJECT_PATH", Project_Path (Needed.Releases, Root)); + Action ("GPR_PROJECT_PATH", Project_Path (Root)); else -- Append to the existing variable Action ("GPR_PROJECT_PATH", Existing_Project_Path.all & Path_Separator & - Project_Path (Needed.Releases, Root)); + Project_Path (Root)); end if; GNAT.OS_Lib.Free (Existing_Project_Path); diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index ae86ad41..b2c7b17a 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -9,6 +9,7 @@ with Alire.Roots; with Alire.Solutions; with Alire.Workspace; +with Alr.Platform; with Alr.Root; with Alr.Utils; @@ -168,7 +169,9 @@ package body Alr.Commands.Init is declare Root : constant Alire.Roots.Root := Alire.Roots.New_Root - (+Name, Ada.Directories.Full_Name (+Directory.Full_Name)); + (+Name, + Ada.Directories.Full_Name (+Directory.Full_Name), + Platform.Properties); begin Make_Dir (Create (+Root.Working_Folder)); diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index 685226b0..2e13b3c6 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -3,6 +3,7 @@ with Alire.Lockfiles; with Alire.Releases; with Alire.Solutions.Diffs; with Alire.Pinning; +with Alire.Utils.TTY; with Alr.Commands.Update; with Alr.Commands.User_Input; @@ -14,6 +15,7 @@ with Semantic_Versioning; package body Alr.Commands.Pin is package Semver renames Semantic_Versioning; + package TTY renames Alire.Utils.TTY; -------------------- -- Change_One_Pin -- @@ -46,7 +48,9 @@ package body Alr.Commands.Pin is Dependencies => Root.Current.Release.Dependencies, Environment => Platform.Properties, - Solution => Solution); + Solution => + Solution.Missing -- Remove a possible link + (Solution.Dependency (Name))); begin if New_Solution.Valid then Solution := New_Solution; @@ -63,7 +67,9 @@ package body Alr.Commands.Pin is procedure Unpin is begin - if not Solution.State (Name).Is_Pinned then + if not (Solution.State (Name).Is_Linked or else + Solution.State (Name).Is_Pinned) + then Reportaise_Command_Failed ("Requested crate is already unpinned"); end if; @@ -92,7 +98,7 @@ package body Alr.Commands.Pin is -- Sanity checks if not Solution.Depends_On (Name) then - Reportaise_Command_Failed ("Cannot pin dependency not in solution: " + Reportaise_Command_Failed ("Cannot pin crate not in dependencies: " & (+Name)); end if; @@ -108,8 +114,12 @@ package body Alr.Commands.Pin is Relaxed => False); Trace.Debug ("Pin requested for exact version: " & Version.Image); - else + elsif Solution.Releases.Contains (Name) then Version := Solution.Releases.Element (Name).Version; + elsif not Cmd.Unpin then + Trace.Warning ("Cannot pin crate with no release" + & " in current solution: " & TTY.Name (Name)); + return; end if; -- Proceed to pin/unpin @@ -160,6 +170,11 @@ package body Alr.Commands.Pin is if Cmd.Pin_All and then Num_Arguments /= 0 then Reportaise_Wrong_Arguments ("--all must appear alone"); + elsif Cmd.URL.all /= "" and then + (Num_Arguments /= 1 or else Cmd.Pin_All or else Cmd.Unpin) + then + Reportaise_Wrong_Arguments + ("--use must be used alone with a crate name"); end if; Requires_Valid_Session; @@ -170,7 +185,8 @@ package body Alr.Commands.Pin is Root.Current.Solution.Print_Pins; return; elsif Num_Arguments > 1 then - Reportaise_Wrong_Arguments ("Pin expects a single crate name"); + Reportaise_Wrong_Arguments + ("Pin expects a single crate or crate=version argument"); end if; -- Apply changes; @@ -182,6 +198,8 @@ package body Alr.Commands.Pin is if Cmd.Pin_All then + -- Change all pins + if not New_Sol.Valid then Reportaise_Command_Failed ("Cannot pin an invalid solution"); end if; @@ -192,7 +210,17 @@ package body Alr.Commands.Pin is end if; end loop; + elsif Cmd.URL.all /= "" then + + -- Pin to dir + + New_Sol := Alire.Pinning.Pin_To + (Cmd.URL.all, Old_Sol, +Argument (1)); + else + + -- Change a single pin + Change_One_Pin (Cmd, New_Sol, Argument (1)); end if; @@ -214,7 +242,8 @@ package body Alr.Commands.Pin is function Long_Description (Cmd : Command) return Alire.Utils.String_Vector is (Alire.Utils.Empty_Vector - .Append ("Pin releases to their current solution version." + .Append ("Pin releases to a particular version." + & " By default, the current solution version is used." & " A pinned release is not affected by automatic updates.") .New_Line .Append ("Without arguments, show existing pins.") @@ -222,6 +251,11 @@ package body Alr.Commands.Pin is .Append ("Use --all to pin the whole current solution.") .New_Line .Append ("Specify a single crate to modify its pin.") + .New_Line + .Append ("Use the --use switch to " + & " force alr to use the PATH target" + & " to fulfill a dependency locally" + & " instead of looking for indexed releases.") ); -------------------- @@ -244,6 +278,13 @@ package body Alr.Commands.Pin is Cmd.Unpin'Access, Long_Switch => "--unpin", Help => "Unpin a release"); + + Define_Switch + (Config => Config, + Output => Cmd.URL'Access, + Long_Switch => "--use=", + Argument => "PATH", + Help => "Use a directory to fulfill a dependency"); end Setup_Switches; end Alr.Commands.Pin; diff --git a/src/alr/alr-commands-pin.ads b/src/alr/alr-commands-pin.ads index 3cf16423..07f2c1cc 100644 --- a/src/alr/alr-commands-pin.ads +++ b/src/alr/alr-commands-pin.ads @@ -1,3 +1,5 @@ +with GNAT.Strings; + package Alr.Commands.Pin is type Command is new Commands.Command with private; @@ -20,13 +22,16 @@ package Alr.Commands.Pin is overriding function Usage_Custom_Parameters (Cmd : Command) return String - is ("[[crate[=]] | --all]"); + is ("[[crate[=]]" + & " | crate --use=" + & " | --all]"); private type Command is new Commands.Command with record Pin_All : aliased Boolean; Unpin : aliased Boolean; + URL : aliased GNAT.Strings.String_Access; end record; end Alr.Commands.Pin; diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index fadb2b55..47c4fd05 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -23,14 +23,21 @@ with Semantic_Versioning.Extended; package body Alr.Commands.Withing is + Switch_URL : constant String := "--use"; + package Query renames Alire.Solver; + procedure Replace_Current + (Old_Deps, + New_Deps : Alire.Conditional.Dependencies; + Old_Solution : Alire.Solutions.Solution := Root.Current.Solution); + --------- -- Add -- --------- - function Add (Deps : Alire.Conditional.Dependencies; - New_Dep : String) + function Add (Deps : Alire.Conditional.Dependencies; + New_Dep : String) return Alire.Conditional.Dependencies is use all type Alire.Conditional.Dependencies; @@ -72,9 +79,56 @@ package body Alr.Commands.Withing is else Trace.Detail ("Dependency " & New_Dep & " can be added"); end if; + end return; end Add; + ------------------ + -- Add_Softlink -- + ------------------ + + procedure Add_Softlink (Cmd : Command) is + Requested : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (Argument (1)); + New_Dep : constant Alire.Dependencies.Dependency := + Alire.Dependencies.From_Milestones (Requested); + begin + if Num_Arguments /= 1 then + Reportaise_Wrong_Arguments + ("Exactly one crate needed for external pinning."); + end if; + + if not Root.Current.Solution.Valid then + Reportaise_Command_Failed + ("Cannot add pinned crates to already unsolvable dependencies"); + end if; + + declare + use Alire; + use type Conditional.Dependencies; + Old_Deps : constant Conditional.Dependencies := + Root.Current.Release.Dependencies; + Old_Solution : constant Solutions.Solution := Root.Current.Solution; + New_Solution : constant Solutions.Solution := + Old_Solution + .Depending_On (New_Dep) + .Linking (Crate => New_Dep.Crate, + Path => Cmd.URL.all); + begin + + -- If we made here there were no errors adding the dependency + -- and storing the softlink. We can proceed to confirming the + -- replacement. + + Replace_Current (Old_Deps => Old_Deps, + New_Deps => Old_Deps and New_Dep, + Old_Solution => New_Solution); + -- We use the New_Solution with the softlink as previous solution, so + -- the pinned directory is used by the solver. + + end; + end Add_Softlink; + --------- -- Del -- --------- @@ -123,8 +177,10 @@ package body Alr.Commands.Withing is -- Replace_Current -- --------------------- - procedure Replace_Current (Old_Deps, - New_Deps : Alire.Conditional.Dependencies) + procedure Replace_Current + (Old_Deps, + New_Deps : Alire.Conditional.Dependencies; + Old_Solution : Alire.Solutions.Solution := Root.Current.Solution) is begin Requires_Full_Index; @@ -134,11 +190,12 @@ package body Alr.Commands.Withing is New_Root : constant Alire.Roots.Root := Alire.Roots.New_Root (Root.Current.Release.Replacing (Dependencies => New_Deps), - Root.Current.Path); + Root.Current.Path, + Platform.Properties); New_Solution : constant Alire.Solutions.Solution := Alire.Solver.Resolve (New_Deps, Platform.Properties, - Root.Current.Solution); + Old_Solution); begin -- Show changes to apply @@ -147,6 +204,15 @@ package body Alr.Commands.Withing is Trace.Info (""); Alire.Dependencies.Diffs.Between (Old_Deps, New_Deps).Print; + -- In the event of a new invalid solution (this should not happen, + -- but as a safeguard we ensure it cannot be committed to disk) bail + -- out already. + + if not New_Solution.Valid then + Reportaise_Command_Failed + ("No solution for the requested changes"); + end if; + -- Show the effects on the solution if not User_Input.Confirm_Solution_Changes @@ -351,12 +417,16 @@ package body Alr.Commands.Withing is begin Requires_Valid_Session; + if Cmd.URL.all /= "" then + Flags := Flags + 1; + end if; + Check (Cmd.Del); Check (Cmd.From); Check (Cmd.Solve); -- No parameters: give current platform dependencies and BAIL OUT - if not (Cmd.Del or else Cmd.From) and then Num_Arguments = 0 then + if Num_Arguments = 0 and then (Flags = 0 or else Cmd.Solve) then List (Cmd); return; end if; @@ -370,9 +440,17 @@ package body Alr.Commands.Withing is end if; end if; - if not (Cmd.Del or else Cmd.From) and then Num_Arguments > 0 then - Requires_Full_Index; - Add; + if not (Cmd.Del or else Cmd.From) then + + -- Must be Add, but it could be regular or softlink + + if Cmd.URL.all /= "" then + Add_Softlink (Cmd); + else + Requires_Full_Index; + Add; + end if; + elsif Cmd.Del then Del; elsif Cmd.From then @@ -403,6 +481,11 @@ package body Alr.Commands.Withing is & " by using the --del flag. Dependencies cannot be" & " simultaneously added and removed in a single invocation.") .New_Line + .Append ("* Adding dependencies pinned to external sources:") + .Append ("When a single crate name is accompanied by an --use PATH" + & " argument, the crate is always fulfilled for any required" + & " version by the sources found at PATH.") + .New_Line .Append ("* Adding dependencies from a GPR file:") .Append ("The project file given with --from will be scanned looking" & " for comments that contain the sequence 'alr with'. " @@ -444,6 +527,13 @@ package body Alr.Commands.Withing is "", "--from", "Use dependencies declared within GPR project file"); + Define_Switch + (Config => Config, + Output => Cmd.URL'Access, + Long_Switch => Switch_URL & "=", + Argument => "PATH", + Help => "Add a dependency pinned to some external source"); + Define_Switch (Config, Cmd.Solve'Access, "", "--solve", diff --git a/src/alr/alr-commands-withing.ads b/src/alr/alr-commands-withing.ads index 3af64b0d..38386ccb 100644 --- a/src/alr/alr-commands-withing.ads +++ b/src/alr/alr-commands-withing.ads @@ -1,3 +1,5 @@ +private with GNAT.Strings; + package Alr.Commands.Withing is type Command is new Commands.Command with private; @@ -16,7 +18,9 @@ package Alr.Commands.Withing is ("Manage release dependencies"); overriding function Usage_Custom_Parameters (Cmd : Command) return String is - ("[{ [--del] [versions]... | --from ... }]"); + ("[{ [--del] [versions]..." + & " | --from ..." + & " | [versions] --use } ]"); private @@ -24,6 +28,7 @@ private Del : aliased Boolean := False; From : aliased Boolean := False; Solve : aliased Boolean := False; + URL : aliased GNAT.Strings.String_Access; end record; end Alr.Commands.Withing; diff --git a/src/alr/alr-main.adb b/src/alr/alr-main.adb index 1018bada..962f60aa 100644 --- a/src/alr/alr-main.adb +++ b/src/alr/alr-main.adb @@ -1,5 +1,6 @@ with Alire; with Alire_Early_Elaboration; pragma Elaborate_All (Alire_Early_Elaboration); +with Alire.Root; with Alr.Bootstrap; with Alr.Commands; @@ -12,6 +13,17 @@ procedure Alr.Main is begin Alr.Platform.Init (Alr.Platforms.Current.New_Platform); + -- Get an instance of the current platform and pass its properties to + -- Alire. This is a temporary situation until all of Alr.Platform is + -- refactored into Alire. TODO: remove during the refactor. During the + -- same refactor, the above creation and setting of an instance can be + -- made unnecessary if we rely on a common spec instead of on a common base + -- class. That will also allow having the platform properties available + -- during elaboration. TODO: during the refactor, convert from tagged + -- type to shared specification. All of this should be done on Issue #335. + + Alire.Root.Set_Platform_Properties (Alr.Platform.Properties); + Trace.Detail ("alr build is " & Bootstrap.Status_Line); Commands.Execute; diff --git a/testsuite/drivers/alr.py b/testsuite/drivers/alr.py index 5c6b3cfc..77b038d3 100644 --- a/testsuite/drivers/alr.py +++ b/testsuite/drivers/alr.py @@ -59,7 +59,7 @@ def run_alr(*args, **kwargs): raise ValueError('Invalid argument: {}'.format(first_unknown_kwarg)) argv = ['alr'] - argv.append('-n') # always non-interactive + argv.append('-n') # always non-interactive if debug: argv.append('-d') if quiet: diff --git a/testsuite/drivers/helpers.py b/testsuite/drivers/helpers.py index 1550bdd5..7b38dee9 100644 --- a/testsuite/drivers/helpers.py +++ b/testsuite/drivers/helpers.py @@ -20,14 +20,41 @@ def check_line_in(filename, line): repr(line), filename) -# Assert two values are equal or format the differences -def compare(found, wanted): - assert found == wanted, 'Got: {}\nWanted: {}'.format(found, wanted) - - # Return the entries (sorted) under a given folder, both folders and files def contents(dir): assert os.path.exists(dir), "Bad path for enumeration: {}".format(dir) return sorted([os.path.join(root, name).replace('\\', '/') for root, dirs, files in os.walk(dir) for name in dirs + files]) + + +# Assert two values are equal or format the differences +def compare(found, wanted): + assert found == wanted, 'Got: {}\nWanted: {}'.format(found, wanted) + + +# Check line appears in file +def check_line_in(filename, line): + """ + Assert that the `filename` tetx file contains at least one line that + contains `line`. + """ + with open(filename, 'r') as f: + for l in f: + if l.rstrip() == line: + break + else: + assert False, 'Could not find {} in {}'.format( + repr(line), filename) + + +def path_separator(): + return '/' if os.name != 'nt' else '\\' + + +# Add a 'with "something";' at the top of a project file +def with_project(file, project): + with open(file, 'r+') as f: + content = f.read() + f.seek(0, 0) + f.write('with "{}";'.format(project) + '\n' + content) diff --git a/testsuite/tests/index/external-hint/test.py b/testsuite/tests/index/external-hint/test.py index 98e8ae3a..9e25c437 100644 --- a/testsuite/tests/index/external-hint/test.py +++ b/testsuite/tests/index/external-hint/test.py @@ -39,7 +39,7 @@ assert_match p = run_alr('show', 'crate_master', '--solve', '--system', quiet=False) assert_match(".*Dependencies \(external\):\n" - " crate\*\n" + " crate\* \(direct,hinted\)\n" " Hint: This is a custom hint\n.*", p.out, flags=re.S) diff --git a/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/libhello.gpr b/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/libhello.gpr new file mode 100644 index 00000000..3fe673f3 --- /dev/null +++ b/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/libhello.gpr @@ -0,0 +1,24 @@ +project Libhello is + + for Library_Name use "Libhello"; + for Library_Version use "0.0.0"; + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + + package Builder is + for Switches ("ada") use ("-j0", "-g"); + end Builder; + + package Compiler is + for Switches ("ada") use + ("-gnatVa", "-gnatwa", "-g", "-O2", + "-gnata", "-gnato", "-fstack-check"); + end Compiler; + + package Binder is + for Switches ("ada") use ("-Es"); + end Binder; + +end Libhello; diff --git a/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/src/libhello.ads b/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/src/libhello.ads new file mode 100644 index 00000000..d4879364 --- /dev/null +++ b/testsuite/tests/pin/change-type/my_index/crates/libhello_1.0.0/src/libhello.ads @@ -0,0 +1,3 @@ +package Libhello is + +end Libhello; diff --git a/testsuite/tests/pin/change-type/my_index/index/index.toml b/testsuite/tests/pin/change-type/my_index/index/index.toml new file mode 100644 index 00000000..7c969026 --- /dev/null +++ b/testsuite/tests/pin/change-type/my_index/index/index.toml @@ -0,0 +1 @@ +version = "0.2" diff --git a/testsuite/tests/pin/change-type/my_index/index/li/libhello.toml b/testsuite/tests/pin/change-type/my_index/index/li/libhello.toml new file mode 100644 index 00000000..460334ba --- /dev/null +++ b/testsuite/tests/pin/change-type/my_index/index/li/libhello.toml @@ -0,0 +1,8 @@ +[general] +description = "libhello" +licenses = [] +maintainers = ["some@one.com"] +maintainers-logins = ["mylogin"] + +['1.0'] +origin = "file://../../crates/libhello_1.0.0" diff --git a/testsuite/tests/pin/change-type/test.py b/testsuite/tests/pin/change-type/test.py new file mode 100644 index 00000000..d950ea4f --- /dev/null +++ b/testsuite/tests/pin/change-type/test.py @@ -0,0 +1,48 @@ +""" +Change a pinned dependency from a version to a folder and back +""" + +import os +import re + +from drivers.alr import run_alr +from drivers.asserts import assert_match +from drivers.helpers import path_separator + + +def check_version_pin(): + p = run_alr('show', '--solve') + assert_match('.*Dependencies \(solution\):' + '.*libhello=1.0.0.*', + p.out, flags=re.S) + + +# Initialize a workspace, enter, and add a regular dependency +run_alr('init', '--bin', 'xxx') +os.chdir('xxx') +run_alr('with', 'libhello') + +# Pin to a version +p = run_alr('pin', 'libhello=1.0') + +# Check that it shows as such in the solution +check_version_pin() + +# Repin to a folder +run_alr('pin', 'libhello', '--use', '../my_index/crates/libhello_1.0.0') + +# Check that it shows as such in the solution +p = run_alr('show', '--solve') +s = re.escape(path_separator()) # platform-dependent +assert_match('.*Dependencies \(external\):.*' + 'libhello\* \(direct,linked' + ',target=.*' + s + 'my_index' + s + + 'crates' + s + 'libhello_1.0.0\).*', + p.out, flags=re.S) + +# Repin to a version and check again +p = run_alr('pin', 'libhello=1.0') +check_version_pin() + + +print('SUCCESS') diff --git a/testsuite/tests/pin/change-type/test.yaml b/testsuite/tests/pin/change-type/test.yaml new file mode 100644 index 00000000..0a859639 --- /dev/null +++ b/testsuite/tests/pin/change-type/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false diff --git a/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr b/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr new file mode 100644 index 00000000..3fe673f3 --- /dev/null +++ b/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr @@ -0,0 +1,24 @@ +project Libhello is + + for Library_Name use "Libhello"; + for Library_Version use "0.0.0"; + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + + package Builder is + for Switches ("ada") use ("-j0", "-g"); + end Builder; + + package Compiler is + for Switches ("ada") use + ("-gnatVa", "-gnatwa", "-g", "-O2", + "-gnata", "-gnato", "-fstack-check"); + end Compiler; + + package Binder is + for Switches ("ada") use ("-Es"); + end Binder; + +end Libhello; diff --git a/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads b/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads new file mode 100644 index 00000000..d4879364 --- /dev/null +++ b/testsuite/tests/pin/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads @@ -0,0 +1,3 @@ +package Libhello is + +end Libhello; diff --git a/testsuite/tests/pin/pin-dir/my_index/index/index.toml b/testsuite/tests/pin/pin-dir/my_index/index/index.toml new file mode 100644 index 00000000..7c969026 --- /dev/null +++ b/testsuite/tests/pin/pin-dir/my_index/index/index.toml @@ -0,0 +1 @@ +version = "0.2" diff --git a/testsuite/tests/pin/pin-dir/my_index/index/li/libhello.toml b/testsuite/tests/pin/pin-dir/my_index/index/li/libhello.toml new file mode 100644 index 00000000..460334ba --- /dev/null +++ b/testsuite/tests/pin/pin-dir/my_index/index/li/libhello.toml @@ -0,0 +1,8 @@ +[general] +description = "libhello" +licenses = [] +maintainers = ["some@one.com"] +maintainers-logins = ["mylogin"] + +['1.0'] +origin = "file://../../crates/libhello_1.0.0" diff --git a/testsuite/tests/pin/pin-dir/test.py b/testsuite/tests/pin/pin-dir/test.py new file mode 100644 index 00000000..2ec13acb --- /dev/null +++ b/testsuite/tests/pin/pin-dir/test.py @@ -0,0 +1,47 @@ +""" +Replacing a dependency with a pinned folder +""" + +import os +import re + +from drivers.alr import run_alr +from drivers.asserts import assert_match +from drivers.helpers import path_separator, with_project + +# Initialize a workspace, enter, and add a regular dependency +run_alr('init', '--bin', 'xxx') +os.chdir('xxx') + +# Prepend the library we want to use to its project file +with_project('xxx.gpr', 'libhello') + +# Verify it doesn't build without it +p = run_alr('build', complain_on_error=False) +assert p.status != 0, "Build should fail" + +# Add normally and then pin, check that it builds +run_alr('with', 'libhello') +run_alr('pin', 'libhello', '--use', '../my_index/crates/libhello_1.0.0') +run_alr('build') + +# Check the pin shows in the solution +p = run_alr('with', '--solve') +# For this match we don't know where the test is temporarily put, so we skip +# over some parts of the output +s = re.escape(path_separator()) # platform-dependent +assert_match('.*Dependencies \(external\):.*' + 'libhello\* \(direct,linked' + ',target=.*' + s + 'my_index' + s + + 'crates' + s + 'libhello_1.0.0\).*', + p.out, flags=re.S) + +# Check that unpinning the dependency works and now the dependency is show +# as a regular one from the index +run_alr('pin', '--unpin', 'libhello') +p = run_alr('show', '--solve') +assert_match('.*Dependencies \(solution\):' + '.*libhello=1.0.0.*', + p.out, flags=re.S) + +print('SUCCESS') diff --git a/testsuite/tests/pin/pin-dir/test.yaml b/testsuite/tests/pin/pin-dir/test.yaml new file mode 100644 index 00000000..0a859639 --- /dev/null +++ b/testsuite/tests/pin/pin-dir/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false diff --git a/testsuite/tests/with/external/test.py b/testsuite/tests/with/external/test.py index a4fe7aef..6ead3123 100644 --- a/testsuite/tests/with/external/test.py +++ b/testsuite/tests/with/external/test.py @@ -23,7 +23,7 @@ p = run_alr('with', '--solve') assert_match('Dependencies \(direct\):\n' ' make\*\n' 'Dependencies \(external\):\n' - ' make\*\n' + ' make\* \(direct,hinted\)\n' 'Dependencies \(graph\):\n' ' xxx=0.0.0 --> make\*\n' '.*', # skip plot or warning diff --git a/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr b/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr new file mode 100644 index 00000000..3fe673f3 --- /dev/null +++ b/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/libhello.gpr @@ -0,0 +1,24 @@ +project Libhello is + + for Library_Name use "Libhello"; + for Library_Version use "0.0.0"; + + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Library_Dir use "lib"; + + package Builder is + for Switches ("ada") use ("-j0", "-g"); + end Builder; + + package Compiler is + for Switches ("ada") use + ("-gnatVa", "-gnatwa", "-g", "-O2", + "-gnata", "-gnato", "-fstack-check"); + end Compiler; + + package Binder is + for Switches ("ada") use ("-Es"); + end Binder; + +end Libhello; diff --git a/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads b/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads new file mode 100644 index 00000000..d4879364 --- /dev/null +++ b/testsuite/tests/with/pin-dir/my_index/crates/libhello_1.0.0/src/libhello.ads @@ -0,0 +1,3 @@ +package Libhello is + +end Libhello; diff --git a/testsuite/tests/with/pin-dir/my_index/index/index.toml b/testsuite/tests/with/pin-dir/my_index/index/index.toml new file mode 100644 index 00000000..7c969026 --- /dev/null +++ b/testsuite/tests/with/pin-dir/my_index/index/index.toml @@ -0,0 +1 @@ +version = "0.2" diff --git a/testsuite/tests/with/pin-dir/my_index/index/libhello/libhello.toml b/testsuite/tests/with/pin-dir/my_index/index/libhello/libhello.toml new file mode 100644 index 00000000..460334ba --- /dev/null +++ b/testsuite/tests/with/pin-dir/my_index/index/libhello/libhello.toml @@ -0,0 +1,8 @@ +[general] +description = "libhello" +licenses = [] +maintainers = ["some@one.com"] +maintainers-logins = ["mylogin"] + +['1.0'] +origin = "file://../../crates/libhello_1.0.0" diff --git a/testsuite/tests/with/pin-dir/test.py b/testsuite/tests/with/pin-dir/test.py new file mode 100644 index 00000000..ba183a14 --- /dev/null +++ b/testsuite/tests/with/pin-dir/test.py @@ -0,0 +1,43 @@ +""" +Addition of dependencies directly as a pinned directory +""" + +import os +import re + +from drivers.alr import run_alr +from drivers.asserts import assert_match +from drivers.helpers import path_separator, with_project + +# Initialize a workspace, enter, and add a pinned dependency +run_alr('init', '--bin', 'xxx') +os.chdir('xxx') + +# Prepend the library we want to use to its project file +with_project('xxx.gpr', 'libhello') + +# Verify it doesn't build without it +p = run_alr('build', complain_on_error=False) +assert p.status != 0, "Build should fail" + +# Add pinned, check that it builds +run_alr('with', 'libhello', '--use', '../my_index/crates/libhello_1.0.0') +run_alr('build') + +# Check the pin shows in the solution +p = run_alr('with', '--solve') +# For this match we don't know where the test is temporarily put, so we skip +# over some parts of the output +s = re.escape(path_separator()) # platform-dependent +assert_match('.*Dependencies \(external\):.*' + 'libhello\* \(direct,linked' + ',target=.*' + s + 'my_index' + s + + 'crates' + s + 'libhello_1.0.0\).*', + p.out, flags=re.S) + +# Check that removing the dependency works and build is again failing +run_alr('with', '--del', 'libhello') +p = run_alr('build', complain_on_error=False) +assert p.status != 0, "Build should fail" + +print('SUCCESS') diff --git a/testsuite/tests/with/pin-dir/test.yaml b/testsuite/tests/with/pin-dir/test.yaml new file mode 100644 index 00000000..0a859639 --- /dev/null +++ b/testsuite/tests/with/pin-dir/test.yaml @@ -0,0 +1,4 @@ +driver: python-script +indexes: + my_index: + in_fixtures: false -- 2.39.5