Solver refactoring

.github/workflows/ci-toolchain.yml

@@ -102,7 +102,8 @@ jobs:
       run: ./bin/alr -d -n version | grep 'compiled with version' | grep -q '${{ matrix.gcc_version }}'
 
     - name: Update dependencies
-      run: ./bin/alr -d -n update
+      run: ./bin/alr -d -n -f update
+      # Force because otherwise solving may time out in non-interactive mode
 
     - name: Show dependencies/pins
       run: ./bin/alr -d -n -q with --solve || ./bin/alr -n -v -d with --solve
@@ -112,7 +113,9 @@ jobs:
 
     - name: Move ./bin to ./bin-old to allow for self-build
       shell: bash
-      run: mv ./bin ./bin-old || { sleep 5s && mv ./bin ./bin-old; }
+      run: |
+        mv ./bin ./bin-old || \
+        { sleep 5s && mv ./bin ./bin-old && echo Old moved on 2nd attempt; }
       # Windows doesn't allow to replace a running exe so the next command
       # fails otherwise. Also, this mv fails sometimes so we try twice JIC.
 

.gitmodules

@@ -57,6 +57,9 @@
 [submodule "deps/dirty_booleans"]
 	path = deps/dirty_booleans
 	url = https://github.com/mosteo/dirty_booleans
+[submodule "deps/compare_to_case"]
+	path = deps/compare_to_case
+	url = https://github.com/mosteo/compare_to_case
 [submodule "deps/den"]
 	path = deps/den
 	url = https://github.com/mosteo/den
@@ -65,4 +68,4 @@
 	url = https://github.com/mosteo/cstrings
 [submodule "deps/lml"]
 	path = deps/lml
-	url = https://github.com/mosteo/lml_ada.git
+	url = https://github.com/mosteo/lml_ada

TODO

@@ -0,0 +1 @@
+- Test of solver timeout behaviors

alire.gpr

@@ -5,6 +5,7 @@ with "ajunitgen";
 with "ansiada";
 with "c_strings";
 with "clic";
+with "compare_to_case";
 with "den";
 with "dirty_booleans";
 with "diskflags";

alire.toml

@@ -21,6 +21,7 @@ ajunitgen = "^1.0.1"
 ansiada = "^1.1"
 c_strings = "^1.0"
 clic = "~0.3"
+compare_to_case = "~0.1"
 den = "~0.1"
 dirty_booleans = "~0.1"
 diskflags = "~0.1"
@@ -51,7 +52,6 @@ windows = { ALIRE_OS = "windows" }
 
 # Some dependencies require precise versions during the development cycle:
 [[pins]]
-
 [pins.aaa]
 url    = "https://github.com/mosteo/aaa"
 commit = "ddfeffe2d6c8f9d19161df7b31d16d37bef4ba71"
@@ -72,6 +72,10 @@ commit = "e4d58ad90bf32bc44304197e5906a519f5a9a7bf"
 url    = "https://github.com/alire-project/clic"
 commit = "56bbdc008e16996b6f76e443fd0165a240de1b13"
 
+[pins.compare_to_case]
+url    = "https://github.com/mosteo/compare_to_case"
+commit = "7934e319711995cf5960774f938c4d3ab5e0b7b6"
+
 [pins.den]
 url    = "https://github.com/mosteo/den"
 commit = "653a4c9ba4469d7e1a8896088789b6514ecdf834"
@@ -127,3 +131,4 @@ command = ["pwsh", "scripts/version-patcher.ps1"]
 [actions.'case(os)'.'...']
 type = "pre-build"
 command = ["scripts/version-patcher.sh"]
+

alr_env.gpr

@@ -14,6 +14,7 @@ aggregate project Alr_Env is
                          "deps/ajunitgen",
                          "deps/ansi",
                          "deps/clic",
+                         "deps/compare_to_case",
                          "deps/cstrings",
                          "deps/den",
                          "deps/dirty_booleans",

src/alire/alire-conditional_trees.ads

@@ -90,7 +90,6 @@ package Alire.Conditional_Trees with Preelaborate is
    with Post'Class => Flatten'Result.Is_Empty or else
                       Flatten'Result.Is_Value or else
                       Flatten'Result.Is_Vector;
-   --  Above Post kept for reference but gnat bugs out during instantiation.
    --  Recursively merge all subtree elements in a single value or vector. It
    --  can result in an empty tree if a vector is empty, so it returns a tree.
 

src/alire/alire-releases-containers.ads

@@ -14,6 +14,9 @@ package Alire.Releases.Containers is
                                                      Release_Image);
    subtype Optional is Optional_Releases.Optional;
 
