From 738e4b43cf696f5c387ed3b313390ad189d99428 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Thu, 11 Jun 2020 13:33:39 +0200 Subject: [PATCH] Internal enhancements to Solution and Dependency states (#429) * Remove obsolete Alire.Dependencies.Unavailable This fake dependency was used in the old Ada index to store an unavailable dependency. There is no longer any use for this constant. * Image functions for newly tagged Alire.Milestones Make the type tagged to gain dot notation, and add [TTY_]Image subprograms for simpler printing elsewhere. * New Alire.Dependencies.States type This type is used to store the actual way in which a dependency was solved. All possibilities are stored, which allows to properly cache a solution, and detect changes in solutions across operations that modify the solution: pinning, withing, updating... * New Alire.Dependencies.States.Maps A crate name -> dep state mapping which is at the core of the cached Solution, with a couple of functional-style modifiers for use in expression functions. * Remove pinning info from Releases This information is now stored in the dependency State where it better belongs. This way it doesn't matter if the solution contains a release for the pinned dependency; the pinning information is always preserved. * Reworked Solution internals to use States (Doesn't build.) Changes to Alire.Solutions to use the new dependency states. With these changes there is no loss of information when going from a valid to an invalid solution (information about partial solutions is stored the same as for complete solutions), which enables down the road better feedback to users and simpler implementation of other improvements, like pinning of crates to local folders. * Solver improvements based on new dependency states (Only alire-solver.adb builds.) With these changes, the solver needs not to check the complete validity of a solution once all dependencies are processed (which is an expensive test), because validity is guaranteed for any partial solution (that is, no incompatible release can make into the solution). Also, while the solver was previously complete in regard to valid solutions (with releases or hints), now it is also complete for invalid solutions (those missing releases and hints for some dependency). This means that the solver will return the "best" incomplete solution when a complete one cannot be found. * Tweaks to achieve build with new Solution A few minor changes due to changes in the Solution public methods are needed here and there, without functional implications. * Tweaks for testsuite compliance A few changes are needed to ensure the same output as before is produced, or to adapt a few tests to minimal output changes caused by the homogenization of dependency images. * Make Alire.Crate_Name a proper private type Our Dynamic_Predicate in the publicly defined Crate_Name as new String is rejected by GNAT 9, and I couldn't find a workaround short of making all of Alire.* non-preelaborable. Defining privately Crate_Name as new String in turn caused numerous errors in child packages due to some mixing between the public and private views. In the end, making it a record was the simplest change without introducing the risk of missing checks (as if we had made it simply a subtype of String). So, given the change, I bit the bullet to make it tagged and provide a couple of convenience functions. * Review fixes --- deps/semantic_versioning | 2 +- deps/simple_logging | 2 +- src/alire/alire-conditional-operations.ads | 31 - src/alire/alire-containers.adb | 24 + src/alire/alire-containers.ads | 4 + src/alire/alire-crates-with_releases.adb | 2 +- src/alire/alire-crates-with_releases.ads | 2 +- src/alire/alire-dependencies-graphs.adb | 12 +- src/alire/alire-dependencies-graphs.ads | 2 +- src/alire/alire-dependencies-states-maps.adb | 79 ++ src/alire/alire-dependencies-states-maps.ads | 27 + src/alire/alire-dependencies-states.adb | 140 +++ src/alire/alire-dependencies-states.ads | 389 ++++++++ src/alire/alire-dependencies.ads | 30 +- src/alire/alire-externals-unindexed.adb | 2 +- src/alire/alire-index_on_disk.adb | 2 +- src/alire/alire-lockfiles.adb | 3 +- src/alire/alire-milestones.ads | 34 +- src/alire/alire-pinning.adb | 6 +- src/alire/alire-pinning.ads | 6 +- src/alire/alire-releases.adb | 66 +- src/alire/alire-releases.ads | 39 +- src/alire/alire-solutions-diffs.adb | 36 +- src/alire/alire-solutions-diffs.ads | 4 +- src/alire/alire-solutions.adb | 662 ++++++++------ src/alire/alire-solutions.ads | 486 ++++++++-- src/alire/alire-solver.adb | 846 ++++++++---------- src/alire/alire-solver.ads | 47 +- src/alire/alire.adb | 34 +- src/alire/alire.ads | 41 +- src/alr/alr-build_env.adb | 1 + src/alr/alr-checkout.adb | 8 +- src/alr/alr-commands-get.adb | 4 +- src/alr/alr-commands-pin.adb | 12 +- src/alr/alr-commands-search.adb | 5 +- src/alr/alr-commands-show.adb | 25 +- src/alr/alr-commands-update.adb | 9 +- src/alr/alr-commands.adb | 7 +- testsuite/tests/get/only/test.py | 4 +- testsuite/tests/get/system-hint/test.py | 2 +- .../tests/index/external-available/test.py | 2 +- .../tests/index/external-from-output/test.py | 2 +- testsuite/tests/pin/downgrade/test.py | 2 +- testsuite/tests/pin/post-update/test.py | 2 +- .../run/defaults/my_index/index/index.toml | 1 - 45 files changed, 2050 insertions(+), 1096 deletions(-) delete mode 100644 src/alire/alire-conditional-operations.ads create mode 100644 src/alire/alire-dependencies-states-maps.adb create mode 100644 src/alire/alire-dependencies-states-maps.ads create mode 100644 src/alire/alire-dependencies-states.adb create mode 100644 src/alire/alire-dependencies-states.ads delete mode 100644 testsuite/tests/run/defaults/my_index/index/index.toml diff --git a/deps/semantic_versioning b/deps/semantic_versioning index d025a2b6..faefc335 160000 --- a/deps/semantic_versioning +++ b/deps/semantic_versioning @@ -1 +1 @@ -Subproject commit d025a2b6374ac6a19322fcc9fc606c73367ebf96 +Subproject commit faefc335609935abbeee8e942ca6742286f7277c diff --git a/deps/simple_logging b/deps/simple_logging index 73a5dd32..2e3f631a 160000 --- a/deps/simple_logging +++ b/deps/simple_logging @@ -1 +1 @@ -Subproject commit 73a5dd32f3f71d718e982a55969d0d915817c0d9 +Subproject commit 2e3f631a9a18f29fd56fa66e19ab34c903a8eb02 diff --git a/src/alire/alire-conditional-operations.ads b/src/alire/alire-conditional-operations.ads deleted file mode 100644 index b56cb283..00000000 --- a/src/alire/alire-conditional-operations.ads +++ /dev/null @@ -1,31 +0,0 @@ -with Alire.Containers; -with Alire.Releases; - -package Alire.Conditional.Operations is - - function Contains (Tree : Dependencies; - R : Releases.Release) - return Boolean; - - function Contains_Some (Tree : Dependencies; - Map : Containers.Release_Map) - return Boolean; - -- If any in Map is also in Tree - -private - - use Conditional.For_Dependencies; - - function Contains (Tree : Dependencies; - R : Releases.Release) - return Boolean - is (for some Child of Tree => - Child.Is_Value and then R.Satisfies (Child.Value) - ); - - function Contains_Some (Tree : Dependencies; - Map : Containers.Release_Map) - return Boolean - is (for some R of Map => Contains (Tree, R)); - -end Alire.Conditional.Operations; diff --git a/src/alire/alire-containers.adb b/src/alire/alire-containers.adb index 0dfb5d48..963d11ab 100644 --- a/src/alire/alire-containers.adb +++ b/src/alire/alire-containers.adb @@ -3,6 +3,30 @@ with Semantic_Versioning.Extended; package body Alire.Containers is + --------------- + -- Enumerate -- + --------------- + + function Enumerate (These : Conditional.Dependencies) return Dependency_Map + is + + procedure Append (C : in out Dependency_Map; + V : Dependencies.Dependency; + Count : Ada.Containers.Count_Type := 1) + is + pragma Unreferenced (Count); + begin + C.Include (V.Crate, V); + end Append; + + function Internal is new Conditional.For_Dependencies.Enumerate + (Collection => Dependency_Map, + Append => Append); + + begin + return Internal (These); + end Enumerate; + ------------ -- Insert -- ------------ diff --git a/src/alire/alire-containers.ads b/src/alire/alire-containers.ads index e84e84cb..49bd2879 100644 --- a/src/alire/alire-containers.ads +++ b/src/alire/alire-containers.ads @@ -28,6 +28,10 @@ package Alire.Containers with Preelaborate is Empty_Dependency_Map : constant Dependency_Map; + function Enumerate (These : Conditional.Dependencies) return Dependency_Map; + -- Eliminate OR branches in These by recursive enumeration; that is, all OR + -- branches will appear in the result. + procedure Merge (This : in out Dependency_Map; Dep : Dependencies.Dependency); -- If the dependency is already in map, create a combined dependency that diff --git a/src/alire/alire-crates-with_releases.adb b/src/alire/alire-crates-with_releases.adb index 8ae9767b..ec2a13b1 100644 --- a/src/alire/alire-crates-with_releases.adb +++ b/src/alire/alire-crates-with_releases.adb @@ -241,7 +241,7 @@ package body Alire.Crates.With_Releases is function New_Crate (Name : Crate_Name) return Crate is (Crate'(General with - Len => Name'Length, + Len => Name.Length, Name => Name, Externals => <>, Releases => <>)); diff --git a/src/alire/alire-crates-with_releases.ads b/src/alire/alire-crates-with_releases.ads index e90da60c..da4e1eb7 100644 --- a/src/alire/alire-crates-with_releases.ads +++ b/src/alire/alire-crates-with_releases.ads @@ -58,7 +58,7 @@ private type Crate (Len : Natural) is new General and Interfaces.Detomifiable with record - Name : Crate_Name (1 .. Len); + Name : Crate_Name (Len); Externals : Alire.Externals.Lists.List; Releases : Containers.Release_Set; end record; diff --git a/src/alire/alire-dependencies-graphs.adb b/src/alire/alire-dependencies-graphs.adb index a6c7e1a0..563dbe4a 100644 --- a/src/alire/alire-dependencies-graphs.adb +++ b/src/alire/alire-dependencies-graphs.adb @@ -25,7 +25,7 @@ package body Alire.Dependencies.Graphs is Result := Result.Including (Rel, Env); end loop; - Result := Result.Filtering_Unused (Sol.Required); + Result := Result.Filtering_Unused (Sol.Crates); end return; end From_Solution; @@ -102,10 +102,10 @@ package body Alire.Dependencies.Graphs is then (if TTY then Solution.Releases.Element (Crate).Milestone.TTY_Image else Solution.Releases.Element (Crate).Milestone.Image) - elsif Solution.Hints.Contains (Crate) + elsif Solution.Depends_On (Crate) then (if TTY - then Solution.Hints.Element (Crate).TTY_Image - else Solution.Hints.Element (Crate).Image) + then Solution.Dependency (Crate).TTY_Image + else Solution.Dependency (Crate).Image) else raise Program_Error with "crate should appear as release or hint"); ---------- @@ -121,7 +121,7 @@ package body Alire.Dependencies.Graphs is Source : Utils.String_Vector; Alt : Utils.String_Vector; - Filtered : constant Graph := This.Filtering_Unused (Solution.Required); + Filtered : constant Graph := This.Filtering_Unused (Solution.Crates); begin Alt.Append ("graph dependencies {"); @@ -156,7 +156,7 @@ package body Alire.Dependencies.Graphs is is Table : Alire.Utils.Tables.Table; - Filtered : constant Graph := This.Filtering_Unused (Solution.Required); + Filtered : constant Graph := This.Filtering_Unused (Solution.Crates); begin for Dep of Filtered loop Table.Append (Prefix & Label (+Dep.Dependent, Solution, TTY => True)); diff --git a/src/alire/alire-dependencies-graphs.ads b/src/alire/alire-dependencies-graphs.ads index 4fc6f4e9..28b02a7a 100644 --- a/src/alire/alire-dependencies-graphs.ads +++ b/src/alire/alire-dependencies-graphs.ads @@ -57,7 +57,7 @@ private function New_Dependency (Dependent, Dependee : Alire.Crate_Name) return Dependency is - (Dependent'Length, Dependee'Length, +Dependent, +Dependee); + (Dependent.Length, Dependee.Length, +Dependent, +Dependee); package Dep_Sets is new Ada.Containers.Indefinite_Ordered_Sets (Dependency); diff --git a/src/alire/alire-dependencies-states-maps.adb b/src/alire/alire-dependencies-states-maps.adb new file mode 100644 index 00000000..92945d55 --- /dev/null +++ b/src/alire/alire-dependencies-states-maps.adb @@ -0,0 +1,79 @@ +package body Alire.Dependencies.States.Maps is + + use TOML; + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) return Map is + -- Read from an array of key: + -- [[state]] + + States : constant TOML_Value := From.Unwrap; -- The TOML array + + begin + return This : Map do + for I in 1 .. States.Length loop + declare + Status : constant State := + Dependencies.States.From_TOML + (From.Descend + (States.Item (I), + "state " & I'Img)); + begin + This.Insert (Status.Crate, Status); + end; + end loop; + end return; + end From_TOML; + + --------------- + -- Including -- + --------------- + + function Including (Base : Map; + State : States.State) + return Map + is + begin + return Result : Map := Base do + Result.Include (State.Crate, State); + end return; + end Including; + + ------------- + -- Merging -- + ------------- + + function Merging (Base : Map; + Dep : Dependencies.Dependency) + return Map + is + New_Dep : constant State := + (if Base.Contains (Dep.Crate) + then Base (Dep.Crate).Merging (Dep.Versions) + else States.New_State (Dep)); + begin + return Result : Map := Base do + Result.Include (Dep.Crate, New_Dep); + end return; + end Merging; + + ------------- + -- To_TOML -- + ------------- + + overriding + function To_TOML (This : Map) return TOML.TOML_Value is + -- Stored as an array of individual states: + -- [[state]] + begin + return Arr : constant TOML_Value := Create_Array (TOML_Table) do + for Dep of This loop + Arr.Append (Dep.To_TOML); + end loop; + end return; + end To_TOML; + +end Alire.Dependencies.States.Maps; diff --git a/src/alire/alire-dependencies-states-maps.ads b/src/alire/alire-dependencies-states-maps.ads new file mode 100644 index 00000000..ed2b4fce --- /dev/null +++ b/src/alire/alire-dependencies-states-maps.ads @@ -0,0 +1,27 @@ +with Ada.Containers.Indefinite_Ordered_Maps; + +package Alire.Dependencies.States.Maps is + + package State_Maps is + new Ada.Containers.Indefinite_Ordered_Maps (Crate_Name, State); + + type Map is + new State_Maps.Map + and Interfaces.Tomifiable with null record; + + function Including (Base : Map; + State : States.State) + return Map; + -- Add or replace a state -- no merging of versions takes place + + function Merging (Base : Map; + Dep : Dependencies.Dependency) + return Map; + -- When Dep is new in Base, add Dep as Unknown, Unsolved, Unpinned. + -- Otherwise, "and" Dep versions without modifying the state. + + function From_TOML (From : TOML_Adapters.Key_Queue) return Map; + + overriding function To_TOML (This : Map) return TOML.TOML_Value; + +end Alire.Dependencies.States.Maps; diff --git a/src/alire/alire-dependencies-states.adb b/src/alire/alire-dependencies-states.adb new file mode 100644 index 00000000..ed604294 --- /dev/null +++ b/src/alire/alire-dependencies-states.adb @@ -0,0 +1,140 @@ +with Alire.Crates.With_Releases; + +package body Alire.Dependencies.States is + + use TOML; + + package Keys is + + Crate : constant String := "crate"; + Fulfilment : constant String := "fulfilment"; + Pin_Version : constant String := "pin_version"; + Pinned : constant String := "pinned"; + Release : constant String := "release"; + Transitivity : constant String := "transitivity"; + Versions : constant String := "versions"; + + end Keys; + + -- The output format is plainly each field in State with its value in a + -- table: field = "value" + + --------------- + -- From_TOML -- + --------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) return State + is + Crate : constant Crate_Name := + +From.Checked_Pop (Keys.Crate, TOML_String).As_String; + Versions : constant Semantic_Versioning.Extended.Version_Set := + Semantic_Versioning.Extended.Value + (From.Checked_Pop (Keys.Versions, + TOML_String).As_String); + begin + return This : State := New_Dependency (Crate, Versions) do + + -- Transitivity + + This.Transitivity := + Transitivities'Value + (From.Checked_Pop (Keys.Transitivity, TOML_String).As_String); + + -- Pinning + + declare + Data : Pinning_Data + (From.Checked_Pop (Keys.Pinned, TOML_Boolean).As_Boolean); + begin + if Data.Pinned then + Data.Version := Semantic_Versioning.Parse + (From.Checked_Pop (Keys.Pin_Version, TOML_String).As_String); + end if; + + This.Pinning := Data; + end; + + -- 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 + + -- 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; + + ------------- + -- To_TOML -- + ------------- + + overriding function To_TOML (This : State) return TOML.TOML_Value + is + use TOML_Adapters; + use Utils; + begin + return Table : constant TOML_Value := Create_Table do + + -- Base + + Table.Set (Keys.Crate, +(+This.Crate)); + Table.Set (Keys.Versions, +This.Versions.Image); + + -- Transitivity + + Table.Set (Keys.Transitivity, +To_Lower_Case (This.Transitivity'Img)); + + -- Pinning + + Table.Set (Keys.Pinned, Create_Boolean (This.Pinning.Pinned)); + if This.Pinning.Pinned then + Table.Set (Keys.Pin_Version, +This.Pinning.Version.Image); + end if; + + -- 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 + + 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; + +end Alire.Dependencies.States; diff --git a/src/alire/alire-dependencies-states.ads b/src/alire/alire-dependencies-states.ads new file mode 100644 index 00000000..e11a920f --- /dev/null +++ b/src/alire/alire-dependencies-states.ads @@ -0,0 +1,389 @@ +private +with Alire.Containers; +with Alire.Properties; +with Alire.Releases; + +package Alire.Dependencies.States is + + -- This type is used to store the state of a dependency post-solving. This + -- extra information goes into the lockfile and allows tracking the status + -- of special dependencies (pins, links, missing) across solution changes. + + type Fulfilments is (Missed, -- Version not found, nor external definition + Hinted, -- Undetected external + Linked, -- Supplied for any version by a local dir + Solved); -- Solved with a regular release/detected hint + + type Transitivities is (Unknown, -- Needed by limitations in the solver + Direct, -- A dependency of the root release + Indirect); -- A dependency introduced transitively + + type State (<>) is new Dependency with private; + + ------------------ + -- Constructors -- + ------------------ + + function New_State (Base : Dependency) return State; + -- Initializes a new Missing, Unknown, Unpinned state. + + function Hinting (Base : State) return State; + -- Change fulfilment to Hinted in copy of Base + + function Merging (Base : State; + Versions : Semantic_Versioning.Extended.Version_Set) + return State; + -- Returns a copy of Base with additional anded versions + + function Missing (Base : State) return State; + -- Change fulfilment to Missed in copy of Base + + function Pinning (Base : State; + Version : Semantic_Versioning.Version) + return State; + -- Sets the pin in a copy of Base + + function Setting (Base : State; + Transitivity : Transitivities) + return State; + -- Modify transitivity in a copy of Base + + function Solving (Base : State; + Using : Releases.Release) + return State + with Pre => Base.Crate = Using.Name; + -- Uses release to fulfil this dependency in a copy of Base + + function Unpinning (Base : State) return State; + -- Removes the pin in a copy of Base + + ---------------- + -- Attributes -- + ---------------- + + function As_Dependency (This : State) return Dependencies.Dependency; + -- Upcast for convenience, equivalent to Dependencies.Dependency (This) + + -- Simple status identification + + function Is_Direct (This : State) return Boolean; + + function Is_Hinted (This : State) return Boolean; + + function Is_Indirect (This : State) return Boolean; + + function Is_Missing (This : State) return Boolean; + + function Is_Pinned (This : State) return Boolean; + + function Is_Solved (This : State) return Boolean; + + -- Case-specific info + + function Fulfilment (This : State) return Fulfilments; + + function Pin_Version (This : State) return Semantic_Versioning.Version + with Pre => This.Is_Pinned; + + function Release (This : State) return Releases.Release + with Pre => This.Is_Solved; + + function Transitivity (This : State) return Transitivities; + + -- Imaging + + overriding function Image (This : State) return String; + + overriding function TTY_Image (This : State) return String; + + ------------------- + -- Serialization -- + ------------------- + + function From_TOML (From : TOML_Adapters.Key_Queue) return State; + + overriding function To_TOML (This : State) return TOML.TOML_Value; + +private + + use type Semantic_Versioning.Extended.Version_Set; + + -- Base overridings + + overriding + function From_Milestones (Unused : Milestones.Allowed_Milestones) + return State; + + overriding + function From_TOML (Unused_Key : String; + Unused_Value : TOML.TOML_Value) return State; + + overriding + function New_Dependency (Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return State; + + 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 + when Solved => Release : Containers.Release_H; + when others => null; + end case; + end record; + + type Pinning_Data (Pinned : Boolean := False) is record + case Pinned is + when True => Version : Semantic_Versioning.Version; + when False => null; + end case; + end record; + + type State (Name_Len : Natural) is new Dependency (Name_Len) with record + Fulfilled : Fulfilment_Data; + Pinning : Pinning_Data; + Transitivity : Transitivities := Unknown; + end record; + + ------------------- + -- As_Dependency -- + ------------------- + + function As_Dependency (This : State) return Dependencies.Dependency + is (Dependencies.Dependency (This)); + + --------------------- + -- From_Milestones -- + --------------------- + + overriding + function From_Milestones (Unused : Milestones.Allowed_Milestones) + return State + is (raise Unimplemented); -- not needed + + --------------- + -- From_TOML -- + --------------- + + overriding + function From_TOML (Unused_Key : String; + Unused_Value : TOML.TOML_Value) return State + is (raise Unimplemented); -- not needed + + ---------------- + -- Fulfilment -- + ---------------- + + function Fulfilment (This : State) return Fulfilments + is (This.Fulfilled.Fulfilment); + + ------------- + -- Hinting -- + ------------- + + function Hinting (Base : State) return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => (Fulfilment => Hinted), + Pinning => Base.Pinning, + Transitivity => Base.Transitivity); + + ----------- + -- Image -- + ----------- + + overriding function Image (This : State) return String + is (This.As_Dependency.Image + & " (" + & Utils.To_Lower_Case + (if This.Transitivity /= Unknown + then This.Transitivity'Img & "," + else "") + & Utils.To_Lower_Case (This.Fulfilled.Fulfilment'Img) + & (if This.Pinning.Pinned + then ",pin=" & This.Pinning.Version.Image + else "") + & ")"); + + -------- + -- Is -- + -------- + + function Is_Direct (This : State) return Boolean + is (This.Transitivity = Direct); + + function Is_Hinted (This : State) return Boolean + is (This.Fulfilled.Fulfilment = Hinted); + + function Is_Indirect (This : State) return Boolean + is (This.Transitivity = Indirect); + + function Is_Missing (This : State) return Boolean + is (This.Fulfilled.Fulfilment = Missed); + + function Is_Pinned (This : State) return Boolean + is (This.Pinning.Pinned); + + function Is_Solved (This : State) return Boolean + is (This.Fulfilled.Fulfilment = Solved); + + ------------- + -- Merging -- + ------------- + + function Merging (Base : State; + Versions : Semantic_Versioning.Extended.Version_Set) + return State + is (Dependencies.New_Dependency (Base.Crate, + Base.Versions and Versions) with + Name_Len => Base.Name_Len, + Fulfilled => Base.Fulfilled, + Pinning => Base.Pinning, + Transitivity => Base.Transitivity); + + ------------- + -- Missing -- + ------------- + + function Missing (Base : State) return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => (Fulfilment => Missed), + Pinning => Base.Pinning, + Transitivity => Base.Transitivity); + + -------------------- + -- New_Dependency -- + -------------------- + + overriding + function New_Dependency (Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return State + is (New_State (Dependencies.New_Dependency (Crate, Version))); + + -------------------- + -- New_Dependency -- + -------------------- + + overriding + function New_Dependency + (Crate : Crate_Name; + Versions : Semantic_Versioning.Extended.Version_Set) + return State + is (New_State (Dependencies.New_Dependency (Crate, Versions))); + + --------------- + -- New_State -- + --------------- + + function New_State (Base : Dependency) return State + is (State'(Base with + Name_Len => Base.Crate.Name'Length, + others => <>)); + + ----------------- + -- Pin_Version -- + ----------------- + + function Pin_Version (This : State) return Semantic_Versioning.Version + is (This.Pinning.Version); + + ------------- + -- Pinning -- + ------------- + + function Pinning (Base : State; + Version : Semantic_Versioning.Version) + return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => Base.Fulfilled, + Pinning => (Pinned => True, + Version => Version), + Transitivity => Base.Transitivity); + + ------------- + -- Release -- + ------------- + + function Release (This : State) return Releases.Release + is (This.Fulfilled.Release.Element); + + ------------- + -- Setting -- + ------------- + + function Setting (Base : State; + Transitivity : Transitivities) + return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => Base.Fulfilled, + Pinning => Base.Pinning, + Transitivity => Transitivity); + + ------------- + -- Solving -- + ------------- + + function Solving (Base : State; + Using : Releases.Release) + return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => (Fulfilment => Solved, + Release => Containers.Release_Holders + .To_Holder (Using)), + Pinning => Base.Pinning, + Transitivity => Base.Transitivity); + + ------------------ + -- Transitivity -- + ------------------ + + function Transitivity (This : State) return Transitivities + is (This.Transitivity); + + --------------- + -- TTY_Image -- + --------------- + + overriding function TTY_Image (This : State) return String + is (This.As_Dependency.TTY_Image + & " (" + & Utils.To_Lower_Case + (if This.Transitivity /= Unknown + 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) + & (if This.Pinning.Pinned + then "," & TTY.Emph ("pin") + & "=" & TTY.Version (This.Pinning.Version.Image) + else "") + & ")"); + + --------------- + -- Unpinning -- + --------------- + + function Unpinning (Base : State) return State + is (Base.As_Dependency with + Name_Len => Base.Name_Len, + Fulfilled => Base.Fulfilled, + Pinning => (Pinned => False), + Transitivity => Base.Transitivity); + +end Alire.Dependencies.States; diff --git a/src/alire/alire-dependencies.ads b/src/alire/alire-dependencies.ads index 34e40d58..ee4cd09d 100644 --- a/src/alire/alire-dependencies.ads +++ b/src/alire/alire-dependencies.ads @@ -63,9 +63,6 @@ package Alire.Dependencies with Preelaborate is overriding function To_YAML (Dep : Dependency) return String; - function Unavailable return Dependency; - -- Special never available dependency to beautify a bit textual outputs - private package TTY renames Utils.TTY; @@ -76,7 +73,7 @@ private and Interfaces.Tomifiable and Interfaces.Yamlable with record - Crate : Crate_Name (1 .. Name_Len); + Crate : Crate_Name (Name_Len); Versions : Semantic_Versioning.Extended.Version_Set; end record; @@ -84,7 +81,7 @@ private (Crate : Crate_Name; Versions : Semantic_Versioning.Extended.Version_Set) return Dependency - is (Crate'Length, Crate, Versions); + is (Crate.Name'Length, Crate, Versions); function New_Dependency (Crate : Crate_Name; @@ -106,31 +103,18 @@ private (New_Dependency (Allowed.Crate, Allowed.Versions)); function Image (Dep : Dependency) return String is - (if Dep = Unavailable - then "Unavailable" - else (+Dep.Crate) & Dep.Versions.Image); + ((+Dep.Crate) & Dep.Versions.Image); overriding function TTY_Image (Dep : Dependency) return String is - (if Dep = Unavailable - then - TTY.Version ("Unavailable") - else - (TTY.Name (+Dep.Crate) & TTY.Version (Dep.Versions.Image))); + (TTY.Name (+Dep.Crate) & TTY.Version (Dep.Versions.Image)); overriding function To_YAML (Dep : Dependency) return String is - (if Dep = Unavailable - then "{}" - else - ("{crate: """ & Utils.To_Lower_Case (+Dep.Crate) & - """, version: """ & Dep.Versions.Image & - """}")); + ("{crate: """ & Utils.To_Lower_Case (+Dep.Crate) & + """, version: """ & Dep.Versions.Image & + """}"); overriding function Key (Dep : Dependency) return String is (+Dep.Crate); - function Unavailable return Dependency - is (New_Dependency ("alire", - Semantic_Versioning.Extended.Value ("0"))); - end Alire.Dependencies; diff --git a/src/alire/alire-externals-unindexed.adb b/src/alire/alire-externals-unindexed.adb index 8e93be4a..0bda2bd8 100644 --- a/src/alire/alire-externals-unindexed.adb +++ b/src/alire/alire-externals-unindexed.adb @@ -13,7 +13,7 @@ package body Alire.Externals.Unindexed is is Result : Utils.String_Vector; begin - for Hint of Lists.To_List (This).Hints ("unused_name") loop + for Hint of Lists.To_List (This).Hints (+"unused_name") loop Result.Append (Hint); end loop; diff --git a/src/alire/alire-index_on_disk.adb b/src/alire/alire-index_on_disk.adb index 1129ea73..f8def774 100644 --- a/src/alire/alire-index_on_disk.adb +++ b/src/alire/alire-index_on_disk.adb @@ -183,7 +183,7 @@ package body Alire.Index_On_Disk is begin if not Is_Valid_Name (Name) then - Result := Outcome_Failure (Error_In_Name); + Result := Outcome_Failure (Error_In_Name (Name)); return New_Invalid_Index; end if; diff --git a/src/alire/alire-lockfiles.adb b/src/alire/alire-lockfiles.adb index 7022f295..948d10b7 100644 --- a/src/alire/alire-lockfiles.adb +++ b/src/alire/alire-lockfiles.adb @@ -49,12 +49,13 @@ package body Alire.Lockfiles is Environment : Properties.Vector; Filename : Any_Path) is + pragma Unreferenced (Environment); use Ada.Text_IO; File : File_Type; begin Trace.Debug ("Dumping solution to " & Filename); Create (File, Out_File, Filename); - TOML.File_IO.Dump_To_File (Solution.To_TOML (Environment), File); + TOML.File_IO.Dump_To_File (Solution.To_TOML, File); Close (File); exception when others => diff --git a/src/alire/alire-milestones.ads b/src/alire/alire-milestones.ads index b026e7b1..9ed0bdbb 100644 --- a/src/alire/alire-milestones.ads +++ b/src/alire/alire-milestones.ads @@ -27,22 +27,38 @@ package Alire.Milestones with Preelaborate is -- Milestone parsing -- ----------------------- - type Allowed_Milestones (Len : Positive) is record - Crate : Alire.Crate_Name (1 .. Len); - Versions : Semantic_Versioning.Extended.Version_Set; - end record; + type Allowed_Milestones (<>) is tagged private; function Crate_Versions (Spec : String) return Allowed_Milestones; -- Either valid set or Constraint_Error -- If no version was specified, Any version is returned -- Syntax: name[extended version set expression] + function Crate (This : Allowed_Milestones) return Crate_Name; + function Versions (This : Allowed_Milestones) + return Semantic_Versioning.Extended.Version_Set; + + function Image (This : Allowed_Milestones) return String; + function TTY_Image (This : Allowed_Milestones) return String; + private + type Allowed_Milestones (Len : Positive) is tagged record + Crate : Alire.Crate_Name (Len); + Versions : Semantic_Versioning.Extended.Version_Set; + end record; + + function Crate (This : Allowed_Milestones) return Crate_Name + is (This.Crate); + + function Versions (This : Allowed_Milestones) + return Semantic_Versioning.Extended.Version_Set + is (This.Versions); + package TTY renames Utils.TTY; type Milestone (Name_Len : Natural) is new Interfaces.Colorable with record - Name : Crate_Name (1 .. Name_Len); + Name : Crate_Name (Name_Len); Version : Semantic_Versioning.Version; end record; @@ -56,7 +72,7 @@ private function New_Milestone (Name : Crate_Name; Version : Semantic_Versioning.Version) return Milestone - is (Name'Length, Name, Version); + is (Name.Length, Name, Version); function Crate (M : Milestone) return Crate_Name is (M.Name); @@ -74,4 +90,10 @@ private & "=" & TTY.Version (Image (M.Version))); + function Image (This : Allowed_Milestones) return String + is ((+This.Crate) & This.Versions.Image); + + function TTY_Image (This : Allowed_Milestones) return String + is (TTY.Name (This.Crate) & TTY.Version (This.Versions.Image)); + end Alire.Milestones; diff --git a/src/alire/alire-pinning.adb b/src/alire/alire-pinning.adb index 07ea4d5b..a4fd6bee 100644 --- a/src/alire/alire-pinning.adb +++ b/src/alire/alire-pinning.adb @@ -24,12 +24,12 @@ package body Alire.Pinning is (Conditional.New_Dependency (Crate, Version) and Dependencies, Environment, - Solution.Changing_Pin (Crate, Pinned => False)); + Solution.Unpinning (Crate)); begin -- If the solution is valid, we enable the pin for the given release if New_Solution.Valid then - return New_Solution.Changing_Pin (Crate, Pinned => True); + return New_Solution.Pinning (Crate, Version); else return New_Solution; end if; @@ -52,7 +52,7 @@ package body Alire.Pinning is return Solver.Resolve (Dependencies, Environment, - Solution.Changing_Pin (Crate, Pinned => False)); + Solution.Unpinning (Crate)); end Unpin; end Alire.Pinning; diff --git a/src/alire/alire-pinning.ads b/src/alire/alire-pinning.ads index 1bed38c9..1471d5d5 100644 --- a/src/alire/alire-pinning.ads +++ b/src/alire/alire-pinning.ads @@ -14,7 +14,7 @@ package Alire.Pinning is Environment : Properties.Vector; Solution : Solutions.Solution) return Solutions.Solution - with Pre => Solution.Releases.Contains (Crate); + with Pre => Solution.Depends_On (Crate); -- Compute a new solution after applying the pin to the given crate, that -- must exist in the solution. Root dependencies are given, and a previous -- solution with possibly more pins. The resulting solution may be invalid. @@ -24,8 +24,8 @@ package Alire.Pinning is Environment : Properties.Vector; Solution : Solutions.Solution) return Solutions.Solution - with Pre => Solution.Releases.Contains (Crate) and then - Solution.Releases.Element (Crate).Is_Pinned; + with Pre => Solution.Depends_On (Crate) and then + 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-releases.adb b/src/alire/alire-releases.adb index ba98d480..7286fb84 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -164,8 +164,8 @@ package body Alire.Releases is begin return Replacement : constant Release - (Base.Name'Length, New_Notes'Length) := - (Prj_Len => Base.Name'Length, + (Base.Name.Length, New_Notes'Length) := + (Prj_Len => Base.Name.Length, Notes_Len => New_Notes'Length, Name => Base.Name, Notes => New_Notes, @@ -176,9 +176,7 @@ package body Alire.Releases is Dependencies => Base.Dependencies, Forbidden => Base.Forbidden, Properties => Base.Properties, - Available => Base.Available, - - Pinned => Base.Pinned) + Available => Base.Available) do null; end return; @@ -222,7 +220,7 @@ package body Alire.Releases is Properties : Conditional.Properties; Available : Alire.Requisites.Tree) return Release - is (Prj_Len => Name'Length, + is (Prj_Len => Name.Length, Notes_Len => Notes'Length, Name => Name, Alias => +"", @@ -232,9 +230,7 @@ package body Alire.Releases is Dependencies => Dependencies, Forbidden => Conditional.For_Dependencies.Empty, Properties => Properties, - Available => Available, - - Pinned => <>); + Available => Available); ------------------------- -- New_Working_Release -- @@ -248,7 +244,7 @@ package body Alire.Releases is Properties : Conditional.Properties := Conditional.For_Properties.Empty) return Release is - (Prj_Len => Name'Length, + (Prj_Len => Name.Length, Notes_Len => 0, Name => Name, Alias => +"", @@ -260,8 +256,7 @@ package body Alire.Releases is Properties => (if Properties = Conditional.For_Properties.Empty then Default_Properties else Properties), - Available => Requisites.Booleans.Always_True, - Pinned => False); + Available => Requisites.Booleans.Always_True); function On_Platform_Actions (R : Release; P : Alire.Properties.Vector; @@ -527,16 +522,9 @@ package body Alire.Releases is From : TOML_Adapters.Key_Queue) return Outcome is - Value : TOML.TOML_Value; begin Trace.Debug ("Loading release " & This.Milestone.Image); - -- Internal attributes (pinning) - - if From.Pop (TOML_Keys.Pinned, Value) then - This.Pinned := Value.As_Boolean; - end if; - -- Origin declare @@ -651,12 +639,6 @@ package body Alire.Releases is Relinfo.Set (TOML_Keys.Available, R.Available.To_TOML); end if; - -- Other internal properties (should only show up in the lockfile): - - if R.Pinned then - Relinfo.Set (TOML_Keys.Pinned, TOML.Create_Boolean (True)); - end if; - -- Version release Root.Set (R.Version_Image, Relinfo); @@ -715,8 +697,7 @@ package body Alire.Releases is Properties => R.Properties.Evaluate (P), Available => (if R.Available.Check (P) then Requisites.Booleans.Always_True - else Requisites.Booleans.Always_False), - Pinned => R.Pinned); + else Requisites.Booleans.Always_False)); ---------------------- -- Long_Description -- @@ -735,35 +716,4 @@ package body Alire.Releases is end if; end Long_Description; - --------- - -- Pin -- - --------- - - procedure Pin (This : in out Release) is - begin - This.Pinned := True; - end Pin; - - ----------- - -- Unpin -- - ----------- - - procedure Unpin (This : in out Release) is - begin - This.Pinned := False; - end Unpin; - - -------------- - -- With_Pin -- - -------------- - - function With_Pin (Base : Release; - Pinned : Boolean) return Release - is - begin - return Result : Release := Base do - Result.Pinned := Pinned; - end return; - end With_Pin; - end Alire.Releases; diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index d1e4b7c6..48e9dd43 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -112,9 +112,6 @@ package Alire.Releases with Preelaborate is return Release; -- Add forbidden dependencies to a release - function With_Pin (Base : Release; - Pinned : Boolean) return Release; - function Whenever (R : Release; P : Properties.Vector) return Release; -- Materialize conditions in a Release once the whatever properties are -- known. At present dependencies, properties, and availability. @@ -140,9 +137,13 @@ package Alire.Releases with Preelaborate is -- The actual name to be used during dependency resolution (but nowhere -- else). - function Forbids (R : Release; - P : Alire.Properties.Vector) - return Conditional.Dependencies; + function Forbidden (R : Release) return Conditional.Dependencies; + -- Get all forbidden dependencies in platform-independen fashion + + function Forbidden (R : Release; + P : Alire.Properties.Vector) + return Conditional.Dependencies; + -- Get platform-specific forbidden dependencies function Notes (R : Release) return Description_String; -- Specific to release @@ -157,8 +158,6 @@ package Alire.Releases with Preelaborate is return Conditional.Dependencies; -- Retrieve only the dependencies that apply on platform P - function Is_Pinned (R : Release) return Boolean; - function Properties (R : Release) return Conditional.Properties; function Origin (R : Release) return Origins.Origin; @@ -249,11 +248,6 @@ package Alire.Releases with Preelaborate is procedure Print (R : Release); -- Dump info to console - -- In place modifiers - - procedure Pin (This : in out Release); - procedure Unpin (This : in out Release); - -- Search helpers function Property_Contains (R : Release; Str : String) return Boolean; @@ -302,7 +296,7 @@ private and Interfaces.Detomifiable and Interfaces.Yamlable with record - Name : Crate_Name (1 .. Prj_Len); + Name : Crate_Name (Prj_Len); Alias : UString; -- I finally gave up on constraints Version : Semantic_Versioning.Version; Origin : Origins.Origin; @@ -311,11 +305,6 @@ private Forbidden : Conditional.Dependencies; Properties : Conditional.Properties; Available : Requisites.Tree; - - -- Internal data not intended for direct user exposure - - Pinned : Boolean := False; - -- A pinned release is never automatically updated end record; use all type Conditional.Properties; @@ -355,9 +344,12 @@ private return Conditional.Dependencies is (R.Dependencies.Evaluate (P)); - function Forbids (R : Release; - P : Alire.Properties.Vector) - return Conditional.Dependencies + function Forbidden (R : Release) return Conditional.Dependencies + is (R.Forbidden); + + function Forbidden (R : Release; + P : Alire.Properties.Vector) + return Conditional.Dependencies is (R.Forbidden.Evaluate (P)); function Properties (R : Release) return Conditional.Properties @@ -382,9 +374,6 @@ private function TTY_Description (R : Release) return String is (Utils.TTY.Description (R.Description)); - function Is_Pinned (R : Release) return Boolean - is (R.Pinned); - function Milestone (R : Release) return Milestones.Milestone is (Milestones.New_Milestone (R.Name, R.Version)); diff --git a/src/alire/alire-solutions-diffs.adb b/src/alire/alire-solutions-diffs.adb index 1187cd76..4d10bf3e 100644 --- a/src/alire/alire-solutions-diffs.adb +++ b/src/alire/alire-solutions-diffs.adb @@ -4,6 +4,10 @@ with Alire.Utils.TTY; package body Alire.Solutions.Diffs is + -- TODO: with the new solution tracking of all dependencies status, this + -- type could be made much simpler, even not needing to preprocess the + -- solutions. To keep in mind for any future large refactoring needed here. + package TTY renames Utils.TTY; use type Semantic_Versioning.Version; @@ -34,17 +38,17 @@ package body Alire.Solutions.Diffs is function Make_Status (Crate : Crate_Name; Sol : Solution) return Crate_Status is begin - if not Sol.Valid then - return (Status => Unsolved); - - elsif Sol.Releases.Contains (Crate) then + if Sol.Releases.Contains (Crate) then return (Status => Needed, - Pinned => Sol.Releases (Crate).Is_Pinned, - Version => Sol.Releases (Crate).Version); + Pinned => Sol.State (Crate).Is_Pinned, + Version => Sol.State (Crate).Release.Version); elsif Sol.Hints.Contains (Crate) then return (Status => Hinted, - Versions => Sol.Hints (Crate).Versions); + Versions => Sol.Dependency (Crate).Versions); + + elsif Sol.Depends_On (Crate) then + return (Status => Unsolved); else return (Status => Unneeded); @@ -55,14 +59,14 @@ package body Alire.Solutions.Diffs is -- Get all involved crates, before and after Crates : constant Containers.Crate_Name_Sets.Set := - Former.Required or Latter.Required; + Former.Crates or Latter.Crates; begin return This : Diff do -- Solution validities - This.Former_Valid := Former.Valid; - This.Latter_Valid := Latter.Valid; + This.Former_Complete := Former.Is_Complete; + This.Latter_Complete := Latter.Is_Complete; -- Store changes for each crate @@ -119,7 +123,7 @@ package body Alire.Solutions.Diffs is ---------------------- function Contains_Changes (This : Diff) return Boolean is - (This.Former_Valid /= This.Latter_Valid or else + (This.Former_Complete /= This.Latter_Complete or else (for some Change of This.Changes => Change.Former /= Change.Latter)); ------------------------ @@ -167,10 +171,12 @@ package body Alire.Solutions.Diffs is Trace.Log ("", Level); - if not This.Latter_Valid then - Trace.Log (Prefix & "New solution is invalid.", Level); - elsif This.Latter_Valid and then not This.Former_Valid then - Trace.Log (Prefix & "New solution is valid.", Level); + if not This.Latter_Complete then + Trace.Log (Prefix & "New solution is " & TTY.Warn ("invalid."), + Level); + elsif This.Latter_Complete and then not This.Former_Complete then + Trace.Log (Prefix & "New solution is " & TTY.OK ("valid."), + Level); end if; -- Early exit if no changes diff --git a/src/alire/alire-solutions-diffs.ads b/src/alire/alire-solutions-diffs.ads index a3718016..7834bf90 100644 --- a/src/alire/alire-solutions-diffs.ads +++ b/src/alire/alire-solutions-diffs.ads @@ -65,8 +65,8 @@ private (Crate_Name, Crate_Changes); type Diff is tagged record - Former_Valid, - Latter_Valid : Boolean := False; + Former_Complete, + Latter_Complete : Boolean := False; -- Empty solutions but with different validity still count as changes. Changes : Change_Maps.Map; diff --git a/src/alire/alire-solutions.adb b/src/alire/alire-solutions.adb index 3167e308..62a328d2 100644 --- a/src/alire/alire-solutions.adb +++ b/src/alire/alire-solutions.adb @@ -1,3 +1,5 @@ +with Ada.Containers; + with Alire.Crates.With_Releases; with Alire.Dependencies.Graphs; with Alire.Index; @@ -13,6 +15,28 @@ package body Alire.Solutions is package TTY renames Utils.TTY; + use type Ada.Containers.Count_Type; + use type Semantic_Versioning.Version; + + ----------------------- + -- Dependencies_That -- + ----------------------- + + function Dependencies_That + (This : Solution; + Check : not null access function (Dep : Dependency_State) return Boolean) + return Dependency_Map + is + begin + return Map : Dependency_Map do + for Dep of This.Dependencies loop + if Check (Dep) then + Map.Insert (Dep.Crate, Dep.As_Dependency); + end if; + end loop; + end return; + end Dependencies_That; + ------------- -- Changes -- ------------- @@ -20,42 +44,217 @@ package body Alire.Solutions is function Changes (Former, Latter : Solution) return Diffs.Diff is (Diffs.Between (Former, Latter)); - ------------------ - -- Changing_Pin -- - ------------------ + ------------ + -- Crates -- + ------------ - function Changing_Pin (This : Solution; - Name : Crate_Name; - Pinned : Boolean) return Solution + function Crates (This : Solution) return Containers.Crate_Name_Sets.Set is + begin + return Set : Containers.Crate_Name_Sets.Set do + for Dep of This.Dependencies loop + Set.Include (Dep.Crate); + end loop; + end return; + end Crates; + + --------------- + -- Forbidden -- + --------------- + + function Forbidden (This : Solution; + Env : Properties.Vector) + return Dependency_Map is - -- This temporary works around a tampering check - New_Releases : constant Release_Map := - This.Releases.Including - (This.Releases (Name).With_Pin (Pinned)); begin - return This : Solution := Changing_Pin.This do - This.Releases := New_Releases; + return Map : Dependency_Map do + for Rel of This.Releases loop + for Dep of Rel.Forbidden (Env) loop + Map.Merge (Dep.Value); + end loop; + end loop; end return; - end Changing_Pin; + end Forbidden; + + ------------- + -- Forbids -- + ------------- + + function Forbids (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector) + return Boolean + -- First check stored releases' forbids against new release, then check new + -- release's forbids agains solution releases. + is ((for some Rel of This.Releases => + (for some Dep of Rel.Forbidden (Env) => + Release.Satisfies (Dep.Value)) + or else + (for some Dep of Release.Forbidden (Env) => + (for some Rel of This.Releases => Rel.Satisfies (Dep.Value))))); --------------- -- Including -- --------------- - function Including (This : Solution; - Release : Alire.Releases.Release) + function Including (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector; + Add_Dependency : Boolean := False) return Solution is begin - if This.Valid then - return Result : Solution := This do - Result.Releases.Include (Release.Name, Release); - end return; - else - return This; - end if; + return Result : Solution := This do + if Add_Dependency and then not This.Depends_On (Release.Name) then + Result := Result.Depending_On (Release.To_Dependency.Value); + end if; + + -- Mark dependency solved and store its release + + Result.Dependencies := + Result.Dependencies.Including + (Result.State (Release.Name).Solving (Release.Whenever (Env))); + -- TODO: remove this Whenever once dynamic expr can be exported + + -- Check that there's no conflict with current solution + + if Result.Forbids (Release, Env) then + -- The solver should take care, so this is an unexpected error + raise Program_Error with + "release " & Release.Milestone.TTY_Image + & " is forbidden by solution"; + end if; + + end return; end Including; + --------------- + -- Is_Better -- + --------------- + + function Is_Better (This, Than : Solution) return Boolean is + + type Comparison is (Better, Equivalent, Worse); + + ---------------------- + -- Compare_Versions -- + ---------------------- + + function Compare_Versions (This, Than : Solution) return Comparison is + begin + + -- Check releases in both only + + for Rel of This.Releases loop + if Than.Contains_Release (Rel.Name) then + if Than.Releases.Element (Rel.Name).Version < Rel.Version then + return Better; + elsif + Rel.Version < Than.Releases.Element (Rel.Name).Version + then + return Worse; + end if; + end if; + end loop; + + return Equivalent; + end Compare_Versions; + + ----------------------------- + -- Lexicographical_Compare -- + ----------------------------- + + function Lexicographical_Compare (This, Than : Solution) return Boolean + is + begin + for Crate of This.Crates.Union (Than.Crates) loop + if This.Depends_On (Crate) and then not Than.Depends_On (Crate) + then + return True; + elsif not This.Depends_On (Crate) and then Than.Depends_On (Crate) + then + return False; + end if; + end loop; + + return False; -- Identical + end Lexicographical_Compare; + + begin + + -- Prefer better compositions + + if This.Composition < Than.Composition then + return True; + elsif This.Composition > Than.Composition then + return False; + end if; + + -- Within complete solutions, prefer higher versions + + if This.Composition = Releases then + case Compare_Versions (This, Than) is + when Better => return True; + when Worse => return False; + when Equivalent => + case Compare_Versions (This => Than, Than => This) is + when Better => return False; + when Worse => return True; + when Equivalent => null; + end case; + end case; + + -- Disambiguate prefering a complete solution with less releases + + if This.Releases.Length < Than.Releases.Length then + return True; + elsif This.Releases.Length > Than.Releases.Length then + return False; + end if; + + -- At this point they must be identical; just in case keep comparing + + end if; + + -- Prefer more fulfilled releases when the solution is incomplete. + -- The rationale is that fewer solved releases will mean more unknown + -- missing indirect depdendencies. + + if This.Releases.Length > Than.Releases.Length then + return True; + elsif This.Releases.Length < Than.Releases.Length then + return False; + end if; + + -- Prefer more undetected hints; at least we know these dependencies + -- exist in some platforms and can be made available somehow. + + if This.Hints.Length > Than.Hints.Length then + return True; + elsif This.Hints.Length < Than.Hints.Length then + return False; + end if; + + -- Prefer fewer missing crates, although at this point who knows what + -- indirect dependencies we are missing through undetected/missing + -- dependencies. + + if This.Misses.Length < Than.Misses.Length then + return True; + elsif This.Misses.Length > Than.Misses.Length then + return False; + end if; + + -- Final disambiguation by any known versions in [partial] solutions + + case Compare_Versions (This, Than) is + when Better => return True; + when Worse => return False; + when Equivalent => return Lexicographical_Compare (This, Than); + -- Final way out is lexicographical ordering of crates, and first + -- one missing a crate in the other solution is worse. + end case; + end Is_Better; + ---------------------------------- -- Libgraph_Easy_Perl_Installed -- ---------------------------------- @@ -64,43 +263,44 @@ package body Alire.Solutions is is (OS_Lib.Subprocess.Locate_In_Path (Paths.Scripts_Graph_Easy) /= ""); -- Return whether libgraph_easy_perl_install is in path - ---------- - -- Pins -- - ---------- + ------------------ + -- New_Solution -- + ------------------ - function Pins (This : Solution) return Conditional.Dependencies is - use type Conditional.Dependencies; + function New_Solution + (Env : Properties.Vector := Properties.No_Properties; + Releases : Release_Map := Containers.Empty_Release_Map; + Direct : Dependency_Map := Containers.Empty_Dependency_Map) + return Solution + is begin - if not This.Valid then - return Conditional.No_Dependencies; - end if; + return This : Solution := (Solved => True, + others => <>) + do + for Rel of Releases loop + This := This.Including (Rel, Env, Add_Dependency => True); + end loop; - return Dependencies : Conditional.Dependencies do - for Release of This.Releases loop - if Release.Is_Pinned then - Dependencies := - Dependencies and - Conditional.New_Dependency (Release.Name, - Release.Version); - end if; + for Dep of Direct loop + This := This.Depending_On (Dep); + This.Set (Dep.Crate, Dependencies.States.Direct); end loop; end return; - end Pins; + end New_Solution; ---------- -- Pins -- ---------- - function Pins (This : Solution) return Release_Map is + function Pins (This : Solution) return Conditional.Dependencies is + use type Conditional.Dependencies; begin - if not This.Valid then - return Containers.Empty_Release_Map; - end if; - - return Map : Release_Map do - for Release of This.Releases loop - if Release.Is_Pinned then - Map.Insert (Release); + return Dependencies : Conditional.Dependencies do + for Dep of This.Dependencies loop + if Dep.Is_Pinned then + Dependencies := + Dependencies and + Conditional.New_Dependency (Dep.Crate, Dep.Versions); end if; end loop; end return; @@ -117,21 +317,23 @@ package body Alire.Solutions is Level : Trace.Levels) is begin - -- For invalid solutions be terse and gone + -- Outta here if nothing to print - if not This.Valid then + if not This.Solved then Trace.Log ("Dependencies (solution):", Level); - Trace.Log (" No solution", Level); + Trace.Log (" No solving attempted", Level); + return; + elsif This.Dependencies.Is_Empty then return; end if; - -- Continue for valid solutions + -- Print all releases first, followed by the rest of dependencies if not This.Releases.Is_Empty then Trace.Log ("Dependencies (solution):", Level); for Rel of This.Releases loop Trace.Log (" " & Rel.Milestone.TTY_Image - & (if Rel.Is_Pinned + & (if This.State (Rel.Name).Is_Pinned then TTY.Emph (" (pinned)") else "") & (if Detailed then @@ -143,42 +345,59 @@ package body Alire.Solutions is end loop; end if; - -- Show unresolved hints, with their hinting message + -- Show other dependencies with their status and hints - if not This.Hints.Is_Empty then + if This.Composition >= Mixed then Trace.Log ("Dependencies (external):", Level); - for Dep of This.Hints loop - 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 ensure the crate is indexed. - - if Index.Exists (Dep.Crate) then - for Hint of - Alire.Index.Crate (Dep.Crate) - .Externals.Hints - (Name => Dep.Crate, - Env => Alire.Properties.No_Properties) - loop - Trace.Log (TTY.Emph (" Hint: ") & Hint, Level); - end loop; + for Dep of This.Dependencies loop + if not This.State (Dep.Crate).Is_Solved then + Trace.Log (" " & Dep.As_Dependency.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 + -- ensure the crate is indexed. + + if Index.Exists (Dep.Crate) then + for Hint of + Alire.Index.Crate (Dep.Crate) + .Externals.Hints + (Name => Dep.Crate, + Env => Alire.Properties.No_Properties) + loop + Trace.Log (TTY.Emph (" Hint: ") & Hint, Level); + end loop; + end if; end if; end loop; end if; - if not (This.Releases.Is_Empty and then This.Hints.Is_Empty) - then + -- Show forbidden, if any + + if not This.Forbidden (Env).Is_Empty then + Trace.Log ("Dependencies (forbidden):", Level); + for Dep of This.Forbidden (Env) loop + Trace.Log (" " & Dep.TTY_Image, Level); + end loop; + end if; + + -- Textual and graphical dependency graph + + if not This.Dependencies.Is_Empty then Trace.Log ("Dependencies (graph):", Level); declare - Graph : constant Dependencies.Graphs.Graph := - Dependencies.Graphs.From_Solution (This, Env) - .Including (Root, Env); + With_Root : constant Solution := + This.Including (Root, Env, Add_Dependency => True); + Graph : constant Alire.Dependencies.Graphs.Graph := + Alire.Dependencies.Graphs + .From_Solution (With_Root, Env); begin - Graph.Print (This.Including (Root), Prefix => " "); + Graph.Print (With_Root, Prefix => " "); + + -- Optional graphical if possible. TODO: remove this warning once + -- show once. if Libgraph_Easy_Perl_Installed then - Graph.Plot (This.Including (Root)); + Graph.Plot (With_Root); else Trace.Log ("Cannot display graphical graph: " & Paths.Scripts_Graph_Easy & " not in path" & @@ -189,6 +408,34 @@ package body Alire.Solutions is end if; end Print; + ----------------- + -- Print_Hints -- + ----------------- + + procedure Print_Hints (This : Solution; + Env : Properties.Vector) is + begin + if not This.Hints.Is_Empty then + + Trace.Warning + ("The following external dependencies " + & "are unavailable within Alire:"); + + for Dep of This.Hints loop + Trace.Warning (" " & Dep.Image); + + for Hint of Index.Crate (Dep.Crate) + .Externals.Hints (Dep.Crate, Env) + loop + Trace.Warning (" Hint: " & Hint); + end loop; + end loop; + + Trace.Warning + ("They should be made available in the environment by the user."); + end if; + end Print_Hints; + ---------------- -- Print_Pins -- ---------------- @@ -196,16 +443,14 @@ package body Alire.Solutions is procedure Print_Pins (This : Solution) is Table : Utils.Tables.Table; begin - if not This.Valid then - Trace.Always ("There is no solution, hence there are no pins"); - elsif not (for some Release of This.Releases => Release.Is_Pinned) then + if This.Dependencies_That (States.Is_Pinned'Access).Is_Empty then Trace.Always ("There are no pins"); else - for Release of This.Releases loop - if Release.Is_Pinned then + for Dep of This.Dependencies loop + if Dep.Is_Pinned then Table - .Append (Release.TTY_Name) - .Append (TTY.Version (Release.Version.Image)) + .Append (TTY.Name (Dep.Crate)) + .Append (TTY.Version (Dep.Pin_Version.Image)) .New_Row; end if; end loop; @@ -215,27 +460,33 @@ package body Alire.Solutions is end Print_Pins; -------------- - -- Required -- + -- Releases -- -------------- - function Required (This : Solution) return Containers.Crate_Name_Sets.Set is + function Releases (This : Solution) return Release_Map is begin - if not This.Valid then - return Containers.Crate_Name_Sets.Empty_Set; - end if; - - -- Merge release and hint crates - - return Set : Containers.Crate_Name_Sets.Set do - for Dep of This.Hints loop - Set.Include (Dep.Crate); - end loop; - - for Rel of This.Releases loop - Set.Include (Rel.Name); + return Result : Release_Map do + for Dep of This.Dependencies loop + if Dep.Is_Solved then + Result.Insert (Dep.Crate, Dep.Release); + end if; end loop; end return; - end Required; + end Releases; + + --------- + -- Set -- + --------- + + procedure Set (This : in out Solution; + Crate : Crate_Name; + Transitivity : Dependencies.States.Transitivities) + is + begin + This.Dependencies := + This.Dependencies.Including + (This.State (Crate).Setting (Transitivity)); + end Set; --------------- -- With_Pins -- @@ -244,13 +495,9 @@ package body Alire.Solutions is function With_Pins (This, Src : Solution) return Solution is begin return Result : Solution := This do - if not Src.Valid then - return; - end if; - - for Release of Src.Releases loop - if Release.Is_Pinned then - Result.Releases.Reference (Release.Name).Pin; + for Dep of Src.Dependencies loop + if Dep.Is_Pinned then + Result.Dependencies.Include (Dep.Crate, Dep); end if; end loop; end return; @@ -264,160 +511,62 @@ package body Alire.Solutions is -- TOML keys used locally for loading and saving of solutions - Advisory : constant String := "advisory"; - Context : constant String := "context"; - Dependencies : constant String := "dependency"; - Externals : constant String := "externals"; - Valid : constant String := "valid"; + Advisory : constant String := "advisory"; + Context : constant String := "context"; + Solved : constant String := "solved"; + State : constant String := "state"; end Keys; - --------------- - -- From_TOML -- - --------------- + use TOML; - function From_TOML (From : TOML_Adapters.Key_Queue) - return Solution - is - -- We are parsing an internally generated structure, so any errors in it - -- are unexpected. - begin - Trace.Debug ("Reading solution from TOML..."); - if From.Unwrap.Get (Keys.Context).Get (Keys.Valid).As_Boolean then - return This : Solution (Valid => True) do - Assert (From_TOML (This, From)); - end return; - else - Trace.Debug ("Read invalid solution from TOML"); - return (Valid => False); - end if; - end From_TOML; + -- The structure used to store a solution is: + -- + -- [context] + -- advisory + -- solved = boolean + -- version # TBD: for breaking changes + -- + -- [[state]] + -- One per dependency in Solution.Dependencies --------------- -- From_TOML -- --------------- - overriding - function From_TOML (This : in out Solution; - From : TOML_Adapters.Key_Queue) - return Outcome - is - use TOML; - - ------------------ - -- Read_Release -- - ------------------ - -- Load a single release. From points to the crate name, which contains - -- crate.general and crate.version tables. - function Read_Release (From : TOML_Value) return Alire.Releases.Release - is - Name : constant String := +From.Keys (1); - Crate : Crates.With_Releases.Crate := - Crates.With_Releases.New_Crate (+Name); - - -- We can proceed loading the crate normally - OK : constant Outcome := - Crate.From_TOML - (From_TOML.From.Descend - (Value => From.Get (Name), - Context => "crate")); - begin + function From_TOML (From : TOML_Adapters.Key_Queue) return Solution is - -- Double checks - - if From.Keys'Length /= 1 then - From_TOML.From.Checked_Error ("too many keys in stored crate"); - end if; - - OK.Assert; - - if Crate.Releases.Length not in 1 then - From_TOML.From.Checked_Error - ("expected a single release, but found" - & Crate.Releases.Length'Img); - end if; - - return Crate.Releases.First_Element; - end Read_Release; + This : Solution; begin - if not From.Unwrap.Get (Keys.Context).Get (Keys.Valid).As_Boolean then - From.Checked_Error ("cannot load invalid solution"); - end if; - - Trace.Debug ("Reading valid solution from TOML..."); + Trace.Debug ("Reading solution from TOML..."); - -- Load proper releases, stored as a crate with a single release + -- Context - declare - Releases : TOML_Value; - Has_Releases : constant Boolean := - From.Pop (Keys.Dependencies, Releases); - begin - if Has_Releases then -- must be an array - for I in 1 .. Releases.Length loop - This.Releases.Insert (Read_Release (Releases.Item (I))); - end loop; - end if; - end; + This.Solved := From.Checked_Pop (Keys.Context, TOML_Table) -- [context] + .Get (Keys.Solved).As_Boolean; -- solved - -- Load external dependencies + -- Load dependency statuses + if From.Unwrap.Has (Keys.State) then + This.Dependencies := + States.Maps.From_TOML + (From.Descend + (From.Checked_Pop (Keys.State, TOML_Array), + "states")); + end if; - declare - Externals : TOML_Value; - Has_Externals : constant Boolean := - From.Pop (Keys.Externals, Externals); - begin - if Has_Externals then -- It's a table containing dependencies - for I in 1 .. Externals.Keys'Length loop - This.Hints.Merge - (Dependencies.From_TOML - (Key => +Externals.Keys (I), - Value => Externals.Get (Externals.Keys (I)))); - end loop; - end if; - end; + From.Report_Extra_Keys; - return Outcome_Success; + return This; end From_TOML; ------------- -- To_TOML -- ------------- - function To_TOML (This : Solution; - Props : Properties.Vector) return TOML.TOML_Value - is - Static_Solution : Solution := This; - begin - if This.Valid then - Static_Solution.Releases := This.Releases.Whenever (Props); - end if; - - return To_TOML (Static_Solution); - end To_TOML; - - ------------- - -- To_TOML -- - ------------- - overriding function To_TOML (This : Solution) return TOML.TOML_Value is - use TOML; begin - - -- The structure used to store a solution is: - -- - -- [context] - -- Validity, advisory - -- - -- [[dependency.crate_name.version]] - -- Dependency release description - -- - -- [externals] - -- crate_name = "version set" - -- ... - return Root : constant TOML_Value := Create_Table do -- Output advisory and validity @@ -426,50 +575,19 @@ package body Alire.Solutions is Context : constant TOML_Value := Create_Table; begin Root.Set (Keys.Context, Context); + Context.Set (Keys.Advisory, Create_String ("THIS IS AN AUTOGENERATED FILE. DO NOT EDIT MANUALLY")); - Context.Set (Keys.Valid, Create_Boolean (This.Valid)); - end; - - -- Early exit when the solution is invalid - if not This.Valid then - return; - end if; - - -- Output proper releases (except detected externals, which will be - -- output as external hints) - - declare - Deps : constant TOML_Value := Create_Array (TOML_Table); - begin - for Dep of This.Releases loop - declare - Release : constant TOML_Value := Create_Table; - begin - Deps.Append (Release); - Release.Set (Dep.Name_Str, Dep.To_TOML); - end; - end loop; - - Root.Set (Keys.Dependencies, Deps); + Context.Set + (Keys.Solved, Create_Boolean (This.Solved)); end; - -- Output external releases - - declare - Externals : constant TOML_Value := Create_Table; - begin - if not This.Hints.Is_Empty then - for Dep of This.Hints loop - Externals.Set (+Dep.Crate, Dep.To_TOML); - end loop; + -- Output the dependency statuses - Root.Set (Keys.Externals, Externals); - end if; - end; + Root.Set (Keys.State, This.Dependencies.To_TOML); end return; end To_TOML; diff --git a/src/alire/alire-solutions.ads b/src/alire/alire-solutions.ads index e8dce767..fec6e54e 100644 --- a/src/alire/alire-solutions.ads +++ b/src/alire/alire-solutions.ads @@ -1,5 +1,6 @@ with Alire.Conditional; with Alire.Containers; +with Alire.Dependencies.States.Maps; with Alire.Interfaces; with Alire.Properties; with Alire.Releases; @@ -7,72 +8,227 @@ with Alire.TOML_Adapters; limited with Alire.Solutions.Diffs; +with Semantic_Versioning.Extended; + with TOML; package Alire.Solutions is - -- A solutions is a set of releases + externals that fulfills the - -- transitive dependencies of the root crate. + subtype Dependency_Map is Alire.Containers.Dependency_Map; + subtype Dependency_State is Dependencies.States.State; + subtype Name_Set is Containers.Crate_Name_Sets.Set; + subtype Release_Map is Alire.Containers.Release_Map; + subtype State_Map is Dependencies.States.Maps.Map; + + package States renames Dependencies.States; + + -- Note in the following enum type that the only complete solutions are + -- Releases and Empty. This enum is mostly useful to classify solutions in + -- order of "goodness". + + type Compositions is + (Empty, + -- 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. + + Mixed, + -- Releases + at least one undetected hint (i.e., build success is not + -- guaranteed). + + Hints, + -- Only undetected hints, no proper releases at all + + Partial, + -- There's at least one missing dependency, in the sense of not being + -- even an undetected hint. This means some unindexed crate is required, + -- or a version that does not exist, or a combination of dependencies + -- results in impossible (empty version intersection) version + -- requirements. + + Unsolved + -- Solving hasn't even been attempted (e.g., when retrieving with + -- --only), so the solution has no dependencies but is still invalid. + ); - subtype Dependency_Map is Alire.Containers.Dependency_Map; + type Solution is new Interfaces.Tomifiable with private; - subtype Release_Map is Alire.Containers.Release_Map; + -- A solution stores all dependencies required by some root crate. More + -- precisely, it stores the regular releases that fulfil some dependency + -- and the particular standing of a dependency (solved, hinted, missing...) + -- A solved dependency will be accompanied by the particular release that + -- fulfils it. - type Solution (Valid : Boolean) is - new Interfaces.Tomifiable - and Interfaces.Detomifiable with private; + ------------------ + -- Construction -- + ------------------ - Invalid_Solution : constant Solution; - Empty_Valid_Solution : constant Solution; + function Empty_Invalid_Solution return Solution; + -- An unsolved empty solution. This is the only way to obtain an unsolved + -- solution. Any solution that has dependencies or is modified in any way + -- is considered to having been attempted to be solved. + + function Empty_Valid_Solution return Solution; function New_Solution - (Releases : Release_Map := Containers.Empty_Release_Map; - Hints : Dependency_Map := Containers.Empty_Dependency_Map) - return Solution; - -- A new valid solution + (Env : Properties.Vector := Properties.No_Properties; + Releases : Release_Map := Containers.Empty_Release_Map; + Direct : Dependency_Map := Containers.Empty_Dependency_Map) + return Solution + with Pre => Releases.Is_Empty or else not Env.Is_Empty; + -- A new solution. Trivially, a Solution without dependencies is complete. + -- We can initialize it with solved releases and unsolved dependencies. In + -- both cases, these are marked as direct dependencies. The environment is + -- only needed when releases are given. + + function Depending_On (This : Solution; + Dep : Dependencies.Dependency) + return Solution; + -- Add or merge a dependency without changing its state. For a new + -- dependency, it will be marked as Missing and with Unknown transitivity. + + function Hinting (This : Solution; + Dep : Dependencies.Dependency) + return Solution; + -- Add/merge dependency as hinted in solution + + function Including (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector; + Add_Dependency : Boolean := False) + return Solution + with Pre => Add_Dependency or else This.Depends_On (Release.Name); + -- Add a release to the solution, marking its dependency as solved. Takes + -- care of adding forbidden dependencies and ensuring the Release does not + -- conflict with current solution (which would result in a Checked_Error). + -- Since from the release we can't know the actual complete dependency the + -- release is fulfilling, by default we don't create its dependency (it + -- must exist previously). + + function Missing (This : Solution; + Dep : Dependencies.Dependency) + return Solution; + -- Add/merge dependency as missing in solution + + function Pinning (This : Solution; + Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return Solution; + -- 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 Unpinning (This : Solution; + Crate : Crate_Name) + return Solution; + -- Unpin a crate. If the crate was not pinned or not in the solution + -- nothing will be done. - function Releases (This : Solution) return Release_Map with - Pre => This.Valid; - -- Returns the regular releases that conform a solution + function With_Pins (This, Src : Solution) return Solution; + -- Copy pins from Src to This and return it - function Hints (This : Solution) return Dependency_Map with - Pre => This.Valid; - -- Returns dependencies that will have to be fulfilled externally. These - -- correspond to undetected externals; a detected external results in a - -- regular release and should require no user action. + ---------------- + -- Attributes -- + ---------------- function Changes (Former, Latter : Solution) return Diffs.Diff; - function Required (This : Solution) return Containers.Crate_Name_Sets.Set; - -- Retrieve all required crates in the solution, no matter if they have - -- known releases or only hints. Will return an empty set for invalid - -- solutions. TODO: when we track reasons for solving failure, return - -- the required crates with their reason for non-solvability. - - function Changing_Pin (This : Solution; - Name : Crate_Name; - Pinned : Boolean) return Solution - with Pre => - This.Valid or else - raise Checked_Error with "Cannot change pins in invalid solution"; - -- Return a copy of the solution with the new pinning status of Name - - function Including (This : Solution; - Release : Alire.Releases.Release) - return Solution; - -- Add a release to the solution, without doing anything with its - -- dependencies. If not This.Valid, result will also be invalid. + function Composition (This : Solution) return Compositions; - function Pins (This : Solution) return Conditional.Dependencies; - -- Return all pinned releases as exact version dependencies. Will return an - -- empty list for invalid solutions. + function Contains_Release (This : Solution; + Crate : Crate_Name) return Boolean; + -- Say if Crate is among the solved releases for this solution. It will + -- return False if the solution does not even depend on Crate. - function Pins (This : Solution) return Release_Map; - -- Return all pinned release. Will return an empty map for invalid - -- solutions. + function Crates (This : Solution) return Name_Set; + -- Dependency name closure, independent of the status in the solution, as + -- found by the solver starting from the direct dependencies. - function With_Pins (This, Src : Solution) return Solution; - -- Copy pins from Src to This + function Dependencies_That + (This : Solution; + Check : not null access function (Dep : Dependency_State) return Boolean) + return Dependency_Map; + -- Retrieve all states that pass a boolean check + + function Dependency (This : Solution; + Crate : Crate_Name) + return Dependencies.Dependency + with Pre => This.Depends_On (Crate); + -- Return the specific dependency versions as currently stored + + function Depends_On (This : Solution; + Name : Crate_Name) return Boolean; + -- Says if the solution depends on the crate in some way + + function Forbidden (This : Solution; + Env : Properties.Vector) + return Dependency_Map; + -- Returns all forbidden dependencies by releases in solution + + function Forbids (This : Solution; + Release : Alire.Releases.Release; + Env : Properties.Vector) + return Boolean; + -- Check whether the solution forbids a release + + function Hints (This : Solution) return Dependency_Map; + -- Return undetected externals in the solution + + function Is_Better (This, Than : Solution) return Boolean; + -- Relative ordering to prioritize found solutions. We prefer decreasing + -- order of Composition (avoid undetected externals/missing dependencies). + + function Is_Complete (This : Solution) return Boolean; + -- A solution is complete when it fulfills all dependencies via regular + -- releases, detected externals, or linked directories. + + function Misses (This : Solution) return Dependency_Map; + -- Return crates for which there is neither hint nor proper versions + + function Pins (This : Solution) return Conditional.Dependencies; + -- Return all pinned dependencies as a dependency tree containing exact + -- versions. + + function Pins (This : Solution) return Dependency_Map; + -- return all pinned dependencies as plain dependencies for a exact version + + function Releases (This : Solution) return Release_Map; + -- Returns the proper releases in the solution (regular and detected) + + function Required (This : Solution) return State_Map'Class; + -- Returns all dependencies required to fulfill this solution, + -- independently of their solving state. + + function State (This : Solution; + Crate : Crate_Name) + return Dependency_State + with Pre => This.Depends_On (Crate); + -- Returns the solving state of a dependency in the solution + + function Valid (This : Solution) return Boolean + is (This.Composition <= Hints); + -- Transitional function to limit changes in this patch (Valid was + -- previously a discriminant of Solution). A follow-up patch removes + -- the use of validity all around when it's not strictly necessary. We + -- currently consider hints to result in a valid solution, although this + -- is not a guarantee of buildability. The follow-up makes this distinction + -- moot (the user is better informed about what is available, externally + -- needed, or outright missing. TODO: deprecate this function in favor of + -- Is_Complete. + + -------------- + -- Mutation -- + -------------- + + procedure Set (This : in out Solution; + Crate : Crate_Name; + Transitivity : States.Transitivities) + with Pre => This.Depends_On (Crate); + + --------- + -- I/O -- + --------- procedure Print (This : Solution; Root : Alire.Releases.Release; @@ -83,73 +239,207 @@ package Alire.Solutions is -- crate not in solution that introduces the direct dependencies. When -- Detailed, extra information about origins is shown. + procedure Print_Hints (This : Solution; + Env : Properties.Vector); + -- Display hints about any undetected externals in the solutions + procedure Print_Pins (This : Solution); -- Dump a table with pins in this solution - -- TOML-related subprograms + ----------------- + -- Persistence -- + ----------------- function From_TOML (From : TOML_Adapters.Key_Queue) return Solution; - -- Since Solution is unconstrained this allows loading of both - -- valid/invalid solutions. - - overriding - function From_TOML (This : in out Solution; - From : TOML_Adapters.Key_Queue) - return Outcome - with Pre => This.Valid, - Post => From_TOML'Result.Success; - -- As this function is used to load Alire-generated files, the only - -- possible outcome when properly used is Success. Any unexpected - -- situation will result in uncaught exception. - - function To_TOML (This : Solution; - Props : Properties.Vector) return TOML.TOML_Value; - -- Stores a solution as a TOML file. Since dynamic expression export is - -- unimplemented yet, we use the given properties to localize to current - -- platform. TODO: export cases (this is the same limitation that exists - -- for the regular export of crate.toml) overriding function To_TOML (This : Solution) return TOML.TOML_Value with - Pre => not This.Valid or else - (for all Release of This.Releases => + Pre => (for all Release of This.Releases => Release.Dependencies.Is_Unconditional and then Release.Properties.Is_Unconditional); - -- As previous one, but requires releases not to have dynamic expressions + -- Requires releases not to have dynamic expressions. This is currently + -- guaranteed by the states storing static versions of releases. private - type Solution (Valid : Boolean) is - new Interfaces.Tomifiable - and Interfaces.Detomifiable with record - case Valid is - when True => - Releases : Release_Map; - -- Resolved dependencies to be deployed - - Hints : Dependency_Map; - -- Unresolved external dependencies - when False => - null; - end case; - end record; + type Solution is new Interfaces.Tomifiable with record + Dependencies : State_Map; - Invalid_Solution : constant Solution := (Valid => False); - Empty_Valid_Solution : constant Solution := (Valid => True, others => <>); + Solved : Boolean := False; + -- Has solving been attempted? + end record; - function New_Solution - (Releases : Release_Map := Containers.Empty_Release_Map; - Hints : Dependency_Map := Containers.Empty_Dependency_Map) - return Solution - is (Solution'(Valid => True, - Releases => Releases, - Hints => Hints)); + -- Begin of implementation + + ----------------- + -- Composition -- + ----------------- + + function Composition (This : Solution) return Compositions + is (if not This.Solved then + Unsolved + elsif This.Dependencies.Is_Empty then + Empty + elsif (for all Dep of This.Dependencies => Dep.Is_Solved) then + Releases + elsif (for all Dep of This.Dependencies => Dep.Is_Hinted) then + Hints + elsif (for some Dep of This.Dependencies => Dep.Is_Missing) then + Partial + else + Mixed); + + ---------------------- + -- Contains_Release -- + ---------------------- + + function Contains_Release (This : Solution; + Crate : Crate_Name) return Boolean + is (This.Depends_On (Crate) and then This.State (Crate).Is_Solved); + + ---------------- + -- Dependency -- + ---------------- + + function Dependency (This : Solution; + Crate : Crate_Name) + return Alire.Dependencies.Dependency + is (This.Dependencies (Crate).As_Dependency); + + ------------------ + -- Depending_On -- + ------------------ + + function Depending_On (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (Solution'(Solved => True, + Dependencies => This.Dependencies.Merging (Dep))); + + ---------------- + -- Depends_On -- + ---------------- + + function Depends_On (This : Solution; + Name : Crate_Name) return Boolean + is (This.Dependencies.Contains (Name)); + + ---------------------------- + -- Empty_Invalid_Solution -- + ---------------------------- + + function Empty_Invalid_Solution return Solution + is (Solved => False, + others => <>); + + -------------------------- + -- Empty_Valid_Solution -- + -------------------------- + + function Empty_Valid_Solution return Solution + is (Solved => True, + others => <>); + + ------------- + -- Hinting -- + ------------- + + function Hinting (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (if This.Depends_On (Dep.Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including (This.State (Dep.Crate).Hinting)) + else (Solved => True, + Dependencies => + This.Dependencies.Including (States.New_State (Dep).Hinting))); + + ----------- + -- Hints -- + ----------- function Hints (This : Solution) return Dependency_Map - is (This.Hints); - - function Releases (This : Solution) return Release_Map - is (This.Releases); + is (This.Dependencies_That (States.Is_Hinted'Access)); + + ----------------- + -- Is_Complete -- + ----------------- + + function Is_Complete (This : Solution) return Boolean + is (for all Dep of This.Dependencies => Dep.Is_Solved); + + ------------ + -- Misses -- + ------------ + + function Misses (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Missing'Access)); + + ------------- + -- Missing -- + ------------- + + function Missing (This : Solution; + Dep : Dependencies.Dependency) + return Solution + is (if This.Depends_On (Dep.Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including (This.State (Dep.Crate).Missing)) + else (Solved => True, + Dependencies => + This.Dependencies.Including (States.New_State (Dep).Missing))); + + ------------- + -- Pinning -- + ------------- + + function Pinning (This : Solution; + Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return Solution + is (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Pinning (Version))); + + ---------- + -- Pins -- + ---------- + + function Pins (This : Solution) return Dependency_Map + is (This.Dependencies_That (States.Is_Pinned'Access)); + + -------------- + -- Required -- + -------------- + + function Required (This : Solution) return State_Map'Class + is (This.Dependencies); + + ----------- + -- State -- + ----------- + + function State (This : Solution; + Crate : Crate_Name) + return Dependency_State + is (This.Dependencies (Crate)); + + --------------- + -- Unpinning -- + --------------- + + function Unpinning (This : Solution; + Crate : Crate_Name) + return Solution + is (if This.Dependencies.Contains (Crate) + then (Solved => True, + Dependencies => + This.Dependencies.Including + (This.Dependencies (Crate).Unpinning)) + else This); end Alire.Solutions; diff --git a/src/alire/alire-solver.adb b/src/alire/alire-solver.adb index 1d4e7f22..9bf9063c 100644 --- a/src/alire/alire-solver.adb +++ b/src/alire/alire-solver.adb @@ -1,58 +1,25 @@ with Ada.Containers; use Ada.Containers; -with Ada.Containers.Indefinite_Doubly_Linked_Lists; +with Ada.Containers.Indefinite_Ordered_Sets; -with Alire.Conditional.Operations; +with Alire.Conditional; with Alire.Containers; -with Alire.Dependencies; +with Alire.Dependencies.States; with Alire.Milestones; with Alire.Origins.Deployers; -with Alire.Utils; +with Alire.Utils.TTY; package body Alire.Solver is - package Solution_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists - (Solution, Solutions."="); - package Semver renames Semantic_Versioning; + package TTY renames Utils.TTY; + use all type Dependencies.States.Transitivities; use all type Semver.Extended.Version_Set; - subtype Dependency_Map is Solutions.Dependency_Map; - - subtype Release_Map is Alire.Containers.Release_Map; - -- Releases with a concrete version (source and detected external releases) - - Empty_Deps : constant Dependency_Map := - (Alire.Containers.Dependency_Maps.Empty_Map with - null record); - - Empty_Map : constant Release_Map := - (Alire.Containers.Crate_Release_Maps.Empty_Map with - null record); - - function "&" (L : Dependency_Map; - R : Dependencies.Dependency) - return Dependency_Map - is - begin - return This : Dependency_Map := L do - This.Merge (R); - end return; - end "&"; - - ---------------------- - -- Dependency_Image -- - ---------------------- - - function Dependency_Image - (Name : Alire.Crate_Name; - Versions : Semantic_Versioning.Extended.Version_Set; - Policy : Age_Policies := Newest) - return String - is ((+Name) & - (if Versions /= Semver.Extended.Any - then " version " & Versions.Image - else " with " & Utils.To_Mixed_Case (Policy'Img) & " version")); + package Solution_Sets is new Ada.Containers.Indefinite_Ordered_Sets + (Element_Type => Solution, + "<" => Solutions.Is_Better, + "=" => Solutions."="); ------------ -- Exists -- @@ -95,13 +62,11 @@ package body Alire.Solver is function Check (R : Index.Release) return Boolean is begin - if R.Name = Name then - if Allowed.Contains (R.Version) then - return True; - else - Trace.Debug ("Skipping unsatisfactory version: " & - Image (R.Version)); - end if; + if Allowed.Contains (R.Version) then + return True; + else + Trace.Debug ("Skipping unsatisfactory version: " & + Image (R.Version)); end if; return False; @@ -124,22 +89,9 @@ package body Alire.Solver is end if; end if; - raise Query_Unsuccessful with "Release not found: " & (+Name); - end Find; - - ---------- - -- Find -- - ---------- - - function Find (Name : String; - Policy : Age_Policies) return Release - is - Spec : constant Milestones.Allowed_Milestones := - Milestones.Crate_Versions (Name); - begin - return Find (Spec.Crate, - Spec.Versions, - Policy); + raise Checked_Error with + "Release within requested version not found: " + & Dependencies.New_Dependency (Name, Allowed).Image; end Find; ------------------- @@ -153,149 +105,6 @@ package body Alire.Solver is return Boolean is (Resolve (Deps, Props, Current, Options).Valid); - -------------------- - -- Print_Solution -- - -------------------- - - procedure Print_Solution (Sol : Solution) is - use Containers.Crate_Release_Maps; - begin - Trace.Debug ("Resolved:"); - for Rel of Sol.Releases loop - Log (" " & Rel.Milestone.Image, Debug); - end loop; - - if Sol.Hints.Is_Empty then - Trace.Debug ("No external hints needed."); - else - Trace.Debug ("Hinted:"); - for Dep of Sol.Hints loop - Log (" " & Dep.Image, Debug); - end loop; - end if; - end Print_Solution; - - ------------------------ - -- Add_Dep_As_Release -- - ------------------------ - -- Declared for use with Materialize instance below. - - procedure Add_Dep_Release (Sol : in out Release_Map; - Dep : Types.Dependency; - Count : Count_Type := 1) - is - pragma Unreferenced (Count); - begin - if not Dep.Versions.Is_Single_Version then - raise Constraint_Error with "Materialization requires exact versions"; - end if; - - Sol.Insert (Dep.Crate, - Find (Dep.Crate, Dep.Versions, Newest)); - end Add_Dep_Release; - - ----------------- - -- Materialize -- - ----------------- - - function Materialize is new Alire.Conditional.For_Dependencies.Materialize - (Release_Map, - Add_Dep_Release); - - ----------------- - -- Is_Complete -- - ----------------- - - function Is_Complete (Deps : Types.Platform_Dependencies; - Props : Properties.Vector; - Sol : Solution) - return Boolean is - - use Alire.Conditional.For_Dependencies; - - ----------------- - -- Check_Value -- - ----------------- - - function Check_Value return Boolean is - begin - for R of Sol.Releases loop - if R.Satisfies (Deps.Value) then - Trace.Debug ("SOLVER:CHECK " & R.Milestone.Image & " satisfies " - & Deps.Image_One_Line); - - -- Check in turn that the release dependencies are satisfied - -- too. - return Is_Complete (R.Dependencies (Props), Props, Sol); - end if; - end loop; - - for Dep of Sol.Hints loop - if Dep.Crate = Deps.Value.Crate then - - -- Hints are unmet dependencies, that may have in turn other - -- dependencies. These are unknown at this point though, so we - -- can only report that a Hint indeed matches a dependency. - - Trace.Debug ("SOLVER:CHECK " & Dep.Image & " HINTS " - & Deps.Image_One_Line); - - return True; - end if; - end loop; - - Trace.Debug ("SOLVER:CHECK Solution fails to satisfy " & - Deps.Image_One_Line); - return False; - end Check_Value; - - ---------------------- - -- Check_And_Vector -- - ---------------------- - - function Check_And_Vector return Boolean is - begin - for I in Deps.Iterate loop - if not Is_Complete (Deps (I), Props, Sol) then - return False; - end if; - end loop; - return True; - end Check_And_Vector; - - --------------------- - -- Check_Or_Vector -- - --------------------- - - function Check_Or_Vector return Boolean is - begin - for I in Deps.Iterate loop - if Is_Complete (Deps (I), Props, Sol) then - return True; - end if; - end loop; - return False; - end Check_Or_Vector; - - begin - if Deps.Is_Empty then - return True; - end if; - - if Deps.Is_Value then - return Check_Value; - elsif Deps.Is_Vector then - if Deps.Conjunction = Anded then - return Check_And_Vector; - else - return Check_Or_Vector; - end if; - else - raise Program_Error - with "Requisites should be already evaluated at this point"; - end if; - end Is_Complete; - ------------- -- Resolve -- ------------- @@ -306,76 +115,84 @@ package body Alire.Solver is Options : Query_Options := Default_Options) return Solution is + Progress : Trace.Ongoing := Trace.Activity ("Solving dependencies..."); + use Alire.Conditional.For_Dependencies; -- On the solver internal operation: the solver recursively tries all -- possible dependency combinations, in depth-first order. This means -- that, for a given dependency, all satisfying releases are attempted - -- in different exploration branches. Once a search branch finds a - -- complete solution, it is added to the following global pool of - -- solutions. Likewise, if a branch cannot complete a solution, it - -- simply stops its exploration. The search status in each branch is - -- carried in a number of lists/trees that are the arguments of the - -- Expand internal procedure (this could be bundled in a single State - -- record at some point): - - Solutions : Solution_Lists.List; - -- We store here all valid solutions found. The solver is currently - -- exhaustive in that it will not stop after the first solution, but - -- will keep going until all possibilities are exhausted. This was done - -- for test purposes, to verify that the solver is indeed complete. - -- The solver is greedily guided by the Age_Policy, and the first found - -- solution is returned after the solving ends. It might be useful to - -- use some other criterion, like Pareto (e.g. returning the solution - -- where no release can be upgraded without degrading some other one). - -- On the other hand, if at some point resolution starts to take too - -- much time, it may be useful to be able to select the solver behavior - -- (e.g. stop after the first solution is found). - - -------------------- - -- Check_Complete -- - -------------------- - - procedure Check_Complete (Deps : Types.Platform_Dependencies; - Sol : Solution) is - -- Note: these Deps may include more than the ones requested to - -- solve, as indirect dependencies are progressively added. + -- in different exploration branches. Once a search branch exhausts + -- all dependencies, successfully solved or not, it is added to the + -- following global pool of solutions. The search status in each branch + -- is stored in a number of trees that are the arguments of the Expand + -- internal procedure, and in a Solution that is being incrementally + -- built. + + Solutions : Solution_Sets.Set; + -- We store here all solutions found. The solver is currently exhaustive + -- in that it will not stop after the first solution, but will keep + -- going until all possibilities are exhausted. If, at some point, + -- resolution starts to take too much time, it may be useful to be able + -- to select the solver behavior (e.g. stop after the first complete + -- solution is found). + + Dupes : Natural := 0; + -- Some solutions are found twice when some dependencies are subsets of + -- other dependencies. + + -------------- + -- Complete -- + -------------- + + function Complete return Natural is begin - if Is_Complete (Deps, Props, Sol) then - Solutions.Append (Sol); - Trace.Debug ("SOLVER: solution FOUND for " & Deps.Image_One_Line); - Print_Solution (Sol); - end if; - end Check_Complete; + return Count : Natural := 0 do + for Sol of Solutions loop + if Sol.Is_Complete then + Count := Count + 1; + end if; + end loop; + end return; + end Complete; + + ------------- + -- Partial -- + ------------- + + function Partial return Natural + is (Natural (Solutions.Length) - Complete); ------------ -- Expand -- ------------ procedure Expand (Expanded, - -- Nodes firmly in requisite tree + -- Nodes already processed - Current, - -- Next node to consider + Target, + -- Next subtree to consider Remaining : Types.Platform_Dependencies; -- Nodes pending to be considered - Frozen : Release_Map; - -- Releases in current solution - - Forbidden : Types.Forbidden_Dependencies; - -- Releases that conflict with current solution - - Hints : Dependency_Map) - -- Externals that supply a dependency + Solution : Alire.Solutions.Solution + -- Partial or complete solution that stores releases + -- and dependencies processed up to now + ) is ------------------ -- Expand_Value -- ------------------ - procedure Expand_Value (Dep : Types.Dependency) is + procedure Expand_Value (Dep : Dependencies.Dependency) is + + -- Ensure the dependency exists in the solution, so the following + -- procedures can safely count on it being there: + + Solution : constant Alire.Solutions.Solution := + Expand.Solution.Depending_On (Dep); ----------- -- Check -- @@ -383,147 +200,170 @@ package body Alire.Solver is procedure Check (R : Release) is use Alire.Containers; - package Cond_Ops renames Conditional.Operations; begin -- We first check that the release matches the dependency we - -- are attempting to resolve, in which case we check if it is - -- a valid candidate taking into account the following cases: - - if Dep.Crate = R.Name then - - -- A possibility is that the dependency was already frozen - -- previously (it was a dependency of an earlierly frozen - -- release). If the frozen version also satisfied the - -- current dependency, we may continue along this branch, - -- with this dependency out of the picture. - - if Frozen.Contains (R.Name) then - if Dep.Versions.Contains (R.Version) then - -- Continue along this tree - Expand (Expanded, - Remaining, - Empty, - Frozen, - Forbidden, - Hints); - else - Trace.Debug - ("SOLVER: discarding tree because of " & - "conflicting FROZEN release: " & - R.Milestone.Image & " does not satisfy " & - Dep.Image & " in tree " & - Tree'(Expanded - and Current - and Remaining).Image_One_Line); - end if; - - -- If the alias of the candidate release is already in the - -- frozen list, the candidate is incompatible since another - -- crate as already provided this dependency: - - elsif Frozen.Contains (R.Provides) then + -- are attempting to resolve, in which case we check whether + -- it is a valid candidate by taking into account the following + -- cases: + + -- A possibility is that the dependency was already frozen + -- previously (it was a dependency of an earlierly frozen + -- release). If the frozen version also satisfied the + -- current dependency, we may continue along this branch, + -- with this dependency out of the picture. + + if Solution.Releases.Contains (R.Name) then + if R.Satisfies (Dep) then + -- Continue along this tree + Expand (Expanded => Expanded, + Target => Remaining, + Remaining => Empty, + Solution => Solution); + else Trace.Debug ("SOLVER: discarding tree because of " & - "conflicting PROVIDES release: " & - R.Milestone.Image & " provides " & (+R.Provides) & - " already in tree " & + "conflicting FROZEN release: " & + R.Milestone.Image & " does not satisfy " & + Dep.Image & " in tree " & Tree'(Expanded - and Current + and Target and Remaining).Image_One_Line); + end if; - -- If the candidate release is forbidden by a previously - -- resolved dependency, the candidate release is - -- incompatible and we may stop search along this branch. + -- If the alias of the candidate release is already in the + -- frozen list, the candidate is incompatible since another + -- crate has already provided this dependency: - elsif Cond_Ops.Contains (Forbidden, R) then - Trace.Debug - ("SOLVER: discarding tree because of" & - " FORBIDDEN release: " & - R.Milestone.Image & - " forbidden by some already in tree " & - Tree'(Expanded - and Current - and Remaining).Image_One_Line); + elsif Solution.Releases.Contains (R.Provides) then + Trace.Debug + ("SOLVER: discarding tree because of " & + "conflicting PROVIDES release: " & + R.Milestone.Image & " provides " & (+R.Provides) & + " already in tree " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); - -- Conversely, if the candidate release forbids some of the - -- frozen crates, it is incompatible and we can discard it: + -- If the candidate release is forbidden by a previously + -- resolved dependency, the candidate release is + -- incompatible and we may stop search along this branch. - elsif Cond_Ops.Contains_Some - (R.Forbids (Props), Frozen) - then - Trace.Debug - ("SOLVER: discarding tree because " & - "candidate FORBIDS frozen release: " & - R.Milestone.Image & - " forbids some already in tree " & - Tree'(Expanded - and Current - and Remaining).Image_One_Line); + elsif Solution.Forbids (R, Props) + then + Trace.Debug + ("SOLVER: discarding tree because of" & + " FORBIDDEN release: " & + R.Milestone.Image & + " forbidden by current solution when tree is " & + Tree'(Expanded + and Target + and Remaining).Image_One_Line); - -- After all these checks, the candidate release must belong - -- to a crate that is still unfrozen, so it is a valid - -- candidate. If it satisfies the dependency version set, - -- and is available in the current platform, we freeze the - -- crate to the candidate version and this dependency is - -- done along this search branch: - - elsif -- First time we see this crate in the current branch. - Dep.Versions.Contains (R.Version) and then - R.Is_Available (Props) - then - Trace.Debug - ("SOLVER: dependency FROZEN: " & R.Milestone.Image & - " to satisfy " & Dep.Image & - (if R.Name /= R.Provides - then " also providing " & (+R.Provides) - else "") & - " adding" & - R.Dependencies (Props).Leaf_Count'Img & - " dependencies to tree " & - Tree'(Expanded - and Current - and Remaining - and R.Dependencies - (Props)).Image_One_Line); - - Expand (Expanded and R.To_Dependency, - Remaining and R.Dependencies (Props), - Empty, - Frozen.Inserting (R), - Forbidden and R.Forbids (Props), - Hints); - - -- Finally, even a valid candidate may not satisfy version - -- restrictions, or not be available in the current - -- platform, in which case this search branch is - -- exhausted without success: + -- After all these checks, the candidate release must belong to + -- a crate that is still unfrozen, so it is a valid new crate + -- and release to consider. First, check version compliance: - else - -- TODO: we could be more specific by actually - -- identifying the reason for rejecting the release - -- in the following log message: - Trace.Debug - ("SOLVER: discarding search branch because " - & "candidate FAILS to fulfil version " - & R.Milestone.Image - & ", or is unavailable in target platform, " - & "when the search tree was " - & Tree'(Expanded - and Current - and Remaining).Image_One_Line); - end if; + elsif not R.Satisfies (Dep) then + Trace.Debug + ("SOLVER: discarding search branch because " + & R.Milestone.Image & " FAILS to fulfil dependency " + & Dep.TTY_Image + & " when the search tree was " + & Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + -- Or it may be that, even being a valid version, it's not for + -- this environment. + + elsif not R.Is_Available (Props) then + + Trace.Debug + ("SOLVER: discarding search branch because " + & R.Milestone.Image & " is UNAVAILABLE" + & " when the search tree was " + & Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + -- If we reached here, the release fulfils the dependency and + -- it's a first time seen, so we add it to the solution. else - -- Not even same crate, this is related to the fixme below. - null; + Trace.Debug + ("SOLVER: dependency FROZEN: " & R.Milestone.Image & + " to satisfy " & Dep.TTY_Image & + (if R.Name /= R.Provides + then " also providing " & (+R.Provides) + else "") & + " adding" & + R.Dependencies (Props).Leaf_Count'Img & + " dependencies to tree " & + Tree'(Expanded + and Target + and Remaining + and R.Dependencies (Props)).Image_One_Line); + + Expand (Expanded => Expanded and R.To_Dependency, + Target => Remaining and R.Dependencies (Props), + Remaining => Empty, + Solution => Solution.Including (R, Props)); end if; end Check; + -------------------- + -- Expand_Missing -- + -------------------- + + procedure Expand_Missing (Dep : Alire.Dependencies.Dependency) + is + begin + if Options.Completeness = Also_Incomplete then + + Trace.Debug + ("SOLVER: marking MISSING the crate " & Dep.Image + & " when the search tree was " + & Tree'(Expanded + and Target + and Remaining).Image_One_Line); + + Expand (Expanded => Expanded, + Target => Remaining, + Remaining => Empty, + Solution => Solution.Missing (Dep)); + + else + Trace.Debug + ("SOLVER: discarding solution MISSING crate " & Dep.Image + & " when the search tree was " + & Tree'(Expanded + and Target + and Remaining).Image_One_Line); + end if; + end Expand_Missing; + begin - if Frozen.Contains (Dep.Crate) then - -- Cut search once a crate is frozen - Check (Frozen (Dep.Crate)); + + if Solution.Releases.Contains (Dep.Crate) then + + -- Cut search once a crate is frozen, by checking the + -- compatibility of the already frozen release: + + Check (Solution.Releases.Element (Dep.Crate)); + + elsif + Current.Depends_On (Dep.Crate) and then + Current.State (Dep.Crate).Is_Pinned and then + Current.State (Dep.Crate).Is_Solved + then + + -- For an existing pinned release, we try first to reuse the + -- stored release instead of looking for another release with + -- the same version (which will be the same one anyway for a + -- same index). + + Check (Current.Releases.Element (Dep.Crate)); elsif Index.Exists (Dep.Crate) then @@ -538,47 +378,48 @@ package body Alire.Solver is -- Check the releases now: - if Options.Age = Newest then - for R of reverse Index.Crate (Dep.Crate).Releases loop - Check (R); - end loop; - else - for R of Index.Crate (Dep.Crate).Releases loop - Check (R); - end loop; - end if; + for R of reverse Index.Crate (Dep.Crate).Releases loop + Check (R); + end loop; -- Beside normal releases, an external may exist for the -- crate, in which case we hint the crate instead of failing -- resolution (if the external failed to find its releases). - if Options.Hinting = Hint and then - not Index.Crate (Dep.Crate).Externals.Is_Empty - then + if not Index.Crate (Dep.Crate).Externals.Is_Empty then Trace.Debug ("SOLVER: dependency HINTED: " & (+Dep.Crate) & " via EXTERNAL to satisfy " & Dep.Image & " without adding dependencies to tree " & Tree'(Expanded - and Current - and Remaining).Image_One_Line); - - Expand (Expanded, - Remaining, - Empty, - Frozen, - Forbidden, - Hints & Dep); + and Target + and Remaining).Image_One_Line); + + Expand (Expanded => Expanded, + Target => Remaining, + Remaining => Empty, + Solution => Solution.Hinting (Dep)); + end if; + -- There may be a less bad solution if we leave this crate out + + Expand_Missing (Dep); + else + + -- The crate plainly doesn't exist in our loaded catalog, so + -- mark it as missing an move on: + Trace.Debug - ("SOLVER: discarding search branch because" - & " index LACKS the crate " & Dep.Image + ("SOLVER: catalog LACKS the crate " & Dep.Image & " when the search tree was " & Tree'(Expanded - and Current - and Remaining).Image_One_Line); + and Target + and Remaining).Image_One_Line); + + Expand_Missing (Dep); + end if; end Expand_Value; @@ -588,12 +429,10 @@ package body Alire.Solver is procedure Expand_And_Vector is begin - Expand (Expanded, - Current.First_Child, - Current.All_But_First_Children and Remaining, - Frozen, - Forbidden, - Hints); + Expand (Expanded => Expanded, + Target => Target.First_Child, + Remaining => Target.All_But_First_Children and Remaining, + Solution => Solution); end Expand_And_Vector; ---------------------- @@ -602,48 +441,85 @@ package body Alire.Solver is procedure Expand_Or_Vector is begin - for I in Current.Iterate loop - Expand (Expanded, - Current (I), - Remaining, - Frozen, - Forbidden, - Hints); + for I in Target.Iterate loop + Expand (Expanded => Expanded, + Target => Target (I), + Remaining => Remaining, + Solution => Solution); end loop; end Expand_Or_Vector; + -------------------- + -- Store_Finished -- + -------------------- + + procedure Store_Finished (Solution : Alire.Solutions.Solution) is + Pre_Length : constant Count_Type := Solutions.Length; + begin + Trace.Debug ("SOLVER: tree FULLY expanded as: " + & Expanded.Image_One_Line + & " complete: " & Solution.Is_Complete'Img + & "; composition: " & Solution.Composition'Img); + + Solutions.Include (Solution); + + if Pre_Length = Solutions.Length then + Dupes := Dupes + 1; + end if; + + Progress.Step ("Solving dependencies... " + & Utils.Trim (Complete'Img) & "/" + & Utils.Trim (Partial'Img) & "/" + & Utils.Trim (Dupes'Image) + & " (complete/partial/dupes)"); + end Store_Finished; + begin - if Current.Is_Empty then + if Target.Is_Empty then + + -- This is a completed search branch, be the solution complete or + -- not. + if Remaining.Is_Empty then - Trace.Debug ("SOLVER: tree FULLY expanded as: " & - Expanded.Image_One_Line); - Check_Complete - (Deps, - Alire.Solutions.New_Solution - (Releases => Materialize (Expanded, Props), - Hints => Hints)); + + Store_Finished (Solution); return; + else - Expand (Expanded, - Remaining, - Empty, - Frozen, - Forbidden, - Hints); + + -- Take the remaining tree and make it the current target for + -- solving, since we already exhausted the previous target. + + Expand (Expanded => Expanded, + Target => Remaining, + Remaining => Empty, + Solution => Solution); end if; end if; - if Current.Is_Value then - Expand_Value (Current.Value); - elsif Current.Is_Vector then - if Current.Conjunction = Anded then + if Target.Is_Value then + + -- We are tackling a new dependency that may have been seen + -- previously. For that reason we need to: 1) Recheck releases in + -- the solution against this new dependency 2) Be sure to consider + -- the merged dependencies for this crate when looking for new + -- releases. 1) is done inside Expand_Value (the first check) + + -- 2 is done here: first add/merge new dep, then use it for expand + + Expand_Value + (Solution.Depending_On (Target.Value) -- add or merge dependency + .Dependency (Target.Value.Crate)); -- and use it in expansion + + elsif Target.Is_Vector then + if Target.Conjunction = Anded then Expand_And_Vector; else Expand_Or_Vector; end if; else raise Program_Error - with "Requisites should be evaluated prior to Resolve"; + with "Dynamic dependency trees cannot be resolved"; end if; end Expand; @@ -653,34 +529,98 @@ package body Alire.Solver is -- can only be solved with the pinned version, and they are attempted -- first to avoid wasteful trial-and-error with other versions. + Solution : constant Alire.Solutions.Solution := + Alire.Solutions.Empty_Valid_Solution; + -- Valid solution in the sense that solving has been attempted + begin + + -- Get the trivial case out of the way + if Full_Dependencies.Is_Empty then Trace.Debug ("Returning trivial solution for empty dependencies"); - return Alire.Solutions.Empty_Valid_Solution; + return Solution; end if; + -- Otherwise expand the full dependencies + Expand (Expanded => Empty, - Current => Full_Dependencies, + Target => Full_Dependencies, Remaining => Empty, - Frozen => Empty_Map, - Forbidden => Empty, - Hints => Empty_Deps); + Solution => Solution); + + -- Once Expand returns the complete recursive exploration has ended. + -- There must exist at least one incomplete solution. if Solutions.Is_Empty then - Trace.Detail ("Dependency resolution failed"); - return Alire.Solutions.Invalid_Solution; + if Options.Completeness = Only_Complete then + -- Reattempt so we can return an incomplete solution: + return Resolve + (Deps => Deps, + Props => Props, + Current => Current, + Options => + (Query_Options'(Age => Options.Age, + Completeness => Also_Incomplete, + Detecting => Options.Detecting, + Hinting => Options.Hinting))); + else + raise Program_Error + with "solver should have found at least one incomplete solution"; + end if; else - Trace.Detail ("Dependencies solvable in" & - Solutions.Length'Img & " ways"); - Trace.Detail ("Dependencies solved with" - & Solutions.First_Element.Releases.Length'Img - & " releases" - & (if not Solutions.First_Element.Hints.Is_Empty - then " and" & Solutions.First_Element.Hints.Length'Img - & " external hints" - else "")); - - return Solutions.First_Element.With_Pins (Current); + + -- Mark direct/indirect dependencies post-hoc + + declare + Best_Solution : Alire.Solutions.Solution := + Solutions.First_Element.With_Pins (Current); + begin + + -- Mark pins as direct dependencies + + for Dep of Conditional.Dependencies'(Current.Pins) loop + Best_Solution.Set (Dep.Value.Crate, Direct); + end loop; + + -- Mark direct dependencies + + for Dep of Containers.Enumerate (Deps) loop + if Best_Solution.Depends_On (Dep.Crate) then + Best_Solution.Set (Dep.Crate, Direct); + end if; + end loop; + + -- Mark all not direct as indirect + + for Crate of Best_Solution.Crates loop + if not Best_Solution.State (Crate).Is_Direct then + Best_Solution.Set (Crate, Indirect); + end if; + end loop; + + Trace.Detail ("Dependencies solvable in" & + TTY.Emph (Solutions.Length'Img) & " ways" + & " (complete:" & TTY.OK (Complete'Img) + & "; partial:" & TTY.Warn (Partial'Img) + & "; dupes:" & TTY.Bold (Dupes'Img) & ")"); + Trace.Detail ("Dependencies solved with" + & TTY.Emph (Best_Solution.Releases.Length'Img) + & " releases" + & (if not Best_Solution.Hints.Is_Empty + then " and" + & TTY.Warn (Best_Solution.Hints.Length'Img) + & " external hints" + else "") + & (if not Best_Solution.Misses.Is_Empty + then " and" + & TTY.Error (Best_Solution.Misses.Length'Img) + & " missing dependencies" + else "") + ); + + return Best_Solution; + end; end if; end Resolve; diff --git a/src/alire/alire-solver.ads b/src/alire/alire-solver.ads index b4d0a31e..98ebeb3e 100644 --- a/src/alire/alire-solver.ads +++ b/src/alire/alire-solver.ads @@ -1,3 +1,4 @@ +with Alire.Dependencies; with Alire.Index; with Alire.Properties; with Alire.Solutions; @@ -17,6 +18,9 @@ package Alire.Solver is type Age_Policies is (Oldest, Newest); -- When looking for releases within a crate, which one to try first. + type Completeness_Policies is (Only_Complete, Also_Incomplete); + -- Allow the solver to further explore incomplete solution space + type Detection_Policies is (Detect, Dont_Detect); -- * Detect: externals will be detected and added to the index once needed. -- * Dont_Detect: externals will remain undetected (faster). @@ -32,12 +36,14 @@ package Alire.Solver is subtype Solution is Solutions.Solution; - -- The dependency solver receives a list of dependencies and will return - -- either a valid solution if one can be found (exploration is exhaustive). - -- System dependencies are resolved in platforms with system packager - -- support. Otherwise they're filed as "hints" but do not cause a failure - -- in resolution. In this case, a warning will be provided for the user - -- with a list of the dependencies that are externally required. + -- The dependency solver (Resolve subprogram, below) receives a + -- dependency tree and will return the best solution found (exploration + -- is exhaustive), according to Solutions.Is_Better ordering. System + -- dependencies are resolved in platforms with system packager support. + -- Otherwise they're filed as "hints". In this case, a warning will + -- be provided for the user with a list of the dependencies that are + -- externally required. Note that a solution is always returned, but + -- it might not be complete. --------------------- -- Basic queries -- @@ -63,11 +69,12 @@ package Alire.Solver is Allowed : Semantic_Versioning.Extended.Version_Set := Semantic_Versioning.Extended.Any; Policy : Age_Policies) - return Release; - - function Find (Name : String; - Policy : Age_Policies) return Release; - -- Given a textual crate+set (see Parsers), find the release if it exists + return Release + with Pre => + Exists (Name, Allowed) or else + raise Query_Unsuccessful + with "Release within requested version not found: " + & Dependencies.New_Dependency (Name, Allowed).Image; ----------------------- -- Advanced queries -- @@ -75,9 +82,10 @@ package Alire.Solver is -- availability checks. type Query_Options is record - Age : Age_Policies := Newest; - Detecting : Detection_Policies := Detect; - Hinting : Hinting_Policies := Hint; + Age : Age_Policies := Newest; + Completeness : Completeness_Policies := Also_Incomplete; + Detecting : Detection_Policies := Detect; + Hinting : Hinting_Policies := Hint; end record; Default_Options : constant Query_Options := (others => <>); @@ -98,15 +106,4 @@ package Alire.Solver is return Boolean; -- Simplified call to Resolve, discarding result - ------------------- - -- Debug helpers -- - ------------------- - - procedure Print_Solution (Sol : Solution); - - function Dependency_Image - (Name : Alire.Crate_Name; - Versions : Semantic_Versioning.Extended.Version_Set; - Policy : Age_Policies := Newest) return String; - end Alire.Solver; diff --git a/src/alire/alire.adb b/src/alire/alire.adb index de84e018..2ab5b25f 100644 --- a/src/alire/alire.adb +++ b/src/alire/alire.adb @@ -1,7 +1,7 @@ with AAA.Debug; with Alire.Errors; -with Alire.Utils; +with Alire.Utils.TTY; with GNAT.IO; @@ -19,7 +19,6 @@ package body Alire is -- "<" -- --------- - overriding function "<" (L, R : Crate_Name) return Boolean is (Utils.To_Lower_Case (+L) < Utils.To_Lower_Case (+R)); @@ -79,16 +78,9 @@ package body Alire is -- Error_In_Name -- ------------------- - Last_Name_Error : UString; - - function Error_In_Name return String is (+Last_Name_Error); - - ------------------- - -- Is_Valid_Name -- - ------------------- - - function Is_Valid_Name (S : String) return Boolean is - Err : UString renames Last_Name_Error; + function Error_In_Name (S : String) return String + is + Err : UString; use type UString; begin if S'Length < Min_Name_Length then @@ -107,8 +99,22 @@ package body Alire is & " with 'alr help identifiers'"; end if; - return +Err = ""; - end Is_Valid_Name; + return +Err; + end Error_In_Name; + + ------------------- + -- Is_Valid_Name -- + ------------------- + + function Is_Valid_Name (S : String) return Boolean + is (Error_In_Name (S) = ""); + + --------------- + -- TTY_Image -- + --------------- + + function TTY_Image (This : Crate_Name) return String + is (Utils.TTY.Name (This.Name)); --------------------- -- Outcome_Failure -- diff --git a/src/alire/alire.ads b/src/alire/alire.ads index cfce65d3..816bc014 100644 --- a/src/alire/alire.ads +++ b/src/alire/alire.ads @@ -59,27 +59,24 @@ package Alire with Preelaborate is -------------------- function Is_Valid_Name (S : String) return Boolean; - function Error_In_Name return String; - -- Returns the problem with the last checked crate name. This is a global, - -- thread-unsafe kludge for a GNAT bug already reported. Since alr is - -- single-threaded, it is not a problem right now. - -- TODO: remove this once the bug is fixed. - - type Crate_Name is new String with - Dynamic_Predicate => - Is_Valid_Name (String (Crate_Name)), - Predicate_Failure => -- This is the buggy predicate requiring workarounds - raise Alire.Checked_Error with Alire.Error_In_Name; - -- Alire.* prefix needed for GNAT bug workaround. + function Error_In_Name (S : String) return String; + -- Returns the problem with the crate name + + type Crate_Name (<>) is tagged private; overriding function "=" (L, R : Crate_Name) return Boolean; -- Crate names are case preserving but insensitive when compared. - overriding function "<" (L, R : Crate_Name) return Boolean; -- Likewise, we do not want capitalization to influence ordering. + function Length (This : Crate_Name) return Positive; + + function As_String (This : Crate_Name) return String; + + function TTY_Image (This : Crate_Name) return String; + subtype Restricted_Name is String with Dynamic_Predicate => Restricted_Name'Length >= Min_Name_Length and then Restricted_Name (Restricted_Name'First) /= '_' and then @@ -87,8 +84,8 @@ package Alire with Preelaborate is -- A type used to limit some things that are given names by the user -- (e.g., remote index names). - function "+" (P : Crate_Name) return String is (String (P)); - function "+" (P : String) return Crate_Name is (Crate_Name (P)); + function "+" (P : Crate_Name) return String; + function "+" (P : String) return Crate_Name; subtype Description_String is String with Dynamic_Predicate => Description_String'Length <= Max_Description_Length; @@ -225,6 +222,20 @@ package Alire with Preelaborate is private + type Crate_Name (Len : Natural) is tagged record + Name : String (1 .. Len); + end record; + + function Length (This : Crate_Name) return Positive is (This.Len); + + function As_String (This : Crate_Name) return String is (This.Name); + + function "+" (P : Crate_Name) return String is (P.Name); + function "+" (P : String) return Crate_Name + is (if Is_Valid_Name (P) + then (P'Length, P) + else raise Checked_Error with Error_In_Name (P)); + type Outcome is tagged record Success : Boolean := False; Message : Ada.Strings.Unbounded.Unbounded_String := diff --git a/src/alr/alr-build_env.adb b/src/alr/alr-build_env.adb index fc9cda0f..80715a2e 100644 --- a/src/alr/alr-build_env.adb +++ b/src/alr/alr-build_env.adb @@ -100,6 +100,7 @@ package body Alr.Build_Env is Full_Instance : Alire.Solutions.Release_Map; begin if not Needed.Valid then + Trace.Error ("Cannot generate environment for invalid solution"); raise Command_Failed; end if; diff --git a/src/alr/alr-checkout.adb b/src/alr/alr-checkout.adb index 6350070a..42e9697b 100644 --- a/src/alr/alr-checkout.adb +++ b/src/alr/alr-checkout.adb @@ -139,7 +139,9 @@ package body Alr.Checkout is Trace.Error ("Remaining releases:" & Pending.Length'Img & "; Dependency graph:"); - Graph.Print (Alire.Solutions.New_Solution (Pending)); + Graph.Print (Alire.Solutions.New_Solution + (Platform.Properties, + Releases => Pending)); raise Program_Error with "No release checked-out in round" & Round'Img; else @@ -187,7 +189,9 @@ package body Alr.Checkout is -- are still unretrieved). Once they are checked out, the lockfile -- will be replaced with the complete solution. Alire.Lockfiles.Write - (Solution => Alire.Solutions.Invalid_Solution, + (Solution => (if R.Dependencies (Platform.Properties).Is_Empty + then Alire.Solutions.Empty_Valid_Solution + else Alire.Solutions.Empty_Invalid_Solution), Environment => Platform.Properties, Filename => Root.Lock_File); end; diff --git a/src/alr/alr-commands-get.adb b/src/alr/alr-commands-get.adb index 2750be7a..a984d061 100644 --- a/src/alr/alr-commands-get.adb +++ b/src/alr/alr-commands-get.adb @@ -1,5 +1,6 @@ with Ada.Directories; +with Alire.Dependencies; with Alire.Directories; with Alire.Index; with Alire.Milestones; @@ -91,7 +92,8 @@ package body Alr.Commands.Get is Diff := Alire.Solutions.Empty_Valid_Solution.Changes (Solution); else Trace.Error ("Could not resolve dependencies for: " & - Query.Dependency_Image (Name, Versions)); + Alire.Dependencies.New_Dependency + (Name, Versions).Image); Trace.Error ("You can still retrieve the crate without " & "dependencies with --only."); raise Command_Failed; diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index 8bed27dd..77f49622 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -63,7 +63,7 @@ package body Alr.Commands.Pin is procedure Unpin is begin - if not Solution.Releases.Element (Name).Is_Pinned then + if not Solution.State (Name).Is_Pinned then Reportaise_Command_Failed ("Requested crate is already unpinned"); end if; @@ -91,8 +91,8 @@ package body Alr.Commands.Pin is -- Sanity checks - if not Solution.Releases.Contains (Name) then - Reportaise_Command_Failed ("Cannot pin release not in solution: " + if not Solution.Depends_On (Name) then + Reportaise_Command_Failed ("Cannot pin dependency not in solution: " & (+Name)); end if; @@ -187,9 +187,9 @@ package body Alr.Commands.Pin is Reportaise_Command_Failed ("Cannot pin an invalid solution"); end if; - for Release of New_Sol.Releases loop - if Release.Is_Pinned = Cmd.Unpin then - Change_One_Pin (Cmd, New_Sol, Release.Name_Str); + for Crate of New_Sol.Crates loop + if New_Sol.State (Crate).Is_Pinned = Cmd.Unpin then + Change_One_Pin (Cmd, New_Sol, +Crate); end if; end loop; diff --git a/src/alr/alr-commands-search.adb b/src/alr/alr-commands-search.adb index 320742a2..cacdf89a 100644 --- a/src/alr/alr-commands-search.adb +++ b/src/alr/alr-commands-search.adb @@ -62,9 +62,8 @@ package body Alr.Commands.Search is (R.Dependencies (Platform.Properties), Platform.Properties, Alire.Solutions.Empty_Valid_Solution, - Options => (Age => Query_Policy, - Detecting => Solver.Dont_Detect, - Hinting => Solver.Hint)) + Options => (Age => Query_Policy, + others => <>)) then " " else Flag_Unsolv))); Tab.Append (TTY.Version (Semantic_Versioning.Image (R.Version))); diff --git a/src/alr/alr-commands-show.adb b/src/alr/alr-commands-show.adb index 408aa362..e5bf29e0 100644 --- a/src/alr/alr-commands-show.adb +++ b/src/alr/alr-commands-show.adb @@ -1,3 +1,4 @@ +with Alire.Dependencies; with Alire.Index; with Alire.Milestones; with Alire.Origins.Deployers; @@ -65,16 +66,14 @@ package body Alr.Commands.Show is (Rel.Dependencies (Platform.Properties), Platform.Properties, Alire.Solutions.Empty_Valid_Solution, - Options => (Age => Query_Policy, - Detecting => <>, - Hinting => <>))); + Options => (Age => Query_Policy, + others => <>))); begin - if Needed.Valid then - Needed.Print (Rel, - Platform.Properties, - Cmd.Detail, - Always); - else + Needed.Print (Rel, + Platform.Properties, + Cmd.Detail, + Always); + if not Needed.Valid then Put_Line ("Dependencies cannot be met"); end if; end; @@ -83,7 +82,9 @@ package body Alr.Commands.Show is end; exception when Alire.Query_Unsuccessful => - Trace.Info ("Not found: " & Query.Dependency_Image (Name, Versions)); + Trace.Info ("Not found: " + & Alire.Dependencies.New_Dependency + (Name, Versions).TTY_Image); if not Alire.Index.Crate (Name).Externals.Is_Empty then Trace.Info ("There are external definitions for the crate. " & "Use --external to show them."); @@ -173,7 +174,9 @@ package body Alr.Commands.Show is end; exception when Alire.Query_Unsuccessful => - Trace.Info ("Not found: " & Query.Dependency_Image (Name, Versions)); + Trace.Info ("Not found: " + & Alire.Dependencies.New_Dependency + (Name, Versions).TTY_Image); end Report_Jekyll; ------------- diff --git a/src/alr/alr-commands-update.adb b/src/alr/alr-commands-update.adb index 3e434309..6edf2bd1 100644 --- a/src/alr/alr-commands-update.adb +++ b/src/alr/alr-commands-update.adb @@ -31,7 +31,7 @@ package body Alr.Commands.Update is -- Ensure requested crates are in solution first for Crate of Allowed loop - if not Old.Releases.Contains (Crate) then + if not Old.Depends_On (Crate) then Reportaise_Wrong_Arguments ("Requested crate is not a dependency: " & Alire.Utils.TTY.Name (Crate)); end if; @@ -50,9 +50,8 @@ package body Alr.Commands.Update is Alire.Workspaces.Update (Platform.Properties, Allowed, - Options => (Age => Query_Policy, - Detecting => <>, - Hinting => <>)); + Options => (Age => Query_Policy, + others => <>)); Diff : constant Alire.Solutions.Diffs.Diff := Old.Changes (Needed); begin @@ -107,7 +106,7 @@ package body Alr.Commands.Update is begin return Set : Alire.Containers.Crate_Name_Sets.Set do for I in 1 .. Num_Arguments loop - Set.Include (Alire.Crate_Name (Argument (I))); + Set.Include (+Argument (I)); end loop; end return; exception diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index 791682da..fbea8c98 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -470,9 +470,10 @@ package body Alr.Commands is Platform.Properties, Alire.Solutions.Empty_Valid_Solution); begin - Alire.Lockfiles.Write (Solution, - Platform.Properties, - Checked.Lock_File); + Alire.Lockfiles.Write + (Solution, + Platform.Properties, + Checked.Lock_File); end; end Requires_Valid_Session; diff --git a/testsuite/tests/get/only/test.py b/testsuite/tests/get/only/test.py index 81f45d3b..7cb90e98 100644 --- a/testsuite/tests/get/only/test.py +++ b/testsuite/tests/get/only/test.py @@ -20,12 +20,12 @@ p = run_alr('with', '--solve') assert_eq('Dependencies (direct):\n' ' libhello^1.0\n' 'Dependencies (solution):\n' - ' No solution\n', + ' No solving attempted\n', p.out) # Verify that it has no pins p = run_alr('pin') -assert_eq('There is no solution, hence there are no pins\n', p.out) +assert_eq('There are no pins\n', p.out) # Verify that updating it fixes the solution run_alr('update') diff --git a/testsuite/tests/get/system-hint/test.py b/testsuite/tests/get/system-hint/test.py index b56412e0..e3733c3a 100644 --- a/testsuite/tests/get/system-hint/test.py +++ b/testsuite/tests/get/system-hint/test.py @@ -9,7 +9,7 @@ from drivers.asserts import assert_match import re -p = run_alr('get', '--no-tty', 'libhello=0.9-test_unav_native', +p = run_alr('get', 'libhello=0.9-test_unav_native', complain_on_error=True, quiet=False) assert_match('Warning: The following external dependencies are unavailable within Alire:\n' diff --git a/testsuite/tests/index/external-available/test.py b/testsuite/tests/index/external-available/test.py index d5f4e698..8c62303e 100644 --- a/testsuite/tests/index/external-available/test.py +++ b/testsuite/tests/index/external-available/test.py @@ -30,7 +30,7 @@ assert_match(".*Executable make --version .* False.*", p = run_alr('show', '--no-tty', 'crate', '--external-detect', quiet=False) -assert_match("Not found: crate with Newest version.*", +assert_match("Not found: crate\*.*", p.out, flags=re.S) diff --git a/testsuite/tests/index/external-from-output/test.py b/testsuite/tests/index/external-from-output/test.py index 47e52db5..19c5ce32 100644 --- a/testsuite/tests/index/external-from-output/test.py +++ b/testsuite/tests/index/external-from-output/test.py @@ -10,7 +10,7 @@ import re # Hint that an external exists p = run_alr('show', 'make', complain_on_error=False, quiet=False) -assert_eq('Not found: make with Newest version\n' +assert_eq('Not found: make*\n' 'There are external definitions for the crate. ' 'Use --external to show them.\n', p.out) diff --git a/testsuite/tests/pin/downgrade/test.py b/testsuite/tests/pin/downgrade/test.py index 2e7398b4..d2fe1cb6 100644 --- a/testsuite/tests/pin/downgrade/test.py +++ b/testsuite/tests/pin/downgrade/test.py @@ -22,7 +22,7 @@ def check_child(version, output, pinned): # Verify lockfile check_line_in('alire/xxx.lock', - '[dependency.libchild."' + version + '"]') + '[state.release.libchild."' + version + '"]') # Verify dependency folders assert os.path.exists('alire/cache/dependencies/libchild_' + version + diff --git a/testsuite/tests/pin/post-update/test.py b/testsuite/tests/pin/post-update/test.py index 7acff977..45777b15 100644 --- a/testsuite/tests/pin/post-update/test.py +++ b/testsuite/tests/pin/post-update/test.py @@ -23,7 +23,7 @@ def check_child(version, output, pinned): # Verify lockfile check_line_in('alire/xxx.lock', - '[dependency.libchild."' + version + '"]') + '[state.release.libchild."' + version + '"]') # Create a new "xxx" program project diff --git a/testsuite/tests/run/defaults/my_index/index/index.toml b/testsuite/tests/run/defaults/my_index/index/index.toml deleted file mode 100644 index 7c969026..00000000 --- a/testsuite/tests/run/defaults/my_index/index/index.toml +++ /dev/null @@ -1 +0,0 @@ -version = "0.2" -- 2.39.5