From f6e4ab7e493d56e8cf2190799956d1bb23e81157 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Mon, 11 May 2020 16:54:10 +0200 Subject: [PATCH] Cache dependency solution in a lockfile (#355) * Refactor Alr.Query as Alire.Solver * Implement lockfiles and create them on checkout --- src/alire/alire-containers.adb | 25 +- src/alire/alire-containers.ads | 9 + src/alire/alire-dependencies.ads | 15 ++ src/alire/alire-lockfiles.adb | 67 ++++++ src/alire/alire-lockfiles.ads | 24 ++ .../alire-milestones.adb} | 10 +- src/alire/alire-milestones.ads | 16 +- src/alire/alire-origins.adb | 18 +- src/alire/alire-origins.ads | 22 +- src/alire/alire-releases.ads | 8 + src/alire/alire-roots.ads | 26 +- src/alire/alire-solutions.adb | 224 ++++++++++++++++++ src/alire/alire-solutions.ads | 70 ++++++ .../alr-query.adb => alire/alire-solver.adb} | 118 +++++---- .../alr-query.ads => alire/alire-solver.ads} | 53 ++--- src/alr/alr-build_env.adb | 32 +-- src/alr/alr-checkout.adb | 35 ++- src/alr/alr-checkout.ads | 16 +- src/alr/alr-commands-get.adb | 43 ++-- src/alr/alr-commands-init.adb | 14 +- src/alr/alr-commands-pin.adb | 17 +- src/alr/alr-commands-search.adb | 26 +- src/alr/alr-commands-show.adb | 11 +- src/alr/alr-commands-test.adb | 20 +- src/alr/alr-commands-update.adb | 13 +- src/alr/alr-commands-withing.adb | 16 +- src/alr/alr-commands.adb | 6 +- src/alr/alr-commands.ads | 4 +- src/alr/alr-dependency_graphs.adb | 2 +- src/alr/alr-dependency_graphs.ads | 5 +- src/alr/alr-parsers.ads | 17 -- .../get/external-tool-dependency/test.py | 1 + testsuite/tests/get/git-local/test.py | 1 + testsuite/tests/get/unpack-in-place/test.py | 1 + .../tests/workflows/init-options/test.py | 3 + 35 files changed, 754 insertions(+), 234 deletions(-) create mode 100644 src/alire/alire-lockfiles.adb create mode 100644 src/alire/alire-lockfiles.ads rename src/{alr/alr-parsers.adb => alire/alire-milestones.adb} (86%) create mode 100644 src/alire/alire-solutions.adb create mode 100644 src/alire/alire-solutions.ads rename src/{alr/alr-query.adb => alire/alire-solver.adb} (88%) rename src/{alr/alr-query.ads => alire/alire-solver.ads} (71%) delete mode 100644 src/alr/alr-parsers.ads diff --git a/src/alire/alire-containers.adb b/src/alire/alire-containers.adb index 88ec4f80..e055ca42 100644 --- a/src/alire/alire-containers.adb +++ b/src/alire/alire-containers.adb @@ -7,10 +7,19 @@ package body Alire.Containers is -- Insert -- ------------ + procedure Insert (Dst : in out Release_Map; Src : Releases.Release) is + begin + Dst.Insert (Src.Name, Src); + end Insert; + + ------------ + -- Insert -- + ------------ + procedure Insert (Dst : in out Release_Map; Src : Release_Map) is begin for E of Src loop - Dst.Insert (E.Name, E); + Dst.Insert (E); end loop; end Insert; @@ -106,4 +115,18 @@ package body Alire.Containers is end return; end To_Map; + -------------- + -- Whenever -- + -------------- + + function Whenever (Map : Release_Map; + Props : Properties.Vector) return Release_Map is + begin + return Result : Release_Map do + for Release of Map loop + Result.Insert (Release.Name, Release.Whenever (Props)); + end loop; + end return; + end Whenever; + end Alire.Containers; diff --git a/src/alire/alire-containers.ads b/src/alire/alire-containers.ads index 496855e8..79ed50ae 100644 --- a/src/alire/alire-containers.ads +++ b/src/alire/alire-containers.ads @@ -6,6 +6,7 @@ with Ada.Containers.Indefinite_Ordered_Sets; with Alire.Conditional; with Alire.Dependencies; with Alire.Milestones; +with Alire.Properties; with Alire.Releases; package Alire.Containers with Preelaborate is @@ -45,6 +46,9 @@ package Alire.Containers with Preelaborate is -- Finds the current release (if existing) and replaces/adds the new -- Release. + procedure Insert (Dst : in out Release_Map; Src : Releases.Release); + -- Insert a release under its name as key + procedure Insert (Dst : in out Release_Map; Src : Release_Map); function Inserting (Dst : Release_Map; @@ -62,6 +66,11 @@ package Alire.Containers with Preelaborate is -- Will filter out duplicates under Provides key (only actual crates will -- remain). + function Whenever (Map : Release_Map; + Props : Properties.Vector) return Release_Map; + -- Replace every release with one that has no case expressions, using + -- environment Props. + function To_Map (R : Releases.Release) return Release_Map; function To_Release_H (R : Releases.Release) return Release_H diff --git a/src/alire/alire-dependencies.ads b/src/alire/alire-dependencies.ads index 5212eedb..677ba642 100644 --- a/src/alire/alire-dependencies.ads +++ b/src/alire/alire-dependencies.ads @@ -2,6 +2,7 @@ with Alire.Interfaces; with Alire.TOML_Adapters; with Alire.Utils; +with Semantic_Versioning.Basic; with Semantic_Versioning.Extended; with TOML; use all type TOML.Any_Value_Kind; @@ -21,6 +22,11 @@ package Alire.Dependencies with Preelaborate is Versions : Semantic_Versioning.Extended.Version_Set) return Dependency; + function New_Dependency + (Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return Dependency; + function Crate (Dep : Dependency) return Crate_Name; function Versions (Dep : Dependency) @@ -67,6 +73,15 @@ private return Dependency is (Crate'Length, Crate, Versions); + function New_Dependency + (Crate : Crate_Name; + Version : Semantic_Versioning.Version) + return Dependency + is (New_Dependency + (Crate, + Semantic_Versioning.Extended.To_Extended + (Semantic_Versioning.Basic.Exactly (Version)))); + function Crate (Dep : Dependency) return Crate_Name is (Dep.Crate); function Versions (Dep : Dependency) diff --git a/src/alire/alire-lockfiles.adb b/src/alire/alire-lockfiles.adb new file mode 100644 index 00000000..702889bc --- /dev/null +++ b/src/alire/alire-lockfiles.adb @@ -0,0 +1,67 @@ +with Ada.Text_IO; + +with Alire.Directories; +with Alire.Paths; +with Alire.Solutions; +with Alire.TOML_Adapters; + +with TOML.File_IO; + +package body Alire.Lockfiles is + + use Directories.Operators; + + --------------- + -- File_Name -- + --------------- + + function File_Name (Name : Crate_Name; + Root_Dir : Any_Path) return Any_Path is + (Root_Dir / Paths.Working_Folder_Inside_Root / (+Name) & ".lock"); + + ---------- + -- Read -- + ---------- + + function Read (Filename : Any_Path) return Solver.Solution is + begin + Trace.Debug ("Reading solution from " & Filename); + + declare + Result : constant TOML.Read_Result := + TOML.File_IO.Load_File (Filename); + begin + if Result.Success then + return Solutions.From_TOML + (TOML_Adapters.From (Result.Value, Filename & ":")); + else + Raise_Checked_Error (TOML.Format_Error (Result)); + end if; + end; + end Read; + + ----------- + -- Write -- + ----------- + + procedure Write (Solution : Solver.Solution; + Environment : Properties.Vector; + Filename : Any_Path) + is + 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); + Close (File); + exception + when others => + if Is_Open (File) then + Close (File); + end if; + + raise; + end Write; + +end Alire.Lockfiles; diff --git a/src/alire/alire-lockfiles.ads b/src/alire/alire-lockfiles.ads new file mode 100644 index 00000000..2d6fd7d3 --- /dev/null +++ b/src/alire/alire-lockfiles.ads @@ -0,0 +1,24 @@ +with Alire.Properties; +with Alire.Solver; + +package Alire.Lockfiles is + + -- A crate lockfile stores the dependency solution in use. This permanente + -- storage, in /crate_name.lock, is the basis for ordely uploads and + -- pinning. This file is autogenerated and manipulated via alr commands; + -- the user should not modify it. + + function File_Name (Name : Crate_Name; + Root_Dir : Any_Path) return Any_Path; + -- Return the location /path/to/crate/dir/alire/crate.lock, filename + -- included, given the root directory where the crate is deployed. + + function Read (Filename : Any_Path) return Solver.Solution; + -- Read a solution from the given lockfile + + procedure Write (Solution : Solver.Solution; + Environment : Properties.Vector; + Filename : Any_Path); + -- Write a solution to a file + +end Alire.Lockfiles; diff --git a/src/alr/alr-parsers.adb b/src/alire/alire-milestones.adb similarity index 86% rename from src/alr/alr-parsers.adb rename to src/alire/alire-milestones.adb index 3dbe002f..56ffd15d 100644 --- a/src/alr/alr-parsers.adb +++ b/src/alire/alire-milestones.adb @@ -1,7 +1,7 @@ with Ada.Strings.Fixed; with Ada.Strings.Maps; -package body Alr.Parsers is +package body Alire.Milestones is package Semver renames Semantic_Versioning; @@ -11,7 +11,7 @@ package body Alr.Parsers is function Crate_Versions (Spec : String) return Allowed_Milestones is - -- Locate and identify the version operator + -- Locate and identify the version operator use Ada.Strings; use Ada.Strings.Fixed; use Ada.Strings.Maps; @@ -34,14 +34,14 @@ package body Alr.Parsers is Trace.Error ("Invalid version set expression: " & Spec (Op_Pos .. Spec'Last)); Trace.Error (Result.Error); - raise Command_Failed with "Invalid version set expression"; + raise Checked_Error with "Invalid version set expression"; end if; exception when Alire.Checked_Error => raise; when others => Trace.Error ("A crate/version string was invalid"); - raise Command_Failed; + raise Checked_Error; end Crate_Versions; -end Alr.Parsers; +end Alire.Milestones; diff --git a/src/alire/alire-milestones.ads b/src/alire/alire-milestones.ads index 6cfbfdb3..72a8e58b 100644 --- a/src/alire/alire-milestones.ads +++ b/src/alire/alire-milestones.ads @@ -1,4 +1,4 @@ -with Semantic_Versioning; +with Semantic_Versioning.Extended; package Alire.Milestones with Preelaborate is @@ -16,6 +16,20 @@ package Alire.Milestones with Preelaborate is function Image (M : Milestone) return String; + ----------------------- + -- Milestone parsing -- + ----------------------- + + type Allowed_Milestones (Len : Positive) is record + Crate : Alire.Crate_Name (1 .. Len); + Versions : Semantic_Versioning.Extended.Version_Set; + end record; + + 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] + private type Milestone (Name_Len : Natural) is tagged record diff --git a/src/alire/alire-origins.adb b/src/alire/alire-origins.adb index 069225c3..a0f7eeed 100644 --- a/src/alire/alire-origins.adb +++ b/src/alire/alire-origins.adb @@ -164,6 +164,7 @@ package body Alire.Origins is Path : constant String := From (From'First + Prefixes (Filesystem)'Length .. From'Last); + Descr : constant String := Tail (From, ':'); begin -- Check easy ones first (unique prefixes): for Kind in Prefixes'Range loop @@ -175,6 +176,8 @@ package body Alire.Origins is when Hg => This := New_Hg (URL, Commit); when SVN => This := New_SVN (URL, Commit); + when External => This := New_External (Descr); + when Filesystem => if Path = "" then return Parent.Failure @@ -182,8 +185,11 @@ package body Alire.Origins is else This := New_Filesystem (Path); end if; - when External | System | Source_Archive => + + when Source_Archive => raise Program_Error with "can't happen"; + + when System => This := New_System (Descr); end case; if Hashed then @@ -304,15 +310,19 @@ package body Alire.Origins is when VCS_Kinds => Table.Set (TOML_Keys.Origin, +(Prefixes (This.Kind).all & This.URL & "@" & This.Commit)); - when External | System => - raise Program_Error - with "external or system packages do not need to be exported"; + when External => + Table.Set (TOML_Keys.Origin, + +(Prefixes (This.Kind).all & (+This.Data.Description))); when Source_Archive => Table.Set (TOML_Keys.Origin, +This.Archive_URL); if This.Archive_Name /= "" then Table.Set (TOML_Keys.Archive_Name, +This.Archive_Name); end if; + + when System => + Table.Set (TOML_Keys.Origin, + +(Prefixes (This.Kind).all & This.Package_Name)); end case; if not This.Data.Hashes.Is_Empty then diff --git a/src/alire/alire-origins.ads b/src/alire/alire-origins.ads index d8bf2db4..27673a4a 100644 --- a/src/alire/alire-origins.ads +++ b/src/alire/alire-origins.ads @@ -25,6 +25,9 @@ package Alire.Origins with Preelaborate is subtype VCS_Kinds is Kinds range Git .. SVN; + subtype External_Kinds is Kinds + with Static_Predicate => External_Kinds in External | System; + type Source_Archive_Format is (Unknown, Tarball, Zip_Archive); subtype Known_Source_Archive_Format is Source_Archive_Format range Tarball .. Source_Archive_Format'Last; @@ -65,6 +68,11 @@ package Alire.Origins with Preelaborate is function Package_Name (This : Origin) return String with Pre => This.Kind = System; + function Is_Regular (This : Origin) return Boolean is + (This.Kind not in External | System); + -- A regular origin is one that is compiled from sources, instead of coming + -- from external definitions (detected or not). + function Short_Unique_Id (This : Origin) return String with Pre => This.Kind in Git | Hg | Source_Archive; @@ -265,18 +273,20 @@ private else " with hashes " & This.Image_Of_Hashes) ); - Prefix_Git : aliased constant String := "git+"; - Prefix_Hg : aliased constant String := "hg+"; - Prefix_SVN : aliased constant String := "svn+"; - Prefix_File : aliased constant String := "file://"; + Prefix_External : aliased constant String := "external:"; + Prefix_Git : aliased constant String := "git+"; + Prefix_Hg : aliased constant String := "hg+"; + Prefix_SVN : aliased constant String := "svn+"; + Prefix_File : aliased constant String := "file://"; + Prefix_System : aliased constant String := "system:"; Prefixes : constant Prefix_Array := (Git => Prefix_Git'Access, Hg => Prefix_Hg'Access, SVN => Prefix_SVN'Access, - External => null, + External => Prefix_External'Access, Filesystem => Prefix_File'Access, - System => null, + System => Prefix_System'Access, Source_Archive => null); end Alire.Origins; diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index bc284b25..f5f46906 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -151,7 +151,11 @@ package Alire.Releases with Preelaborate is function Properties (R : Release) return Conditional.Properties; function Origin (R : Release) return Origins.Origin; + function Available (R : Release) return Requisites.Tree; + function Is_Available (R : Release; + P : Alire.Properties.Vector) return Boolean; + -- Evaluate R.Availabel under platform properties P function Default_Executable (R : Release) return String; -- We encapsulate here the fixing of platform extension @@ -336,6 +340,10 @@ private function Available (R : Release) return Requisites.Tree is (R.Available); + function Is_Available (R : Release; + P : Alire.Properties.Vector) return Boolean + is (R.Available.Check (P)); + function Description (R : Release) return Description_String -- Image returns "Description: Blah" so we have to cut. is (Utils.Tail diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index fe4a12db..31452799 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -1,9 +1,12 @@ private with Alire.Containers; +private with Alire.Lockfiles; private with Alire.OS_Lib; private with Alire.Paths; + with Alire.Releases; +with Alire.Solutions; -package Alire.Roots with Preelaborate is +package Alire.Roots is -- Type used to encapsulate the information about the working context. -- Currently, this can either be: @@ -54,20 +57,24 @@ package Alire.Roots with Preelaborate is function Release (This : Root) return Releases.Release with Pre => This.Is_Valid; + function Solution (This : Root) return Solutions.Solution with + Pre => This.Is_Valid; + -- Returns the solution stored in the lockfile + -- files and folders derived from the root path (this obsoletes Alr.Paths) function Working_Folder (This : Root) return Absolute_Path with Pre => This.Is_Valid; -- The "alire" folder inside the root path - function Build_File (This : Root) return Absolute_Path with - Pre => This.Is_Valid; - -- The "alr_build.gpr" file inside Working_Folder - function Crate_File (This : Root) return Absolute_Path with Pre => This.Is_Valid; -- The "$crate.toml" file inside Working_Folder + function Lock_File (This : Root) return Absolute_Path with + Pre => This.Is_Valid; + -- The "$crate.lock" file inside Working_Folder + private type Root (Valid : Boolean) is tagged record @@ -109,10 +116,15 @@ private function Release (This : Root) return Releases.Release is (This.Release.Constant_Reference); + function Solution (This : Root) return Solutions.Solution is + (Lockfiles.Read (This.Lock_File)); + use OS_Lib; - function Build_File (This : Root) return Absolute_Path is - (This.Working_Folder / "alr_build.gpr"); + function Lock_File (This : Root) return Absolute_Path is + (Lockfiles.File_Name + (This.Release.Constant_Reference.Name, + +This.Path)); function Crate_File (This : Root) return Absolute_Path is (This.Working_Folder / diff --git a/src/alire/alire-solutions.adb b/src/alire/alire-solutions.adb new file mode 100644 index 00000000..da8eb403 --- /dev/null +++ b/src/alire/alire-solutions.adb @@ -0,0 +1,224 @@ +with Alire.Crates.With_Releases; +with Alire.Dependencies; +with Alire.Releases; + +package body Alire.Solutions is + + ---------- + -- Keys -- + ---------- + + package Keys 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"; + + end Keys; + + --------------- + -- From_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; + + --------------- + -- 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 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 + + -- 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; + + 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..."); + + -- Load proper releases, stored as a crate with a single release + + 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; + + -- Load external dependencies + + 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.Append + (Dependencies.From_TOML + (Key => +Externals.Keys (I), + Value => Externals.Get (Externals.Keys (I)))); + end loop; + end if; + end; + + return Outcome_Success; + 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 + + declare + 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); + 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; + + Root.Set (Keys.Externals, Externals); + end if; + end; + + end return; + end To_TOML; + +end Alire.Solutions; diff --git a/src/alire/alire-solutions.ads b/src/alire/alire-solutions.ads new file mode 100644 index 00000000..a6c45451 --- /dev/null +++ b/src/alire/alire-solutions.ads @@ -0,0 +1,70 @@ +with Alire.Containers; +with Alire.Interfaces; +with Alire.Properties; +with Alire.TOML_Adapters; + +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_List is Alire.Containers.Dependency_Lists.List; + + subtype Release_Map is Alire.Containers.Release_Map; + + 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_List; + -- Unresolved external dependencies + + when False => + null; + end case; + end record; + + Invalid_Solution : constant Solution; + Empty_Valid_Solution : constant Solution; + + 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 => (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 + +private + + Invalid_Solution : constant Solution := (Valid => False); + Empty_Valid_Solution : constant Solution := (Valid => True, others => <>); + +end Alire.Solutions; diff --git a/src/alr/alr-query.adb b/src/alire/alire-solver.adb similarity index 88% rename from src/alr/alr-query.adb rename to src/alire/alire-solver.adb index 2688e9e2..f0fbe26e 100644 --- a/src/alr/alr-query.adb +++ b/src/alire/alire-solver.adb @@ -2,32 +2,42 @@ with Ada.Containers; use Ada.Containers; with Ada.Containers.Indefinite_Doubly_Linked_Lists; with Alire.Conditional.Operations; +with Alire.Containers; with Alire.Dependencies; +with Alire.Milestones; with Alire.Origins.Deployers; with Alire.Utils; -with Alr.Commands; -with Alr.Parsers; -with Alr.Platform; - -package body Alr.Query is - - use Alire; +package body Alire.Solver is package Solution_Lists is new Ada.Containers.Indefinite_Doubly_Linked_Lists - (Solution); + (Solution, Solutions."="); package Semver renames Semantic_Versioning; use all type Semver.Extended.Version_Set; + subtype Dependency_List is Solutions.Dependency_List; + + subtype Release_Map is Alire.Containers.Release_Map; + -- Releases with a concrete version (source and detected external releases) + + Empty_Deps : constant Dependency_List := + Alire.Containers.Dependency_Lists.Empty_List; + + Empty_Map : constant Release_Map := + (Alire.Containers.Crate_Release_Maps.Empty_Map with null record); + --------- -- "&" -- --------- - function "&" (L : Dep_List; R : Dependencies.Dependency) return Dep_List is + function "&" (L : Dependency_List; + R : Dependencies.Dependency) + return Dependency_List + is begin - return Result : Dep_List := L do + return Result : Dependency_List := L do Result.Append (R); end return; end "&"; @@ -126,29 +136,23 @@ package body Alr.Query is function Find (Name : String; Policy : Age_Policies) return Release is - Spec : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Name); + Spec : constant Milestones.Allowed_Milestones := + Milestones.Crate_Versions (Name); begin return Find (Spec.Crate, Spec.Versions, Policy); end Find; - ------------------ - -- Is_Available -- - ------------------ - - function Is_Available (R : Alire.Index.Release) return Boolean is - (R.Available.Check (Platform.Properties)); - ------------------- -- Is_Resolvable -- ------------------- function Is_Resolvable (Deps : Types.Platform_Dependencies; + Props : Properties.Vector; Options : Query_Options := Default_Options) return Boolean - is (Resolve (Deps, Options).Valid); + is (Resolve (Deps, Props, Options).Valid); -------------------- -- Print_Solution -- @@ -177,7 +181,7 @@ package body Alr.Query is ------------------------ -- Declared for use with Materialize instance below. - procedure Add_Dep_Release (Sol : in out Instance; + procedure Add_Dep_Release (Sol : in out Release_Map; Dep : Types.Dependency; Count : Count_Type := 1) is @@ -188,7 +192,7 @@ package body Alr.Query is end if; Sol.Insert (Dep.Crate, - Find (Dep.Crate, Dep.Versions, Commands.Query_Policy)); + Find (Dep.Crate, Dep.Versions, Newest)); end Add_Dep_Release; ----------------- @@ -196,15 +200,16 @@ package body Alr.Query is ----------------- function Materialize is new Alire.Conditional.For_Dependencies.Materialize - (Instance, + (Release_Map, Add_Dep_Release); ----------------- -- Is_Complete -- ----------------- - function Is_Complete (Deps : Types.Platform_Dependencies; - Sol : Solution) + function Is_Complete (Deps : Types.Platform_Dependencies; + Props : Properties.Vector; + Sol : Solution) return Boolean is use Alire.Conditional.For_Dependencies; @@ -222,7 +227,7 @@ package body Alr.Query is -- Check in turn that the release dependencies are satisfied -- too. - return Is_Complete (R.Dependencies (Platform.Properties), Sol); + return Is_Complete (R.Dependencies (Props), Props, Sol); end if; end loop; @@ -252,7 +257,7 @@ package body Alr.Query is function Check_And_Vector return Boolean is begin for I in Deps.Iterate loop - if not Is_Complete (Deps (I), Sol) then + if not Is_Complete (Deps (I), Props, Sol) then return False; end if; end loop; @@ -266,7 +271,7 @@ package body Alr.Query is function Check_Or_Vector return Boolean is begin for I in Deps.Iterate loop - if Is_Complete (Deps (I), Sol) then + if Is_Complete (Deps (I), Props, Sol) then return True; end if; end loop; @@ -297,6 +302,7 @@ package body Alr.Query is ------------- function Resolve (Deps : Alire.Types.Platform_Dependencies; + Props : Properties.Vector; Options : Query_Options := Default_Options) return Solution is @@ -335,7 +341,7 @@ package body Alr.Query is -- Note: these Deps may include more than the ones requested to -- solve, as indirect dependencies are progressively added. begin - if Is_Complete (Deps, Sol) then + if Is_Complete (Deps, Props, Sol) then Solutions.Append (Sol); Trace.Debug ("SOLVER: solution FOUND for " & Deps.Image_One_Line); Print_Solution (Sol); @@ -346,13 +352,23 @@ package body Alr.Query is -- Expand -- ------------ - procedure Expand (Expanded, -- Nodes firmly in requisite tree - Current, -- Next node to consider - Remaining : -- Nodes pending to be considered - Types.Platform_Dependencies; - Frozen : Instance; -- Releases in current solution + procedure Expand (Expanded, + -- Nodes firmly in requisite tree + + Current, + -- Next node to consider + + Remaining : Types.Platform_Dependencies; + -- Nodes pending to be considered + + Frozen : Release_Map; + -- Releases in current solution + Forbidden : Types.Forbidden_Dependencies; - Hints : Dep_List) -- Externals that supply a dep + -- Releases that conflict with current solution + + Hints : Dependency_List) + -- Externals that supply a dependency is ------------------ @@ -434,7 +450,7 @@ package body Alr.Query is -- frozen crates, it is incompatible and we can discard it: elsif Cond_Ops.Contains_Some - (R.Forbids (Platform.Properties), Frozen) + (R.Forbids (Props), Frozen) then Trace.Debug ("SOLVER: discarding tree because " & @@ -454,7 +470,7 @@ package body Alr.Query is elsif -- First time we see this crate in the current branch. Dep.Versions.Contains (R.Version) and then - Is_Available (R) + R.Is_Available (Props) then Trace.Debug ("SOLVER: dependency FROZEN: " & R.Milestone.Image & @@ -463,21 +479,20 @@ package body Alr.Query is then " also providing " & (+R.Provides) else "") & " adding" & - R.Dependencies (Platform.Properties).Leaf_Count'Img & + R.Dependencies (Props).Leaf_Count'Img & " dependencies to tree " & Tree'(Expanded and Current and Remaining and R.Dependencies - (Platform.Properties)).Image_One_Line); + (Props)).Image_One_Line); - Expand - (Expanded and R.To_Dependency, - Remaining and R.Dependencies (Platform.Properties), - Empty, - Frozen.Inserting (R), - Forbidden and R.Forbids (Platform.Properties), - Hints); + 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 @@ -518,7 +533,7 @@ package body Alr.Query is -- below. if Options.Detecting = Detect then - Index.Add_Externals (Dep.Crate, Platform.Properties); + Index.Add_Externals (Dep.Crate, Props); end if; -- Check the releases now: @@ -606,7 +621,7 @@ package body Alr.Query is (Deps, Solution'(Valid => True, Releases => Materialize - (Expanded, Platform.Properties), + (Expanded, Props), Hints => Hints)); return; else @@ -636,14 +651,14 @@ package body Alr.Query is begin if Deps.Is_Empty then return Solution'(Valid => True, - Releases => Empty_Instance, + Releases => Empty_Map, Hints => Empty_Deps); end if; Expand (Expanded => Empty, Current => Deps, Remaining => Empty, - Frozen => Empty_Instance, + Frozen => Empty_Map, Forbidden => Empty, Hints => Empty_Deps); @@ -660,8 +675,9 @@ package body Alr.Query is then " and" & Solutions.First_Element.Hints.Length'Img & " external hints" else "")); + return Solutions.First_Element; end if; end Resolve; -end Alr.Query; +end Alire.Solver; diff --git a/src/alr/alr-query.ads b/src/alire/alire-solver.ads similarity index 71% rename from src/alr/alr-query.ads rename to src/alire/alire-solver.ads index a73429b6..882e39e0 100644 --- a/src/alr/alr-query.ads +++ b/src/alire/alire-solver.ads @@ -1,11 +1,18 @@ -with Alire.Containers; with Alire.Index; with Alire.Properties; +with Alire.Solutions; +with Alire.TOML_Adapters; with Alire.Types; with Semantic_Versioning.Extended; -package Alr.Query is +with TOML; + +package Alire.Solver is + + -------------- + -- Policies -- + -------------- type Age_Policies is (Oldest, Newest); -- When looking for releases within a crate, which one to try first. @@ -21,14 +28,10 @@ package Alr.Query is -- releases will be used normally; otherwise a crate with only externals -- will always cause failure. - subtype Dep_List is Alire.Containers.Dependency_Lists.List; - -- Dependency lists are used to keep track of failed dependencies - - subtype Instance is Alire.Containers.Release_Map; - -- A list of releases complying with a Solution - subtype Release is Types.Release; + 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 @@ -36,23 +39,6 @@ package Alr.Query is -- in resolution. In this case, a warning will be provided for the user -- with a list of the dependencies that are externally required. - type Solution (Valid : Boolean) is tagged record - case Valid is - when True => - Releases : Instance; -- Resolved dependencies to be deployed - Hints : Dep_List; -- Unresolved external dependencies - - when False => - null; - end case; - end record; - - Empty_Deps : constant Dep_List := - Alire.Containers.Dependency_Lists.Empty_List; - - Empty_Instance : constant Instance := - (Alire.Containers.Crate_Release_Maps.Empty_Map with null record); - --------------------- -- Basic queries -- -- Merely check the catalog @@ -83,17 +69,6 @@ package Alr.Query is Policy : Age_Policies) return Release; -- Given a textual crate+set (see Parsers), find the release if it exists - ---------------------------------- - -- Platform individual queries -- - -- Only need a release and the platform properties - - function Is_Available (R : Alire.Index.Release) return Boolean; - -- The release knows the requisites on the platform; here we evaluate these - -- against the current target. Current checks include the "available" - -- requisites and that the system package do exist. NOTE: it does not - -- consider that dependencies can be resolved, only that it "could" be - -- available. - ----------------------- -- Advanced queries -- -- They may need to travel the full catalog, with multiple individual @@ -108,10 +83,14 @@ package Alr.Query is Default_Options : constant Query_Options := (others => <>); function Resolve (Deps : Alire.Types.Platform_Dependencies; + Props : Properties.Vector; Options : Query_Options := Default_Options) return Solution; + -- Exhaustively look for a solution to the given dependencies, under the + -- given platform properties and lookup options. function Is_Resolvable (Deps : Types.Platform_Dependencies; + Props : Properties.Vector; Options : Query_Options := Default_Options) return Boolean; -- simplified call to Resolve, discarding result @@ -127,4 +106,4 @@ package Alr.Query is Versions : Semantic_Versioning.Extended.Version_Set; Policy : Age_Policies := Newest) return String; -end Alr.Query; +end Alire.Solver; diff --git a/src/alr/alr-build_env.adb b/src/alr/alr-build_env.adb index 0ec32804..ee3c667d 100644 --- a/src/alr/alr-build_env.adb +++ b/src/alr/alr-build_env.adb @@ -3,19 +3,22 @@ with Ada.Text_IO; with GNAT.OS_Lib; -with Alire.Utils; -with Alire.Properties.Scenarios; -with Alire.GPR; with Alire.Directories; +with Alire.GPR; +with Alire.Properties.Scenarios; +with Alire.Solutions; +with Alire.Solver; +with Alire.Utils; +with Alr.Commands; +with Alr.OS_Lib; with Alr.Platform; with Alr.Paths; -with Alr.OS_Lib; -with Alr.Query; -with Alr.Commands; package body Alr.Build_Env is + package Query renames Alire.Solver; + type Env_Var_Action_Callback is access procedure (Key, Val : String); Path_Separator : constant Character := GNAT.OS_Lib.Path_Separator; @@ -24,7 +27,7 @@ package body Alr.Build_Env is -- Project_Path -- ------------------ - function Project_Path (Instance : Query.Instance; + function Project_Path (Releases : Alire.Solutions.Release_Map; Root : Alire.Roots.Root) return String is @@ -41,7 +44,7 @@ package body Alr.Build_Env is First : Boolean := True; begin -- First obtain all paths and then output them, if any needed - for Rel of Instance.Including (Root.Release) loop + for Rel of Releases.Including (Root.Release) loop if Rel.Name = Root.Release.Name then -- All_Paths.Append ("."); null; -- That's the first path in aggregate projects anyway @@ -92,15 +95,16 @@ package body Alr.Build_Env is Action : not null Env_Var_Action_Callback) is Needed : constant Query.Solution := - Query.Resolve - (Root.Release.Dependencies.Evaluate (Platform.Properties), - Options => (Age => Commands.Query_Policy, - Detecting => <>, - Hinting => <>)); + Query.Resolve + (Root.Release.Dependencies.Evaluate (Platform.Properties), + Platform.Properties, + Options => (Age => Commands.Query_Policy, + Detecting => <>, + Hinting => <>)); Existing_Project_Path : GNAT.OS_Lib.String_Access; - Full_Instance : Query.Instance; + Full_Instance : Alire.Solutions.Release_Map; begin if not Needed.Valid then raise Command_Failed; diff --git a/src/alr/alr-checkout.adb b/src/alr/alr-checkout.adb index d8f3db1b..e0f7a982 100644 --- a/src/alr/alr-checkout.adb +++ b/src/alr/alr-checkout.adb @@ -4,6 +4,7 @@ with Alire; with Alire.Actions; with Alire.Containers; with Alire.Externals.Lists; +with Alire.Lockfiles; with Alire.Origins.Deployers; with Alire.Roots; @@ -57,18 +58,21 @@ package body Alr.Checkout is end if; end Checkout; - --------------- - -- To_Folder -- - --------------- + ------------------ + -- Dependencies -- + ------------------ - procedure To_Folder (Solution : Query.Solution; - Parent : String := Paths.Dependencies_Folder) + procedure Dependencies + (Root : Alire.Crate_Name; + Solution : Alire.Solver.Solution; + Root_Dir : Alire.Any_Path; + Deps_Dir : Alire.Absolute_Path := Paths.Dependencies_Folder) is Was_There : Boolean; Graph : Dependency_Graphs.Graph := Dependency_Graphs.From_Solution (Solution); - Pending : Query.Solution := Solution; - Round : Natural := 0; + Pending : Alire.Solver.Solution := Solution; + Round : Natural := 0; begin -- Notify about missing external dependencies: @@ -89,6 +93,14 @@ package body Alr.Checkout is ("They should be made available in the environment by the user."); end if; + -- Store given solution on disk + + Alire.Lockfiles.Write + (Solution, + Platform.Properties, + Alire.Lockfiles.File_Name (Name => Root, + Root_Dir => Root_Dir)); + -- Deploy resolved dependencies: while not Pending.Releases.Is_Empty loop @@ -105,9 +117,14 @@ package body Alr.Checkout is else Trace.Debug ("Round" & Round'Img & ": CHECKOUT ready " & Rel.Milestone.Image); - Checkout (Rel, Parent, Was_There); Graph := Graph.Removing_Dependee (Rel.Name); To_Remove.Include (Rel); + if Rel.Name /= Root then + Checkout (Rel, Deps_Dir, Was_There); + else + Trace.Debug + ("Skipping checkout of root crate as dependency"); + end if; end if; end loop; @@ -128,7 +145,7 @@ package body Alr.Checkout is end loop; return; - end To_Folder; + end Dependencies; ------------------ -- Working_Copy -- diff --git a/src/alr/alr-checkout.ads b/src/alr/alr-checkout.ads index e40455f2..0b1bcb8d 100644 --- a/src/alr/alr-checkout.ads +++ b/src/alr/alr-checkout.ads @@ -1,9 +1,9 @@ with Alire.Index; with Alire.Properties; with Alire.Releases; +with Alire.Solver; with Alr.Paths; -with Alr.Query; package Alr.Checkout is @@ -14,10 +14,14 @@ package Alr.Checkout is -- A working copy might not have alr and gpr files, that will be generated -- if needed. - procedure To_Folder (Solution : Query.Solution; - Parent : String := Paths.Dependencies_Folder); - -- Retrieves all releases into a folder, typically the main cache. - -- One release in the solution (typically the root release itself) can be - -- ignored. + procedure Dependencies + (Root : Alire.Crate_Name; + Solution : Alire.Solver.Solution; + Root_Dir : Alire.Any_Path; + Deps_Dir : Alire.Absolute_Path := Paths.Dependencies_Folder); + -- Retrieves all releases in a solution into a folder, typically the main + -- cache. Also creates the lockfile for the solution at the appropriate + -- place inside Root_Dir. If a crate in Solution matches Root, it will + -- be ignored. end Alr.Checkout; diff --git a/src/alr/alr-commands-get.adb b/src/alr/alr-commands-get.adb index 63e81dec..7e9a5233 100644 --- a/src/alr/alr-commands-get.adb +++ b/src/alr/alr-commands-get.adb @@ -1,25 +1,25 @@ with Ada.Directories; with Alire.Actions; -with Alire.Directories; with Alire.Index; +with Alire.Milestones; with Alire.Origins.Deployers; with Alire.Platform; with Alire.Platforms; +with Alire.Solver; with Alr.Actions; with Alr.Checkout; with Alr.Commands.Build; with Alr.Commands.Update; -with Alr.Parsers; with Alr.Platform; -with Alr.Query; with Alr.Bootstrap; with Semantic_Versioning.Extended; package body Alr.Commands.Get is + package Query renames Alire.Solver; package Semver renames Semantic_Versioning; use all type Bootstrap.Session_States; @@ -40,8 +40,9 @@ package body Alr.Commands.Get is Query.Find (Name, Versions, Query_Policy); begin if not Query.Is_Resolvable - (Rel.Dependencies.Evaluate (Platform.Properties)) - and then not Cmd.Only + (Rel.Dependencies.Evaluate (Platform.Properties), + Platform.Properties) + and then not Cmd.Only then Trace.Error ("Could not resolve dependencies for: " & Query.Dependency_Image (Name, Versions)); @@ -53,21 +54,23 @@ package body Alr.Commands.Get is end if; declare + R : constant Alire.Index.Release := + Query.Find (Name, Versions, Query_Policy); Result : Alire.Outcome; begin -- Check that itself is available (but overridable with --only) - if not Cmd.Only and then not Query.Is_Available (Rel) then + if not Cmd.Only and then not R.Is_Available (Platform.Properties) then Trace.Error ("The requested version (" - & Rel.Milestone.Image + & R.Milestone.Image & ") is not available"); Reportaise_Command_Failed ("You can retrieve it without dependencies with --only"); end if; -- Check if it's system first and thus we need not to check out. - if Rel.Origin.Is_System then - Result := Alire.Origins.Deployers.Deploy (Rel); + if R.Origin.Is_System then + Result := Alire.Origins.Deployers.Deploy (R); if Result.Success then return; else @@ -84,21 +87,9 @@ package body Alr.Commands.Get is -- Check out requested crate release under current directory, -- but delay its post-fetch: - declare - Root_Dir : Alire.Directories.Temp_File := - Alire.Directories.With_Name (Rel.Unique_Folder); - begin - Checkout.Working_Copy (Rel, - Ada.Directories.Current_Directory, - Perform_Actions => False); - - -- At this point, both crate and lock files must exist and - -- be correct, so the working session is correct. Errors with - -- dependencies can still occur, but these are outside of the - -- retrieved crate and might be corrected manipulating dependencies - -- and updating. - Root_Dir.Keep; - end; + Checkout.Working_Copy (Rel, + Ada.Directories.Current_Directory, + Perform_Actions => False); if Cmd.Only then Trace.Detail ("By your command, dependencies not resolved nor" & @@ -219,8 +210,8 @@ package body Alr.Commands.Get is end if; declare - Allowed : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Argument (1)); + Allowed : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (Argument (1)); begin if Cmd.Build and Cmd.Only then Reportaise_Wrong_Arguments diff --git a/src/alr/alr-commands-init.adb b/src/alr/alr-commands-init.adb index 68b77eea..c9bfa987 100644 --- a/src/alr/alr-commands-init.adb +++ b/src/alr/alr-commands-init.adb @@ -1,11 +1,14 @@ with Ada.Directories; with Ada.Text_IO; +with Alire.Lockfiles; +with Alire.Milestones; with Alire.Origins; with Alire.Releases; with Alire.Roots; +with Alire.Solutions; -with Alr.Parsers; +with Alr.Platform; with Alr.Root; with Alr.Templates; with Alr.Utils; @@ -171,6 +174,11 @@ package body Alr.Commands.Init is Templates.Generate_Prj_Alr (Root.Release, Root.Crate_File); + + Alire.Lockfiles.Write + (Alire.Solutions.Empty_Valid_Solution, + Platform.Properties, + Root.Lock_File); end; end Generate; @@ -198,8 +206,8 @@ package body Alr.Commands.Init is declare Name : constant String := Argument (1); - Check : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Name) + Check : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (Name) with Unreferenced; begin if Utils.To_Lower_Case (Name) diff --git a/src/alr/alr-commands-pin.adb b/src/alr/alr-commands-pin.adb index d06c648b..f8a19505 100644 --- a/src/alr/alr-commands-pin.adb +++ b/src/alr/alr-commands-pin.adb @@ -1,13 +1,15 @@ with Alire.Releases; +with Alire.Solver; with Alr.Commands.Update; with Alr.Platform; -with Alr.Query; with Alr.Root; with Alr.Templates; package body Alr.Commands.Pin is + package Solver renames Alire.Solver; + ------------- -- Execute -- ------------- @@ -20,12 +22,13 @@ package body Alr.Commands.Pin is Requires_Valid_Session; declare - Sol : constant Query.Solution := - Query.Resolve (Root.Current.Release.Dependencies - (Platform.Properties), - Options => (Age => Query_Policy, - Detecting => <>, - Hinting => <>)); + Sol : constant Solver.Solution := + Solver.Resolve + (Root.Current.Release.Dependencies (Platform.Properties), + Platform.Properties, + Options => (Age => Query_Policy, + Detecting => <>, + Hinting => <>)); begin if Sol.Valid then Templates.Generate_Prj_Alr diff --git a/src/alr/alr-commands-search.adb b/src/alr/alr-commands-search.adb index 03974374..57e7a9e6 100644 --- a/src/alr/alr-commands-search.adb +++ b/src/alr/alr-commands-search.adb @@ -6,9 +6,9 @@ with Alire.Index; with Alire.Origins.Deployers; with Alire.Crates.With_Releases; with Alire.Releases; +with Alire.Solver; with Alr.Platform; -with Alr.Query; with Alr.Utils; with Semantic_Versioning; @@ -29,7 +29,7 @@ package body Alr.Commands.Search is ------------------ procedure List_Release (R : Alire.Releases.Release) is - use Alr.Query; + package Solver renames Alire.Solver; use Solver; begin if (Cmd.Prop.all = "" or else @@ -45,16 +45,18 @@ package body Alr.Commands.Search is Found := Found + 1; Tab.New_Row; Tab.Append (+R.Name); - Tab.Append ((if R.Origin.Is_System then "S" else " ") & - (if Query.Is_Available (R) then " " else "U") & - (if R.Origin.Is_System then " " else - (if Query.Is_Resolvable - (R.Dependencies (Platform.Properties), - Options => (Age => Query_Policy, - Detecting => Dont_Detect, - Hinting => Hint)) - then " " - else "X"))); + Tab.Append + ((if R.Origin.Is_System then "S" else " ") & + (if R.Is_Available (Platform.Properties) then " " else "U") & + (if R.Origin.Is_System then " " else + (if Solver.Is_Resolvable + (R.Dependencies (Platform.Properties), + Platform.Properties, + Options => (Age => Query_Policy, + Detecting => Dont_Detect, + Hinting => Hint)) + then " " + else "X"))); Tab.Append (Semantic_Versioning.Image (R.Version)); Tab.Append (R.Description); Tab.Append (R.Notes); diff --git a/src/alr/alr-commands-show.adb b/src/alr/alr-commands-show.adb index f59d2179..c26ed9ce 100644 --- a/src/alr/alr-commands-show.adb +++ b/src/alr/alr-commands-show.adb @@ -1,6 +1,7 @@ with AAA.Table_IO; with Alire.Index; +with Alire.Milestones; with Alire.Origins.Deployers; with Alire.OS_Lib.Subprocess; with Alire.Platform; @@ -8,11 +9,11 @@ with Alire.Platforms; with Alire.Properties; with Alire.Requisites.Booleans; with Alire.Roots; +with Alire.Solver; with Alire.Utils; with Alr.Bootstrap; with Alr.Dependency_Graphs; -with Alr.Parsers; with Alr.Paths; with Alr.Platform; with Alr.Root; @@ -21,6 +22,7 @@ with Semantic_Versioning.Extended; package body Alr.Commands.Show is + package Query renames Alire.Solver; package Semver renames Semantic_Versioning; ---------------------------------- @@ -64,6 +66,7 @@ package body Alr.Commands.Show is Needed : Query.Solution := Query.Resolve (Rel.To_Dependency, + Platform.Properties, Options => (Age => Query_Policy, Detecting => <>, Hinting => <>)); @@ -264,10 +267,10 @@ package body Alr.Commands.Show is end if; declare - Allowed : constant Parsers.Allowed_Milestones := + Allowed : constant Alire.Milestones.Allowed_Milestones := (if Num_Arguments = 1 - then Parsers.Crate_Versions (Argument (1)) - else Parsers.Crate_Versions + then Alire.Milestones.Crate_Versions (Argument (1)) + else Alire.Milestones.Crate_Versions (Root.Current.Release.Milestone.Image)); begin if Num_Arguments = 1 and not Alire.Index.Exists (Allowed.Crate) then diff --git a/src/alr/alr-commands-test.adb b/src/alr/alr-commands-test.adb index bbaaf744..55a5384a 100644 --- a/src/alr/alr-commands-test.adb +++ b/src/alr/alr-commands-test.adb @@ -8,13 +8,13 @@ with Alire.Defaults; with Alire.Index; with Alire.OS_Lib.Subprocess; with Alire.Crates.With_Releases; +with Alire.Milestones; +with Alire.Solver; with Alire.Utils; with Alr.Files; with Alr.Paths; with Alr.Platform; -with Alr.Parsers; -with Alr.Query; with Alr.Testing.Collections; with Alr.Testing.Console; with Alr.Testing.JUnit; @@ -28,6 +28,8 @@ with GNATCOLL.VFS; package body Alr.Commands.Test is + package Query renames Alire.Solver; + Docker_Switch : constant String := "--docker"; ----------------- @@ -155,9 +157,10 @@ package body Alr.Commands.Test is Start := Clock; - Is_Available := Query.Is_Available (R); + Is_Available := R.Is_Available (Platform.Properties); Is_Resolvable := Query.Is_Resolvable - (R.Dependencies (Platform.Properties)); + (R.Dependencies (Platform.Properties), + Platform.Properties); if not Is_Available then Reporters.End_Test (R, Testing.Unavailable, Clock - Start, No_Log); @@ -292,8 +295,8 @@ package body Alr.Commands.Test is else for J in 1 .. Num_Arguments loop declare - Allowed : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Argument (J)); + Allowed : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (Argument (J)); Crate : constant Alire.Crates.With_Releases.Crate := Alire.Index.Crate (Allowed.Crate); Releases : constant Alire.Containers.Release_Set := @@ -353,8 +356,9 @@ package body Alr.Commands.Test is if not Cmd.Search then for I in 1 .. Num_Arguments loop declare - Cry_Me_A_River : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Argument (I)) with Unreferenced; + Cry_Me_A_River : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions + (Argument (I)) with Unreferenced; begin null; -- Just check that no exception is raised end; diff --git a/src/alr/alr-commands-update.adb b/src/alr/alr-commands-update.adb index 94d58e60..de9cea5c 100644 --- a/src/alr/alr-commands-update.adb +++ b/src/alr/alr-commands-update.adb @@ -1,8 +1,8 @@ with Alire.Paths; +with Alire.Solver; with Alr.Checkout; with Alr.Platform; -with Alr.Query; with Alr.Root; with GNAT.OS_Lib; @@ -12,6 +12,8 @@ package body Alr.Commands.Update is use all type Bootstrap.Session_States; + package Query renames Alire.Solver; + ------------- -- Upgrade -- ------------- @@ -28,6 +30,7 @@ package body Alr.Commands.Update is Query.Resolve (Root.Current.Release.Dependencies.Evaluate (Platform.Properties), + Platform.Properties, Options => (Age => Query_Policy, Detecting => <>, Hinting => <>)); @@ -35,7 +38,13 @@ package body Alr.Commands.Update is if not Needed.Valid then Reportaise_Command_Failed ("Update failed"); end if; - Checkout.To_Folder (Needed); + + -- Requires_Valid_Session ensures we are at the root working dir + + Checkout.Dependencies (Root => Root.Current.Release.Name, + Solution => Needed, + Root_Dir => OS_Lib.Current_Folder); + Trace.Detail ("Update completed"); end; end Upgrade; diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index f708da9c..8298da2d 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -4,13 +4,14 @@ with Ada.Strings.Maps; with Ada.Text_IO; with Alire.Conditional; +with Alire.Milestones; with Alire.Roots; +with Alire.Solver; with Alire.Utils; with Alr.Commands.Update; with Alr.Exceptions; with Alr.OS_Lib; -with Alr.Parsers; with Alr.Platform; with Alr.Root; with Alr.Templates; @@ -19,6 +20,8 @@ with Semantic_Versioning.Extended; package body Alr.Commands.Withing is + package Query renames Alire.Solver; + --------- -- Add -- --------- @@ -28,8 +31,8 @@ package body Alr.Commands.Withing is return Alire.Conditional.Dependencies is use all type Alire.Conditional.Dependencies; - Requested : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (New_Dep); + Requested : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (New_Dep); begin -- Check that the requested dependency exists @@ -57,7 +60,8 @@ package body Alr.Commands.Withing is Deps and Alire.Conditional.New_Dependency (Requested.Crate, Requested.Versions) do - if not Query.Is_Resolvable (Result.Evaluate (Platform.Properties)) + if not Query.Is_Resolvable (Result.Evaluate (Platform.Properties), + Platform.Properties) then Reportaise_Command_Failed ("Adding " & New_Dep & " has no dependency solution"); @@ -77,8 +81,8 @@ package body Alr.Commands.Withing is is use all type Alire.Conditional.Dependencies; use all type Semantic_Versioning.Extended.Version_Set; - Requested : constant Parsers.Allowed_Milestones := - Parsers.Crate_Versions (Old_Dep); + Requested : constant Alire.Milestones.Allowed_Milestones := + Alire.Milestones.Crate_Versions (Old_Dep); begin if Requested.Versions /= Semantic_Versioning.Extended.Any then Trace.Warning diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index 47bac8fa..b38ee54f 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -342,8 +342,10 @@ package body Alr.Commands is -- Query_Policy -- ------------------ - function Query_Policy return Query.Age_Policies is - (if Prefer_Oldest then Query.Oldest else Query.Newest); + function Query_Policy return Alire.Solver.Age_Policies is + (if Prefer_Oldest + then Alire.Solver.Oldest + else Alire.Solver.Newest); ------------------------------- -- Reportaise_Command_Failed -- diff --git a/src/alr/alr-commands.ads b/src/alr/alr-commands.ads index 33021bc9..cb429d30 100644 --- a/src/alr/alr-commands.ads +++ b/src/alr/alr-commands.ads @@ -1,10 +1,10 @@ with GNAT.Command_Line; with Alire.Directories; +with Alire.Solver; with Alire.Utils; with Alr.Bootstrap; -with Alr.Query; private with Ada.Text_IO; @@ -95,7 +95,7 @@ package Alr.Commands is function Is_Quiet return Boolean; -- Says if -q was in the command line - function Query_Policy return Query.Age_Policies; + function Query_Policy return Alire.Solver.Age_Policies; -- Current policy -- Declared here so they are available to the help metacommand child diff --git a/src/alr/alr-dependency_graphs.adb b/src/alr/alr-dependency_graphs.adb index 533317e9..5c4b7974 100644 --- a/src/alr/alr-dependency_graphs.adb +++ b/src/alr/alr-dependency_graphs.adb @@ -21,7 +21,7 @@ package body Alr.Dependency_Graphs is -- From_Instance -- ------------------- - function From_Solution (Sol : Query.Solution) return Graph is + function From_Solution (Sol : Alire.Solver.Solution) return Graph is begin return Result : Graph do for Rel of Sol.Releases loop diff --git a/src/alr/alr-dependency_graphs.ads b/src/alr/alr-dependency_graphs.ads index 1ab5620d..fff65153 100644 --- a/src/alr/alr-dependency_graphs.ads +++ b/src/alr/alr-dependency_graphs.ads @@ -1,8 +1,7 @@ with Ada.Containers.Indefinite_Ordered_Sets; with Alire.Containers; - -with Alr.Query; +with Alire.Solver; package Alr.Dependency_Graphs is @@ -10,7 +9,7 @@ package Alr.Dependency_Graphs is function Empty_Graph return Graph; - function From_Solution (Sol : Query.Solution) + function From_Solution (Sol : Alire.Solver.Solution) return Graph; function Including (This : Graph; diff --git a/src/alr/alr-parsers.ads b/src/alr/alr-parsers.ads deleted file mode 100644 index 8790bd1b..00000000 --- a/src/alr/alr-parsers.ads +++ /dev/null @@ -1,17 +0,0 @@ -with Alire; - -with Semantic_Versioning.Extended; - -package Alr.Parsers with Preelaborate is - - type Allowed_Milestones (Len : Positive) is record - Crate : Alire.Crate_Name (1 .. Len); - Versions : Semantic_Versioning.Extended.Version_Set; - end record; - - 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] - -end Alr.Parsers; diff --git a/testsuite/tests/get/external-tool-dependency/test.py b/testsuite/tests/get/external-tool-dependency/test.py index bccbb1ad..809d4ae1 100644 --- a/testsuite/tests/get/external-tool-dependency/test.py +++ b/testsuite/tests/get/external-tool-dependency/test.py @@ -13,6 +13,7 @@ assert_eq('', p.out) # Check folder contents compare(contents('main_1.0.0_filesystem/'), ['main_1.0.0_filesystem/alire', + 'main_1.0.0_filesystem/alire/main.lock', 'main_1.0.0_filesystem/alire/main.toml', 'main_1.0.0_filesystem/noop.gpr', 'main_1.0.0_filesystem/src', diff --git a/testsuite/tests/get/git-local/test.py b/testsuite/tests/get/git-local/test.py index eadee857..253ce26f 100644 --- a/testsuite/tests/get/git-local/test.py +++ b/testsuite/tests/get/git-local/test.py @@ -17,6 +17,7 @@ compare(list(filter contents('libfoo_1.0.0_9ddda32b'))), ['libfoo_1.0.0_9ddda32b/a', 'libfoo_1.0.0_9ddda32b/alire', + 'libfoo_1.0.0_9ddda32b/alire/libfoo.lock', 'libfoo_1.0.0_9ddda32b/alire/libfoo.toml', 'libfoo_1.0.0_9ddda32b/b', 'libfoo_1.0.0_9ddda32b/b/x', diff --git a/testsuite/tests/get/unpack-in-place/test.py b/testsuite/tests/get/unpack-in-place/test.py index 162c37a1..75e14201 100644 --- a/testsuite/tests/get/unpack-in-place/test.py +++ b/testsuite/tests/get/unpack-in-place/test.py @@ -10,6 +10,7 @@ from drivers.helpers import compare, contents run_alr('get', 'libhello=1.0.0-tarball') compare(contents('libhello_1.0.0_filesystem'), ['libhello_1.0.0_filesystem/alire', + 'libhello_1.0.0_filesystem/alire/libhello.lock', 'libhello_1.0.0_filesystem/alire/libhello.toml', 'libhello_1.0.0_filesystem/libhello.gpr', 'libhello_1.0.0_filesystem/src', diff --git a/testsuite/tests/workflows/init-options/test.py b/testsuite/tests/workflows/init-options/test.py index 77f1ea69..d0d305a9 100644 --- a/testsuite/tests/workflows/init-options/test.py +++ b/testsuite/tests/workflows/init-options/test.py @@ -12,6 +12,7 @@ from drivers.helpers import compare, contents # Plain init run_alr('init', '--bin', 'xxx') compare(contents('xxx'), ['xxx/alire', + 'xxx/alire/xxx.lock', 'xxx/alire/xxx.toml', 'xxx/src', 'xxx/src/xxx.adb', @@ -20,6 +21,7 @@ compare(contents('xxx'), ['xxx/alire', # Init without skeleton run_alr('init', '--bin', '--no-skel', 'yyy') compare(contents('yyy'), ['yyy/alire', + 'yyy/alire/yyy.lock', 'yyy/alire/yyy.toml']) # Init in place @@ -27,6 +29,7 @@ os.mkdir('zzz') os.chdir('zzz') run_alr('init', '--bin', '--in-place', 'zzz') compare(contents('.'), ['./alire', + './alire/zzz.lock', './alire/zzz.toml']) -- 2.39.5