+   function Unit (Element : Releases.Release) return Optional
+                  renames Optional_Releases.Unit;
+
    package Release_Sets
    is new Ada.Containers.Indefinite_Ordered_Sets (Releases.Release,
                                                   Releases."<",

src/alire/alire-solutions.adb

@@ -6,10 +6,8 @@ with Alire.Dependencies.Diffs;
 with Alire.Dependencies.Graphs;
 with Alire.Errors;
 with Alire.Index;
-with Alire.Milestones;
 with Alire.Root;
 with Alire.Solutions.Diffs;
-with Alire.Toolchains;
 with Alire.Utils.Tables;
 with Alire.Utils.Tools;
 with Alire.Utils.TTY;
@@ -21,6 +19,7 @@ package body Alire.Solutions is
    package Semver renames Semantic_Versioning;
 
    use type Ada.Containers.Count_Type;
+   use type Alire.Releases.Release;
    use type Semantic_Versioning.Version;
    use all type States.Missed_Reasons;
 
@@ -51,6 +50,26 @@ package body Alire.Solutions is
        else
           Mixed);
 
+   --------------
+   -- Contains --
+   --------------
+
+   function Contains (This    : Solution;
+                      Release : Alire.Releases.Release) return Boolean
+   is (for some Rel of This.Releases => Rel = Release);
+
+   --------------
+   -- Contains --
+   --------------
+
+   function Contains (This    : Solution;
+                      Release : Milestones.Milestone) return Boolean
+   is
+      use type Milestones.Milestone;
+   begin
+      return (for some Rel of This.Releases => Rel.Milestone = Release);
+   end Contains;
+
    ----------------------
    -- Contains_Release --
    ----------------------
@@ -59,6 +78,16 @@ package body Alire.Solutions is
                               Crate : Crate_Name) return Boolean
    is (This.Depends_On (Crate) and then This.State (Crate).Has_Release);
 
+   ---------------------------
+   -- Contains_Incompatible --
+   ---------------------------
+
+   function Contains_Incompatible (This    : Solution;
+                                   Release : Alire.Releases.Release)
+                                   return Boolean
+   is (for some Dep of This.Dependencies =>
+          Dep.Has_Release and then Release.Satisfies (Dep));
+
    ----------------
    -- Dependency --
    ----------------
@@ -92,6 +121,14 @@ package body Alire.Solutions is
       return Result;
    end Excluding;
 
+   -------------------------
+   -- Depends_Directly_On --
+   -------------------------
+
+   function Depends_Directly_On (This : Solution;
+                                 Name : Crate_Name) return Boolean
+   is (This.Dependencies.Contains (Name));
+
    ----------------
    -- Depends_On --
    ----------------
@@ -111,15 +148,6 @@ package body Alire.Solutions is
                         Release : Alire.Releases.Release) return Boolean
    is (for some Dep of This.Dependencies => Release.Provides (Dep.Crate));
 
-   ------------------------------
-   -- Depends_On_Specific_GNAT --
-   ------------------------------
-
-   function Depends_On_Specific_GNAT (This : Solution) return Boolean
-   is (This.Releases.Contains_Or_Provides (GNAT_Crate) and then
-         (for some Rel of This.Releases.Elements_Providing (GNAT_Crate) =>
-               Rel.Name /= GNAT_Crate));
-
    ----------------------------
    -- Empty_Invalid_Solution --
    ----------------------------
@@ -241,6 +269,17 @@ package body Alire.Solutions is
                       return Boolean
    is (for some Solved of This.Releases => Solved.Provides (Release));
 
+   ---------------
+   -- Satisfies --
+   ---------------
+
+   function Satisfies (This : Solution;
+                       Dep  : Dependencies.Dependency'Class)
+                       return Boolean
+   is (This.Links.Contains (Dep.Crate)
+       or else
+         (for some Solved of This.Releases => Solved.Satisfies (Dep)));
+
    ---------------
    -- Resetting --
    ---------------
@@ -409,18 +448,48 @@ package body Alire.Solutions is
                      Env     : Properties.Vector)
                      return Boolean
    is
+      use type Milestones.Milestone;
    begin
       return
-       --  Some of the releases in the solution forbid this one release
-       ((for some Solved of This.Releases =>
-          (for some Dep of Solved.Forbidden (Env) =>
-                Release.Satisfies (Dep.Value)))
-       or else
-       --  The candidate release forbids something in the solution
-          (for some Dep of Release.Forbidden (Env) =>
-               (for some Rel of This.Releases => Rel.Satisfies (Dep.Value))));
+        --  Some of the releases in the solution forbid this one release
+        (for all Solved of This.Releases =>
+           Solved.Milestone /= Release.Milestone)
+        and then
+          ((for some Solved of This.Releases =>
+              (for some Dep of Solved.Forbidden (Env) =>
+                   Release.Satisfies (Dep.Value)))
+           or else
+           --  The candidate release forbids something in the solution
+           (for some Dep of Release.Forbidden (Env) =>
+              (for some Rel of This.Releases => Rel.Satisfies (Dep.Value))));
    end Forbids;
 
+   --------------------
+   -- Image_One_Line --
+   --------------------
+
+   function Image_One_Line (This : Solution) return String is
+      use UStrings;
+      Result : UString;
+      First  : Boolean := True;
+   begin
+      for State of This.Dependencies loop
+         if First then
+            First := False;
+         else
+            Result := Result & "; ";
+         end if;
+
+         if State.Has_Release then
+            Append (Result, State.Release.Milestone.TTY_Image);
+         else
+            Append (Result, State.TTY_Image);
+         end if;
+      end loop;
+
+      return +Result;
+   end Image_One_Line;
+
    ---------------
    -- Including --
    ---------------
@@ -508,27 +577,6 @@ package body Alire.Solutions is
          --  TODO: instead of using the first discrepancy, we should count all
          --  differences and see which one is globally "newer".
 
-         --  Prefer one with an installed compiler
-
-         for Rel_L of This.Releases loop
-            if Rel_L.Provides (GNAT_Crate) then
-               for Rel_R of Than.Releases loop
-                  if Rel_R.Provides (GNAT_Crate) then
-                     if Toolchains.Available.Contains (Rel_L)
-                       xor Toolchains.Available.Contains (Rel_R)
-                     then
-                        return (if Toolchains.Available.Contains (Rel_L)
-                                then Better
-                                else Worse);
-                     else
-                        exit; -- No need to keep checking, 1 compiler in sol
-                     end if;
-                  end if;
-               end loop;
-               exit; -- No need to keep checking, only 1 compiler in sol
-            end if;
-         end loop;
-
          --  Check releases in both only
 
          for Rel of This.Releases loop

src/alire/alire-solutions.ads

@@ -3,6 +3,7 @@ with Alire.Containers;
 with Alire.Dependencies.Containers;
 with Alire.Dependencies.States.Maps;
 with Alire.Interfaces;
+with Alire.Milestones;
 with Alire.Optional;
 with Alire.Properties;
 with Alire.Releases.Containers;
@@ -186,11 +187,25 @@ package Alire.Solutions is
 
    function Composition (This : Solution) return Compositions;
 
+   function Contains (This    : Solution;
+                      Release : Alire.Releases.Release) return Boolean;
+   --  Say if the solution contains exactly this release
+
+   function Contains (This    : Solution;
+                      Release : Milestones.Milestone) return Boolean;
+
    function Contains_Release (This  : Solution;
                               Crate : Crate_Name) return Boolean;
    --  Say if Crate is among the releases (solved or linked) for this solution.
    --  It will return False if the solution does not even depend on Crate.
 
+   function Contains_Incompatible (This    : Solution;
+                                   Release : Alire.Releases.Release)
+                                   return Boolean;
+   --  Say if this solution already contains a release for a dependency
+   --  provided by the given release; in which case Release cannot be added
+   --  to this solution for a different dependency.
+
    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.
@@ -221,6 +236,10 @@ package Alire.Solutions is
    --  This function allows identifying the concrete dependency that a solved
    --  release introduced in the solution.
 
+   function Depends_Directly_On (This : Solution;
+                                 Name : Crate_Name) return Boolean;
+   --  Says if Name is one of the dependency state keys in solution
+
    function Depends_On (This : Solution;
                         Name : Crate_Name) return Boolean;
    --  Says if the solution depends on the crate in some way. Will also
@@ -230,9 +249,6 @@ package Alire.Solutions is
                         Release : Alire.Releases.Release) return Boolean;
    --  Likewise, but take also into account the Release.Provides
 
-   function Depends_On_Specific_GNAT (This : Solution) return Boolean;
-   --  Say if the solution contains a release which is a gnat_something
-
    function Forbidden (This : Solution;
                        Env  : Properties.Vector)
                        return Dependency_Map;
@@ -250,6 +266,12 @@ package Alire.Solutions is
    --  Check whether the solution already contains or provides a release
    --  equivalent to Release.
 
+   function Satisfies (This : Solution;
+                       Dep  : Dependencies.Dependency'Class)
+                       return Boolean;
+   --  Say if some release already in solution will satisfy Dep, either
+   --  directly, via provides, or via link.
+
    function Dependencies_Providing (This  : Solution;
                                     Crate : Crate_Name)
                                     return State_Map;
@@ -346,6 +368,10 @@ package Alire.Solutions is
    -- I/O --
    ---------
 
+   function Image_One_Line (This : Solution) return String;
+   --  Simplified representation containing only solved milestones or unsolved
+   --  dependencies
+
    procedure Print (This     : Solution;
                     Root     : Alire.Releases.Release;
                     Env      : Properties.Vector;