From 821fecb14441acf9cc90fad6d483108a7ee1cd74 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Fri, 5 Mar 2021 16:52:04 +0100 Subject: [PATCH] Remove Alire.Requisites and Alire.Boolean_Trees (#701) * Availability as conditional tree * Refactor up to Alire.Releases * It builds for all of Alire.* * It completely builds * Testsuite passing, minor cosmetic fixes There is a minor improvement for trees in which a vector with a single value is promoted to the single value itself. As vectors are delimited by '(' ')', there are a few test outputs that required eliminating these former extra parentheses. * Dead code removal related to old Ada index * Case exprs excised from Requisites This allows more dead code removal and some further internal simplifications. * Removed Requisites and all related dead code No longer needed, Requisites were useful in the old index for general expressions, but not anymore in our case-restricted index. Some quite obscure portions of Alire code can be thus removed. * Bring gnatelim up to date It bugboxes anyway, so it's not currently usable * Stetic tweaks found during selfreview --- elim/alr.gpr | 2 + src/alire/alire-boolean_trees.adb | 220 ------------------ src/alire/alire-boolean_trees.ads | 103 -------- src/alire/alire-conditional.adb | 74 +++++- src/alire/alire-conditional.ads | 68 ++++++ src/alire/alire-conditional_trees-cases.adb | 8 +- src/alire/alire-conditional_trees-cases.ads | 6 +- src/alire/alire-conditional_trees.adb | 151 +++--------- src/alire/alire-conditional_trees.ads | 96 +------- src/alire/alire-crates.adb | 4 +- src/alire/alire-crates.ads | 1 - src/alire/alire-externals-from_output.adb | 1 - src/alire/alire-externals-from_system.adb | 1 - src/alire/alire-externals-lists.adb | 4 +- src/alire/alire-externals.adb | 9 +- src/alire/alire-externals.ads | 5 +- src/alire/alire-index.ads | 1 - src/alire/alire-properties-cases.ads | 29 +++ src/alire/alire-properties-platform.ads | 34 +++ src/alire/alire-releases.adb | 49 +--- src/alire/alire-releases.ads | 24 +- src/alire/alire-requisites-booleans.adb | 18 -- src/alire/alire-requisites-booleans.ads | 55 ----- src/alire/alire-requisites-cases.adb | 107 --------- src/alire/alire-requisites-cases.ads | 91 -------- src/alire/alire-requisites-comparables.ads | 119 ---------- src/alire/alire-requisites-platform.ads | 84 ------- src/alire/alire-requisites.adb | 37 --- src/alire/alire-requisites.ads | 132 ----------- src/alire/alire-roots.ads | 1 - src/alire/alire-toml_expressions-cases.adb | 144 +++++------- src/alire/alire-toml_expressions-cases.ads | 4 +- src/alire/alire-toml_expressions.ads | 6 +- src/alire/alire-toml_index.ads | 1 - src/alire/alire-toml_load.adb | 28 ++- src/alire/alire-toml_load.ads | 3 +- src/alr/alr-commands-show.adb | 8 +- .../tests/index/case-expressions/test.py | 6 +- testsuite/tests/index/environment/test.py | 2 +- testsuite/tests/show/jekyll/test.py | 2 +- .../tests/with/dynamic-dependencies/test.py | 6 +- 41 files changed, 351 insertions(+), 1393 deletions(-) delete mode 100644 src/alire/alire-boolean_trees.adb delete mode 100644 src/alire/alire-boolean_trees.ads create mode 100644 src/alire/alire-properties-cases.ads delete mode 100644 src/alire/alire-requisites-booleans.adb delete mode 100644 src/alire/alire-requisites-booleans.ads delete mode 100644 src/alire/alire-requisites-cases.adb delete mode 100644 src/alire/alire-requisites-cases.ads delete mode 100644 src/alire/alire-requisites-comparables.ads delete mode 100644 src/alire/alire-requisites-platform.ads delete mode 100644 src/alire/alire-requisites.adb delete mode 100644 src/alire/alire-requisites.ads diff --git a/elim/alr.gpr b/elim/alr.gpr index a1379214..03e10dfd 100644 --- a/elim/alr.gpr +++ b/elim/alr.gpr @@ -1,10 +1,12 @@ with "../deps/aaa/aaa"; with "../deps/ada-toml/ada_toml"; +with "../deps/ansi/ansi"; with "alire"; with "../alire_common"; with "ajunitgen"; with "../deps/semantic_versioning/semantic_versioning"; with "../deps/simple_logging/simple_logging"; +with "../deps/spdx/spdx"; with "../deps/xmlezout/xml_ez_out"; project Alr is diff --git a/src/alire/alire-boolean_trees.adb b/src/alire/alire-boolean_trees.adb deleted file mode 100644 index 7abc344b..00000000 --- a/src/alire/alire-boolean_trees.adb +++ /dev/null @@ -1,220 +0,0 @@ -with Ada.Containers; use Ada.Containers; - -with GNAT.IO; - -package body Alire.Boolean_Trees is - - function Merge_Under (N : Node; - L, R : Tree := Empty_Tree) - return Tree; - - function Image_Recursive (C : Trees.Cursor; - Skeleton : Boolean) - return String; - ---------- - -- Leaf -- - ---------- - - function Leaf (C : Condition) return Tree is - begin - return T : Tree do - T.Append_Child (T.Root, Node'(Leaf, Conditions.To_Holder (C))); - end return; - end Leaf; - - ----------------- - -- Merge_Under -- - ----------------- - - function Merge_Under (N : Node; - L, R : Tree := Empty_Tree) - return Tree - is - use Trees; - begin - return T : Tree do - T.Append_Child (Parent => T.Root, New_Item => N); - - declare - Op : constant Cursor := First_Child (T.Root); - begin - pragma Assert (Element (Op) = N); - - if L /= Empty_Tree then - T.Copy_Subtree (Parent => Op, - Before => No_Element, - Source => First_Child (L.Root)); - end if; - - if R /= Empty_Tree then - T.Copy_Subtree (Parent => Op, - Before => No_Element, - Source => First_Child (R.Root)); - end if; - end; - end return; - end Merge_Under; - - ----------- - -- "and" -- - ----------- - - function "and" (L, R : Tree) return Tree is - begin - if L.Is_Empty and then R.Is_Empty then - return Empty_Tree; - elsif L.Is_Empty then - return R; - elsif R.Is_Empty then - return L; - else - return Merge_Under (Node'(Kind => And_Node), L, R); - end if; - end "and"; - - ---------- - -- "or" -- - ---------- - - function "or" (L, R : Tree) return Tree is - begin - if L.Is_Empty and then R.Is_Empty then - return Empty_Tree; - elsif L.Is_Empty then - return R; - elsif R.Is_Empty then - return L; - else - return Merge_Under (Node'(Kind => Or_Node), L, R); - end if; - end "or"; - - ----------- - -- "not" -- - ----------- - - function "not" (T : Tree) return Tree is - begin - return Merge_Under (Node'(Kind => Not_Node), T); - end "not"; - - ----------- - -- Check -- - ----------- - - function Check (T : Tree; - V : Value; - If_Empty : Boolean := True) - return Boolean - is - - function Check (C : Trees.Cursor) return Boolean; - - ----------- - -- Check -- - ----------- - - function Check (C : Trees.Cursor) return Boolean is - N : constant Node := Trees.Element (C); - begin - case N.Kind is - when Leaf => - return Check (N.Condition.Element, V); - when And_Node => - return Check (Trees.First_Child (C)) - and then - Check (Trees.Last_Child (C)); - when Or_Node => - return Check (Trees.First_Child (C)) - or else - Check (Trees.Last_Child (C)); - when Not_Node => - return not Check (Trees.First_Child (C)); - end case; - end Check; - - begin - if T.Is_Empty then - return If_Empty; - else - return Check (Trees.First_Child (T.Root)); - end if; - end Check; - - --------------------- - -- Image_Recursive -- - --------------------- - - function Image_Recursive (C : Trees.Cursor; - Skeleton : Boolean) - return String - is - N : constant Node := Trees.Element (C); - begin - case N.Kind is - when Leaf => - if Skeleton then - return "Leaf"; - else - return Image (N.Condition.Constant_Reference); - end if; - when And_Node => - return "(" & Image_Recursive (Trees.First_Child (C), Skeleton) & - " and " & - Image_Recursive (Trees.Last_Child (C), Skeleton) & ")"; - when Or_Node => - return "(" & Image_Recursive (Trees.First_Child (C), Skeleton) & - " or " & - Image_Recursive (Trees.Last_Child (C), Skeleton) & ")"; - when Not_Node => - return "(not " & - Image_Recursive (Trees.First_Child (C), Skeleton) & ")"; - end case; - end Image_Recursive; - - ----------- - -- Image -- - ----------- - - function Image (T : Tree) return String is - begin - if T.Is_Empty then - return "(empty tree)"; - else - return Image_Recursive - (Trees.First_Child (T.Root), Skeleton => False); - end if; - end Image; - - ----------- - -- Print -- - ----------- - - procedure Print (T : Tree) is - begin - GNAT.IO.Put_Line (T.Image); - end Print; - - -------------------- - -- Image_Skeleton -- - -------------------- - - function Image_Skeleton (T : Tree) return String is - begin - if T.Is_Empty then - return "(empty tree)"; - else - return Image_Recursive (Trees.First_Child (T.Root), Skeleton => True); - end if; - end Image_Skeleton; - - -------------------- - -- Print_Skeleton -- - -------------------- - - procedure Print_Skeleton (T : Tree) is - begin - GNAT.IO.Put_Line (T.Image_Skeleton); - end Print_Skeleton; - -end Alire.Boolean_Trees; diff --git a/src/alire/alire-boolean_trees.ads b/src/alire/alire-boolean_trees.ads deleted file mode 100644 index 48319fc5..00000000 --- a/src/alire/alire-boolean_trees.ads +++ /dev/null @@ -1,103 +0,0 @@ -private with Ada.Containers.Indefinite_Holders; -private with Ada.Containers.Indefinite_Multiway_Trees; - -with Alire.Interfaces; - -with TOML; - -generic - type Value (<>) is private; - type Condition (<>) is new Interfaces.Tomifiable with private; - with function Check (C : Condition; V : Value) return Boolean; - with function Image (C : Condition) return String; -package Alire.Boolean_Trees with Preelaborate is - - -- A package to represent trees of logical expressions - - type Tree is new Interfaces.Tomifiable with private; - - Empty_Tree : constant Tree; - - -- Tree building - - function Leaf (C : Condition) return Tree; - function "+" (C : Condition) return Tree renames Leaf; - - function "and" (L, R : Tree) return Tree; - - function "and" (L : Tree; R : Condition) return Tree - is (L and Leaf (R)); - - function "and" (L : Condition; R : Tree) return Tree - is (Leaf (L) and R); - - function "and" (L : Condition; R : Condition) return Tree - is (Leaf (L) and Leaf (R)); - - function "or" (L, R : Tree) return Tree; - - function "or" (L : Tree; R : Condition) return Tree - is (L or Leaf (R)); - - function "or" (L : Condition; R : Tree) return Tree - is (Leaf (L) or R); - - function "or" (L : Condition; R : Condition) return Tree - is (Leaf (L) or Leaf (R)); - - function "not" (T : Tree) return Tree - with Pre => T /= Empty_Tree; - function "not" (C : Condition) return Tree is (not Leaf (C)); - - -- Tree evaluation - - function Check (T : Tree; - V : Value; - If_Empty : Boolean := True) - return Boolean; - - -- Access - - function Is_Empty (T : Tree) return Boolean; - - -- Debugging - - function Image_Skeleton (T : Tree) return String; - procedure Print_Skeleton (T : Tree); - - function Image (T : Tree) return String; - procedure Print (T : Tree); - -private - - type Node_Kinds is (Leaf, And_Node, Or_Node, Not_Node); - - package Values is new Ada.Containers.Indefinite_Holders (Value); - package Conditions is new Ada.Containers.Indefinite_Holders (Condition); - - type Node (Kind : Node_Kinds) is record - case Kind is - when Leaf => - Condition : Conditions.Holder; - when others => - null; - end case; - end record; - - package Trees is new Ada.Containers.Indefinite_Multiway_Trees (Node); - - type Tree is new Trees.Tree and Interfaces.Tomifiable with null record; - - overriding - function To_TOML (This : Tree) return TOML.TOML_Value is - (case Trees.First_Child_Element (This.Root).Kind is - when Leaf => Trees.First_Child_Element (This.Root) - .Condition.Constant_Reference.To_TOML, - when others => raise Unimplemented); - - overriding function Is_Empty (T : Tree) return Boolean - is (Trees.Is_Empty (Trees.Tree (T))); - - Empty_Tree : constant Tree := (Trees.Empty_Tree with null record); - -end Alire.Boolean_Trees; diff --git a/src/alire/alire-conditional.adb b/src/alire/alire-conditional.adb index e09ff65d..07847a01 100644 --- a/src/alire/alire-conditional.adb +++ b/src/alire/alire-conditional.adb @@ -1,10 +1,28 @@ -with TOML; - package body Alire.Conditional is - --------------- - -- From_TOML -- - --------------- + ------------------------- + -- Available_From_TOML -- + ------------------------- + + function Available_From_TOML (From : TOML_Adapters.Key_Queue) + return For_Available.Tree + is + begin + if From.Unwrap.Is_Null or else From.Unwrap.Keys'Length = 0 then + return For_Available.Empty; + else + return For_Available.New_Value + (Available' + (Is_Available => + From.Checked_Pop + (TOML_Keys.Available, + TOML.TOML_Boolean).As_Boolean)); + end if; + end Available_From_TOML; + + -------------------- + -- Deps_From_TOML -- + -------------------- function Deps_From_TOML (From : TOML_Adapters.Key_Queue) return Dependencies is @@ -19,4 +37,50 @@ package body Alire.Conditional is end return; end Deps_From_TOML; + ------------------ + -- Is_Available -- + ------------------ + + function Is_Available (This : Availability; + Env : Alire.Properties.Vector) + return Boolean + is + Tree : constant Availability := This. Evaluate (Env); + + ------------------- + -- Eval_Children -- + ------------------- + + function Eval_Children (T : For_Available.Tree) return Boolean is + use For_Available; + begin + if T.Root in Leaf_Node'Class then + return T.Value.Is_Available; + else + return Result : Boolean := True do + for Child of T loop + case T.Conjunction is + when Anded => Result := Result and Eval_Children (Child); + when Ored => Result := Result or Eval_Children (Child); + end case; + end loop; + end return; + end if; + end Eval_Children; + + begin + + -- Trivial case out of the way + + if This.Is_Empty or else Tree.Is_Empty then + return True; + end if; + + -- After evaluation, the tree is made of values/vectors that we can + -- recursively evaluate. + + return Eval_Children (For_Available.Tree (Tree)); + + end Is_Available; + end Alire.Conditional; diff --git a/src/alire/alire-conditional.ads b/src/alire/alire-conditional.ads index 89294f1f..f6042773 100644 --- a/src/alire/alire-conditional.ads +++ b/src/alire/alire-conditional.ads @@ -1,10 +1,14 @@ with Alire.Conditional_Trees; with Alire.Dependencies.Containers; +with Alire.Interfaces; with Alire.Properties; with Alire.TOML_Adapters; +with Alire.TOML_Keys; with Semantic_Versioning.Extended; +with TOML; + package Alire.Conditional with Preelaborate is ------------------ @@ -79,6 +83,56 @@ package Alire.Conditional with Preelaborate is -- From is always a table "prop-name = whatever". -- These may raise Checked_Error. + -------------------- + -- Availability -- + -------------------- + + -- We reuse the conditional trees for availability. This was not possible + -- in the general Ada index, but it is now with the more limited case + -- expressions. This allows removing the separate hierarchy of code + -- that was formerly used only for availability. + + type Available is + new Interfaces.Classificable + and Interfaces.Tomifiable + and Interfaces.Yamlable + with record + Is_Available : Boolean; + end record; + -- A wrapper on boolean to be able to store it in a conditional tree + + function Image (This : Available) return String; + + overriding + function Key (This : Available) return String; + + overriding + function To_TOML (This : Available) return TOML.TOML_Value; + + overriding + function To_YAML (This : Available) return String; + + package For_Available is new Conditional_Trees (Available, Image); + + type Availability is new For_Available.Tree with null record; + -- This is the actual type that encapsulates an expression tree + + function Available_From_TOML (From : TOML_Adapters.Key_Queue) + return For_Available.Tree; + -- Expects a single table "available = true/false" + + function Is_Available (This : Availability; + Env : Alire.Properties.Vector) + return Boolean; + -- Evaluate availability in an environment. In adition to resolving the + -- tree for the environment, we then need to traverse the tree evaluating + -- the boolean expressions to arrive to a final boolean value. (Formerly + -- done via Boolean_Trees). + + function Available_Default return Availability + is (New_Value (Available'(Is_Available => True))); + -- Availability default is True unless an expression is given + private function New_Dependency @@ -99,4 +153,18 @@ private return Properties is (For_Properties.New_Value (Property)); + function Image (This : Available) return String + is (if This.Is_Available then "True" else "False"); + + overriding + function Key (This : Available) return String is (TOML_Keys.Available); + + overriding + function To_TOML (This : Available) return TOML.TOML_Value + is (TOML.Create_Boolean (This.Is_Available)); + + overriding + function To_YAML (This : Available) return String + is (This.Key & ": " & This.Image); + end Alire.Conditional; diff --git a/src/alire/alire-conditional_trees-cases.adb b/src/alire/alire-conditional_trees-cases.adb index 6efc6b6e..1261fe59 100644 --- a/src/alire/alire-conditional_trees-cases.adb +++ b/src/alire/alire-conditional_trees-cases.adb @@ -30,7 +30,7 @@ package body Alire.Conditional_Trees.Cases is function Is_Conditional (This : Case_Node) return Boolean is (True); function Image_Case (Cases : Cases_Array; - I : Requisite_Cases.Enum) return String is + I : Enum) return String is (I'Img & " => " & Cases (I).Image_One_Line & (if I /= Cases'Last then ", " & Image_Case (Cases, Enum'Succ (I)) @@ -38,7 +38,7 @@ package body Alire.Conditional_Trees.Cases is overriding function Image (This : Case_Node) return String is - ("(case " & Requisite_Cases.Name & " is " + ("(case " & Enum_Cases.Name & " is " & Image_Case (This.Cases, This.Cases'First) & ")"); overriding @@ -53,7 +53,7 @@ package body Alire.Conditional_Trees.Cases is use GNAT.IO; Tab : constant String := " "; begin - Put_Line (Prefix & "case " & Requisite_Cases.Name & " is"); + Put_Line (Prefix & "case " & Enum_Cases.Name & " is"); for I in This.Cases'Range loop if not This.Cases (I).Is_Empty then Put_Line (Prefix & Tab & "when " @@ -75,7 +75,7 @@ package body Alire.Conditional_Trees.Cases is begin return Eval : Tree := Empty do for I in This.Cases'Range loop - if Requisite_Cases.Is_Satisfied (I, Against) then + if Enum_Cases.Is_Satisfied (I, Against) then Eval := Eval and This.Cases (I).Evaluate (Against); end if; end loop; diff --git a/src/alire/alire-conditional_trees-cases.ads b/src/alire/alire-conditional_trees-cases.ads index 2bd319dc..d54d0b64 100644 --- a/src/alire/alire-conditional_trees-cases.ads +++ b/src/alire/alire-conditional_trees-cases.ads @@ -1,14 +1,14 @@ -with Alire.Requisites.Cases; +with Alire.Properties.Cases; generic - with package Requisite_Cases is new Requisites.Cases (<>); + with package Enum_Cases is new Properties.Cases (<>); package Alire.Conditional_Trees.Cases with Preelaborate is -- This package provides the case-holding nodes in a conditional tree. -- Since clients retrieve such nodes as trees (New_Case below), the whole -- new Node class can be hidden in the body. - subtype Enum is Requisite_Cases.Enum; + subtype Enum is Enum_Cases.Enum; type Cases_Array is array (Enum) of Tree; -- Every case points to a dependency tree, that at leaves will have diff --git a/src/alire/alire-conditional_trees.adb b/src/alire/alire-conditional_trees.adb index 1fb986ad..12bb1bdc 100644 --- a/src/alire/alire-conditional_trees.adb +++ b/src/alire/alire-conditional_trees.adb @@ -32,10 +32,6 @@ package body Alire.Conditional_Trees is function To_YAML (V : Vector_Node) return String is (Non_Primitive.To_YAML (V.Values)); - overriding - function To_YAML (V : Conditional_Node) return String is - (raise Unimplemented with "TODO YAML output to be defined"); - ----------- -- Image -- ----------- @@ -59,15 +55,6 @@ package body Alire.Conditional_Trees is then Non_Primitive.One_Liner_And (V.Values) else Non_Primitive.One_Liner_Or (V.Values)) & ")"); - ----------- - -- Image -- - ----------- - - overriding function Image (V : Conditional_Node) return String is - ("if " & V.Condition.Image & - " then " & V.Then_Value.Image_One_Line & - " else " & V.Else_Value.Image_One_Line); - ----------------- -- Conjunction -- ----------------- @@ -84,17 +71,6 @@ package body Alire.Conditional_Trees is then This else To_Tree (Vector_Node (This.Root).Values.First_Element)); - --------------------- - -- New_Conditional -- - --------------------- - - function New_Conditional (If_X : Requisites.Tree; - Then_X : Tree; - Else_X : Tree) return Tree is - (To_Holder (Conditional_Node'(Condition => If_X, - Then_Value => Then_X, - Else_Value => Else_X))); - -------------- -- New_Leaf -- -------------- @@ -102,27 +78,6 @@ package body Alire.Conditional_Trees is function New_Leaf (V : Values) return Tree is (To_Holder (Leaf_Node'(Value => Definite_Values.To_Holder (V)))); - --------------- - -- Condition -- - --------------- - - function Condition (This : Tree) return Requisites.Tree is - (Conditional_Node (This.Root).Condition); - - ---------------- - -- True_Value -- - ---------------- - - function True_Value (This : Tree) return Tree is - (Conditional_Node (This.Root).Then_Value); - - ----------------- - -- False_Value -- - ----------------- - - function False_Value (This : Tree) return Tree is - (Conditional_Node (This.Root).Else_Value); - ----------- -- Empty -- ----------- @@ -205,54 +160,52 @@ package body Alire.Conditional_Trees is when Ored => Result := Result or Child.Flatten.To_Tree; end case; end loop; + return Result.Root; end Flatten; - ----------- - -- "and" -- - ----------- - - function "and" (L, R : Tree) return Tree is - Inner : Vector_Node := (Conjunction => Anded, Values => <>); + ---------- + -- Join -- + ---------- + function Join (L, R : Tree; Op : Conjunctions) return Tree is + Inner : Vector_Node := (Conjunction => Op, Values => <>); begin if not L.Is_Empty then - Flatten (Inner, L.Constant_Reference, Anded); + Flatten (Inner, L.Constant_Reference, Op); end if; if not R.Is_Empty then - Flatten (Inner, R.Constant_Reference, Anded); + Flatten (Inner, R.Constant_Reference, Op); end if; if Inner.Values.Is_Empty then return Empty; else - return (To_Holder (Inner)); - end if; - end "and"; - ---------- - -- "or" -- - ---------- + -- Convert vector with single value into value - function "or" (L, R : Tree) return Tree is - Inner : Vector_Node := (Conjunction => Ored, Values => <>); + if Inner.Values.Length in 1 then + return Inner.Values.First_Element.To_Tree; + end if; - begin - if not L.Is_Empty then - Flatten (Inner, L.Constant_Reference, Ored); + return To_Holder (Inner); end if; + end Join; - if not R.Is_Empty then - Flatten (Inner, R.Constant_Reference, Ored); - end if; + ----------- + -- "and" -- + ----------- - if Inner.Values.Is_Empty then - return Empty; - else - return (To_Holder (Inner)); - end if; - end "or"; + function "and" (L, R : Tree) return Tree + is (Join (L, R, Anded)); + + ---------- + -- "or" -- + ---------- + + function "or" (L, R : Tree) return Tree + is (Join (L, R, Ored)); ------------ -- Append -- @@ -421,28 +374,6 @@ package body Alire.Conditional_Trees is end if; end Iterate_Children; - --------------------- - -- Case_Statements -- - --------------------- - - package body Case_Statements is - - function Case_Is (Arr : Arrays) return Tree is - Case_Is : Tree := Arr (Arr'Last); - -- Since we get the whole array, - -- by exhaustion at worst the last must be true - begin - for I in reverse Arr'First .. Enum'Pred (Arr'Last) loop - Case_Is := New_Conditional (If_X => Requisite_Equal (I), - Then_X => Arr (I), - Else_X => Case_Is); - end loop; - - return Case_Is; - end Case_Is; - - end Case_Statements; - ----------- -- Print -- ----------- @@ -495,22 +426,6 @@ package body Alire.Conditional_Trees is end if; end Print; - overriding - procedure Print (This : Conditional_Node; - Prefix : String; - Verbose : Boolean; - Sorted : Boolean) - is - use GNAT.IO; - begin - Put_Line (Prefix & "when " & This.Condition.Image & ":"); - Print (This.Then_Value.Root, Prefix & Tab, Verbose, Sorted); - if not This.Else_Value.Is_Empty then - Put_Line (Prefix & "else:"); - Print (This.Else_Value.Root, Prefix & Tab, Verbose, Sorted); - end if; - end Print; - ----------- -- Print -- ----------- @@ -619,12 +534,6 @@ package body Alire.Conditional_Trees is end loop; end To_TOML; - overriding - procedure To_TOML (This : Conditional_Node; Parent : TOML.TOML_Value) is - begin - raise Unimplemented; - end To_TOML; - overriding function To_TOML (This : Tree) return TOML.TOML_Value is Root_Table : constant TOML.TOML_Value := TOML.Create_Table; @@ -683,9 +592,11 @@ package body Alire.Conditional_Trees is begin if Container.Is_Empty then return Forward_Iterator'(others => <>); - end if; - - if Container.Constant_Reference not in Vector_Node then + elsif Container.Constant_Reference in Leaf_Node then + return Single : Forward_Iterator do + Single.Children.Append (Container.Element); + end return; + elsif Container.Constant_Reference not in Vector_Node then raise Constraint_Error with "Cannot iterate over non-vector conditional value"; end if; diff --git a/src/alire/alire-conditional_trees.ads b/src/alire/alire-conditional_trees.ads index 2b701adb..e05b2bba 100644 --- a/src/alire/alire-conditional_trees.ads +++ b/src/alire/alire-conditional_trees.ads @@ -3,7 +3,6 @@ with Ada.Iterator_Interfaces; with Alire.Interfaces; with Alire.Properties; -with Alire.Requisites; with Alire.Utils.YAML; private with Ada.Containers.Indefinite_Holders; @@ -47,7 +46,7 @@ package Alire.Conditional_Trees with Preelaborate is -- available properties to remove conditional expressions. function Image (This : Node) return String is abstract; - -- Single-line image for single-line tree image (used by Requisites). + -- Single-line image for single-line tree image (used by Available). procedure Print (This : Node; Prefix : String; @@ -83,8 +82,8 @@ package Alire.Conditional_Trees with Preelaborate is Default_Iterator => Iterate, Iterator_Element => Tree, Constant_Indexing => Indexed_Element; - -- Recursive type that stores values, possibly with associated requisites. - -- Requisites must be satisfied by some environment property or else their + -- Recursive type that stores values, possibly with case expressions. + -- Cases must be satisfied by some environment property or else their -- associated values will be dropped from the tree. This structure is thus -- used to store conditional/dynamic properties and dependencies. -- Iteration is only over direct children, when the tree is AND/OR vector. @@ -234,47 +233,6 @@ package Alire.Conditional_Trees with Preelaborate is -- Empty, when This is a leaf, or all children but first, when vector. -- Error otherwise. - -------------------- - -- CONDITIONALS -- - -------------------- - - -- Conditional nodes are no longer used with the new index syntax. They may - -- be kept around in case at some point the syntax is expanded. - - type Conditional_Node is new Node with private; - -- A conditional node stores a if/then/else structure, based on whether its - -- requisites are fulfilled or not. - - function New_Conditional (If_X : Requisites.Tree; - Then_X : Tree; - Else_X : Tree) return Tree; - - function Condition (This : Tree) return Requisites.Tree - with Pre => This.Root in Conditional_Node; - - function True_Value (This : Tree) return Tree - with Pre => This.Root in Conditional_Node; - - function False_Value (This : Tree) return Tree - with Pre => This.Root in Conditional_Node; - - -- The following generic transforms an array of some enumerated type that - -- holds further conditional subtrees into an if/elif/elif/elif/else tree. - -- This was used by the old index and is superseded by the new compact Case - -- nodes, which result in a flat structure closer to the TOML syntax. - - generic - type Enum is (<>); - with function Requisite_Equal (V : Enum) return Requisites.Tree; - -- Function which creates an equality requisite on V - package Case_Statements is - - type Arrays is array (Enum) of Tree; - - function Case_Is (Arr : Arrays) return Tree; - - end Case_Statements; - ----------------- -- ITERATORS -- ----------------- @@ -467,54 +425,6 @@ private function Is_Vector (This : Tree) return Boolean is (This.Root in Vector_Node); - ---------------------- - -- Conditional Node -- - ---------------------- - - type Conditional_Node is new Node with record - Condition : Requisites.Tree; - Then_Value : Tree; - Else_Value : Tree; - end record; - - overriding - function Contains_ORs (This : Conditional_Node) return Boolean is - (This.Then_Value.Contains_ORs or else This.Else_Value.Contains_ORs); - - overriding - function Is_Conditional (N : Conditional_Node) return Boolean is (True); - - overriding - function Image (V : Conditional_Node) return String; - - overriding - function To_YAML (V : Conditional_Node) return String; - - overriding - function Flatten (This : Conditional_Node) return Node'Class is - (Flatten (Tree'Class (This.Then_Value and This.Else_Value).Root)); - - overriding - function Leaf_Count (This : Conditional_Node) return Positive is - (This.Then_Value.Leaf_Count + This.Else_Value.Leaf_Count); - - overriding - function Evaluate (This : Conditional_Node; - Against : Properties.Vector) - return Tree'Class is - (if This.Condition.Check (Against) - then This.Then_Value.Evaluate (Against) - else This.Else_Value.Evaluate (Against)); - - overriding - procedure Print (This : Conditional_Node; - Prefix : String; - Verbose : Boolean; - Sorted : Boolean); - - overriding - procedure To_TOML (This : Conditional_Node; Parent : TOML.TOML_Value); - -- Delayed implementation to avoid freezing: function Is_Iterable (This : Tree) return Boolean is diff --git a/src/alire/alire-crates.adb b/src/alire/alire-crates.adb index d812eb0f..e4c9b351 100644 --- a/src/alire/alire-crates.adb +++ b/src/alire/alire-crates.adb @@ -55,7 +55,7 @@ package body Alire.Crates is Notes => "", Dependencies => Conditional.No_Dependencies, Properties => This.Externals.Properties, - Available => Requisites.No_Requisites); + Available => Conditional.Empty); end Base; -------------- @@ -138,7 +138,7 @@ package body Alire.Crates is -- Load the shared section declare - Unused_Avail : Requisites.Tree; + Unused_Avail : Conditional.Availability; Unused_Deps : Conditional.Dependencies; Properties : Conditional.Properties; begin diff --git a/src/alire/alire-crates.ads b/src/alire/alire-crates.ads index a5cd5942..d179ac27 100644 --- a/src/alire/alire-crates.ads +++ b/src/alire/alire-crates.ads @@ -4,7 +4,6 @@ with Alire.Externals.Lists; with Alire.Policies; with Alire.Properties; with Alire.Releases; -with Alire.Requisites; with Alire.TOML_Adapters; with Alire.Utils; diff --git a/src/alire/alire-externals-from_output.adb b/src/alire/alire-externals-from_output.adb index 8ced3d73..6840130d 100644 --- a/src/alire/alire-externals-from_output.adb +++ b/src/alire/alire-externals-from_output.adb @@ -2,7 +2,6 @@ with Alire.Index; with Alire.Origins; with Alire.OS_Lib.Subprocess; with Alire.Releases; -with Alire.Requisites; with Alire.TOML_Keys; with Semantic_Versioning; diff --git a/src/alire/alire-externals-from_system.adb b/src/alire/alire-externals-from_system.adb index f6090998..e514b17d 100644 --- a/src/alire/alire-externals-from_system.adb +++ b/src/alire/alire-externals-from_system.adb @@ -2,7 +2,6 @@ with Alire.Index; with Alire.Origins.Deployers.System; with Alire.Platform; with Alire.Releases; -with Alire.Requisites; with Alire.TOML_Adapters; with Alire.TOML_Expressions; with Alire.TOML_Keys; diff --git a/src/alire/alire-externals-lists.adb b/src/alire/alire-externals-lists.adb index 571fe2ff..fae8ae8f 100644 --- a/src/alire/alire-externals-lists.adb +++ b/src/alire/alire-externals-lists.adb @@ -28,7 +28,7 @@ package body Alire.Externals.Lists is begin return Detected : Containers.Release_Set do for External of This loop - if External.Available.Check (Env) then + if External.Available.Is_Available (Env) then Trace.Debug ("Attempting detection of available external: " & (+Name)); Detected.Union (External.Detect (Name)); @@ -66,7 +66,7 @@ package body Alire.Externals.Lists is TOML_Keys.Hint); elsif - External.Available.Check (Env) and then + External.Available.Is_Available (Env) and then External.Detect (Name).Is_Empty then diff --git a/src/alire/alire-externals.adb b/src/alire/alire-externals.adb index 843ec02e..bc518a33 100644 --- a/src/alire/alire-externals.adb +++ b/src/alire/alire-externals.adb @@ -5,7 +5,6 @@ with Alire.Externals.From_Output; with Alire.Externals.From_System; with Alire.Externals.Softlinks; with Alire.Externals.Unindexed; -with Alire.Requisites.Booleans; with Alire.TOML_Keys; with Alire.TOML_Load; @@ -17,8 +16,8 @@ package body Alire.Externals is -- Available -- --------------- - function Available (This : External'Class) return Requisites.Tree is - (This.Available); + function Available (This : External'Class) return Conditional.Availability + is (This.Available); --------------- -- From_TOML -- @@ -103,9 +102,7 @@ package body Alire.Externals is Env : Properties.Vector) return External'Class is begin return Ext : External'Class := This do - Ext.Available := (if Ext.Available.Check (Env) - then Requisites.Booleans.Always_True - else Requisites.Booleans.Always_False); + Ext.Available := Ext.Available.Evaluate (Env); Ext.Properties := Ext.Properties.Evaluate (Env); end return; end On_Platform; diff --git a/src/alire/alire-externals.ads b/src/alire/alire-externals.ads index e248f575..eadc0b40 100644 --- a/src/alire/alire-externals.ads +++ b/src/alire/alire-externals.ads @@ -2,7 +2,6 @@ with Alire.Conditional; with Alire.Containers; with Alire.Platforms; with Alire.Properties; -with Alire.Requisites; with Alire.TOML_Adapters; with Alire.Utils; @@ -39,7 +38,7 @@ package Alire.Externals is -- Classwide helpers -- ------------------------- - function Available (This : External'Class) return Requisites.Tree; + function Available (This : External'Class) return Conditional.Availability; type Kinds is (Hint, -- A placeholder for a knowingly-unavailable crate, that @@ -69,7 +68,7 @@ private type External is abstract tagged record Properties : Conditional.Properties; - Available : Requisites.Tree; + Available : Conditional.Availability := Conditional.Available_Default; end record; end Alire.Externals; diff --git a/src/alire/alire-index.ads b/src/alire/alire-index.ads index 39413511..3a7beb07 100644 --- a/src/alire/alire-index.ads +++ b/src/alire/alire-index.ads @@ -9,7 +9,6 @@ with Alire.Policies; with Alire.Properties; with Alire.Properties.Licenses; with Alire.Releases; -with Alire.Requisites; with Alire.Utils; with Semantic_Versioning; diff --git a/src/alire/alire-properties-cases.ads b/src/alire/alire-properties-cases.ads new file mode 100644 index 00000000..125a8324 --- /dev/null +++ b/src/alire/alire-properties-cases.ads @@ -0,0 +1,29 @@ +with Alire.TOML_Adapters; + +with TOML; + +generic + -- Encapsulated enumeration type + type Enum is (<>); + + -- Encapsulating property that contains one of the enumerated values + type Property is new Properties.Property with private; + with function Element (P : Property) return Enum; + + Name : String with Warnings => Off; + -- String used for Image (seen by the user). + + TOML_Name : String with Warnings => Off; + -- String used for case(toml-name) expressions in files. +package Alire.Properties.Cases with Preelaborate is + + -- Traits package to be able to deal with case expressions that are + -- resolved based on the value of a property. + + function Is_Satisfied (E : Enum; V : Properties.Vector) return Boolean + -- Convenience for conditional trees to check if a case value is satisfied. + is (for some P of V => + P in Property and then + Element (Property (P)) = E); + +end Alire.Properties.Cases; diff --git a/src/alire/alire-properties-platform.ads b/src/alire/alire-properties-platform.ads index 8905715a..73b30dfd 100644 --- a/src/alire/alire-properties-platform.ads +++ b/src/alire/alire-properties-platform.ads @@ -1,4 +1,5 @@ with Alire.Platforms; +with Alire.Properties.Cases; with Alire.TOML_Adapters; with Alire.TOML_Keys; @@ -59,6 +60,39 @@ package Alire.Properties.Platform with Preelaborate is pragma Warnings (On); + -- Case instantiations for case expressions + + package Ps renames Platforms; + package PrPl renames Properties.Platform; + + package Distro_Cases is new Cases + (Enum => Ps.Distributions, + Property => PrPl.Distributions.Property, + Element => PrPl.Distributions.Element, + Name => "Distribution", + TOML_Name => TOML_Keys.Distribution); + + package OS_Cases is new Cases + (Enum => Ps.Operating_Systems, + Property => PrPl.Operating_Systems.Property, + Element => PrPl.Operating_Systems.Element, + Name => "OS", + TOML_Name => TOML_Keys.OS); + + package Toolchain_Cases is new Cases + (Enum => Ps.Toolchains, + Property => PrPl.Toolchains.Property, + Element => PrPl.Toolchains.Element, + Name => "Toolchain", + TOML_Name => TOML_Keys.Toolchain); + + package Word_Size_Cases is new Cases + (Enum => Ps.Word_Sizes, + Property => PrPl.Word_Sizes.Property, + Element => PrPl.Word_Sizes.Element, + Name => "Word_Size", + TOML_Name => TOML_Keys.Word_Size); + function Distribution_Is (D : Platforms.Distributions) return Vector renames Distributions.New_Vector; diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 847991cd..7b38f893 100644 --- a/src/alire/alire-releases.adb +++ b/src/alire/alire-releases.adb @@ -10,7 +10,6 @@ with Alire.Errors; with Alire.Origins.Deployers; with Alire.Properties.Bool; with Alire.Properties.Actions.Executor; -with Alire.Requisites.Booleans; with Alire.TOML_Expressions; with Alire.TOML_Load; with Alire.Utils.YAML; @@ -146,27 +145,6 @@ package body Alire.Releases is end if; end Deploy; - --------------- - -- Extending -- - --------------- - - function Extending - (Base : Release; - Dependencies : Conditional.Dependencies := Conditional.No_Dependencies; - Properties : Conditional.Properties := Conditional.No_Properties; - Available : Alire.Requisites.Tree := Requisites.No_Requisites) - return Release - is - use all type Conditional.Dependencies; - use all type Requisites.Tree; - begin - return Extended : Release := Base do - Extended.Dependencies := Base.Dependencies and Dependencies; - Extended.Properties := Base.Properties and Properties; - Extended.Available := Base.Available and Available; - end return; - end Extending; - ---------------- -- Forbidding -- ---------------- @@ -236,20 +214,6 @@ package body Alire.Releases is -- Replacing -- --------------- - function Replacing - (Base : Release; - Available : Alire.Requisites.Tree := Requisites.No_Requisites) - return Release is - begin - return Replaced : Release := Base do - Replaced.Available := Available; - end return; - end Replacing; - - --------------- - -- Replacing -- - --------------- - function Replacing (Base : Release; Notes : Description_String := "") @@ -315,7 +279,7 @@ package body Alire.Releases is Notes : Description_String; Dependencies : Conditional.Dependencies; Properties : Conditional.Properties; - Available : Alire.Requisites.Tree) + Available : Conditional.Availability) return Release is (Prj_Len => Name.Length, Notes_Len => Notes'Length, @@ -359,7 +323,7 @@ package body Alire.Releases is Dependencies => Dependencies, Forbidden => Conditional.For_Dependencies.Empty, Properties => Properties, - Available => Requisites.Trees.Empty_Tree -- empty evaluates to True + Available => Conditional.Empty ); ------------------------- @@ -615,7 +579,7 @@ package body Alire.Releases is -- AVAILABILITY if not R.Available.Is_Empty then - Put_Line ("Available when: " & R.Available.Image); + Put_Line ("Available when: " & R.Available.Image_One_Line); end if; -- PROPERTIES @@ -846,7 +810,6 @@ package body Alire.Releases is is package APL renames Alire.Properties.Labeled; use all type Alire.Properties.Labeled.Cardinalities; - use all type Alire.Requisites.Tree; use TOML_Adapters; Root : constant TOML.TOML_Value := R.Properties.To_TOML; begin @@ -909,7 +872,7 @@ package body Alire.Releases is -- Available if R.Available.Is_Empty or else - R.Available = Alire.Requisites.Booleans.Always_True + R.Available.Value.Is_Available then null; -- Do nothing, do not pollute .toml file else @@ -973,9 +936,7 @@ package body Alire.Releases is Dependencies => R.Dependencies.Evaluate (P), Forbidden => R.Forbidden.Evaluate (P), Properties => R.Properties.Evaluate (P), - Available => (if R.Available.Check (P) - then Requisites.Booleans.Always_True - else Requisites.Booleans.Always_False)); + Available => R.Available.Evaluate (P)); ---------------------- -- Long_Description -- diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index bc2760b1..7f1fa5fb 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -11,7 +11,6 @@ with Alire.Properties.Actions; with Alire.Properties.Environment; with Alire.Properties.Labeled; with Alire.Properties.Licenses; -with Alire.Requisites; with Alire.TOML_Adapters; with Alire.TOML_Keys; with Alire.Utils; @@ -40,7 +39,7 @@ package Alire.Releases is Notes : Description_String; Dependencies : Conditional.Dependencies; Properties : Conditional.Properties; - Available : Alire.Requisites.Tree) + Available : Conditional.Availability) return Release; function New_Empty_Release (Name : Crate_Name) return Release; @@ -61,14 +60,6 @@ package Alire.Releases is -- For working releases that may have incomplete information. Note that the -- default properties are used by default. - function Extending - (Base : Release; - Dependencies : Conditional.Dependencies := Conditional.No_Dependencies; - Properties : Conditional.Properties := Conditional.No_Properties; - Available : Alire.Requisites.Tree := Requisites.No_Requisites) - return Release; - -- Takes a release and merges given fields - function Renaming (Base : Release; Provides : Crate_Name) return Release; -- Fills-in the "provides" field @@ -90,11 +81,6 @@ package Alire.Releases is Properties : Conditional.Properties := Conditional.No_Properties) return Release; - function Replacing - (Base : Release; - Available : Alire.Requisites.Tree := Requisites.No_Requisites) - return Release; - function Replacing (Base : Release; Origin : Origins.Origin) return Release; @@ -177,7 +163,7 @@ package Alire.Releases is function Origin (R : Release) return Origins.Origin; - function Available (R : Release) return Requisites.Tree; + function Available (R : Release) return Conditional.Availability; function Is_Available (R : Release; P : Alire.Properties.Vector) return Boolean; -- Evaluate R.Available under platform properties P @@ -350,7 +336,7 @@ private Dependencies : Conditional.Dependencies; Forbidden : Conditional.Dependencies; Properties : Conditional.Properties; - Available : Requisites.Tree; + Available : Conditional.Availability; end record; function From_TOML (This : in out Release; @@ -413,12 +399,12 @@ private function Origin (R : Release) return Origins.Origin is (R.Origin); - function Available (R : Release) return Requisites.Tree + function Available (R : Release) return Conditional.Availability is (R.Available); function Is_Available (R : Release; P : Alire.Properties.Vector) return Boolean - is (R.Available.Check (P)); + is (R.Available.Is_Available (P)); function Description (R : Release) return Description_String -- Image returns "Description: Blah" so we have to cut. diff --git a/src/alire/alire-requisites-booleans.adb b/src/alire/alire-requisites-booleans.adb deleted file mode 100644 index cb308148..00000000 --- a/src/alire/alire-requisites-booleans.adb +++ /dev/null @@ -1,18 +0,0 @@ -package body Alire.Requisites.Booleans is - - function From_TOML (From : TOML_Adapters.Key_Queue) - return Tree - is - Value : TOML.TOML_Value; - Unused_Key : constant String := From.Pop (Value); - begin - -- Should never fail if the caller has properly constructed the adapter: - if Value.Kind in TOML.TOML_Boolean then - return New_Requisite (Value.As_Boolean); - else - From.Checked_Error ("expected a Boolean value, but got a " - & Value.Kind'Img); - end if; - end From_TOML; - -end Alire.Requisites.Booleans; diff --git a/src/alire/alire-requisites-booleans.ads b/src/alire/alire-requisites-booleans.ads deleted file mode 100644 index 957a22a7..00000000 --- a/src/alire/alire-requisites-booleans.ads +++ /dev/null @@ -1,55 +0,0 @@ -with Alire.TOML_Adapters; - -with TOML; - -package Alire.Requisites.Booleans with Preelaborate is - - -- Special unconditional requisites to represent a plain Boolean. - - function Always_True return Tree; - - function Always_False return Tree; - - function New_Requisite (Bool : Boolean) return Tree; - - function From_TOML (From : TOML_Adapters.Key_Queue) - return Tree; - -private - - type Requisite is new Requisites.Requisite with record - Bool : Boolean; - end record; - - overriding - function Image (R : Requisite) return String - is (if R.Bool then "True" else "False"); - - overriding - function Is_Applicable (R : Requisite; - Unused : Property'Class) - return Boolean - is (True); - - overriding - function Satisfies (R : Requisite; - Unused : Property'Class) - return Boolean - is (R.Bool); - - overriding - function To_TOML (This : Requisite) return TOML.TOML_Value is - (TOML.Create_Boolean (This.Bool)); - - function Always_True return Tree is - (Trees.Leaf (Requisite'(Bool => True))); - - function Always_False return Tree is - (Trees.Leaf (Requisite'(Bool => False))); - - function New_Requisite (Bool : Boolean) return Tree is - (case Bool is - when True => Always_True, - when False => Always_False); - -end Alire.Requisites.Booleans; diff --git a/src/alire/alire-requisites-cases.adb b/src/alire/alire-requisites-cases.adb deleted file mode 100644 index ef836d5d..00000000 --- a/src/alire/alire-requisites-cases.adb +++ /dev/null @@ -1,107 +0,0 @@ -package body Alire.Requisites.Cases is - - Dots : constant String := "..."; - - use TOML; - - ---------------- - -- Is_Boolean -- - ---------------- - - function Is_Boolean (This : Enumerable; I : Enum) return Boolean is - (This.Cases (I).To_TOML.Kind = TOML_Boolean); - - ---------------- - -- As_Boolean -- - ---------------- - - function As_Boolean (This : Enumerable; I : Enum) return Boolean is - (This.Cases (I).To_TOML.As_Boolean); - - ------------------ - -- Is_Satisfied -- - ------------------ - - function Is_Satisfied (E : Enum; V : Properties.Vector) return Boolean is - (for some P of V => - P in Property and then - Element (Property (P)) = E); - - ------------- - -- To_TOML -- - ------------- - - overriding - function To_TOML (This : Enumerable) return TOML.TOML_Value is - - --------------- - -- Aggregate -- - --------------- - - -- With this function we construct a case entry with all matching - -- (true/false) alternatives: "'foo|bar' = ..." - function Aggregate (Bool : Boolean; - I : Enum; - Prev : String) return String is - (if This.Is_Boolean (I) and then This.As_Boolean (I) = Bool then - (if Prev /= "" - then Prev & "|" - else "") & TOML_Adapters.Tomify (I'Img) - else Prev); - - ---------------------- - -- Set_If_Not_Empty -- - ---------------------- - - procedure Set_If_Not_Empty (Table : TOML.TOML_Value; - Key : String; - Value : TOML.TOML_Value) is - begin - if Key /= "" then - Table.Set (Key, Value); - end if; - end Set_If_Not_Empty; - - Same : Boolean := - This.Is_Boolean (Enum'First) and then - This.As_Boolean (Enum'First); - -- Used to keep track that all entries in a case have the same value. - - Master : constant TOML.TOML_Value := TOML.Create_Table; - -- The master TOML table "case(xx)" - - Cases : constant TOML.TOML_Value := TOML.Create_Table; - -- The child table with the entries. - begin - Master.Set ("case(" & TOML_Name & ")", Cases); - - -- Check that all are equal - for I in This.Cases'Range loop - Same := This.Is_Boolean (I) and then This.As_Boolean (I) = Same; - exit when not Same; - end loop; - - if Same then - Cases.Set (Dots, TOML.Create_Boolean (Same)); - else - Set_If_Not_Empty (Cases, - Aggregate (True, Enum'First, ""), - TOML.Create_Boolean (True)); - Set_If_Not_Empty (Cases, - Aggregate (False, Enum'First, ""), - TOML.Create_Boolean (False)); - for I in This.Cases'Range loop - if not This.Is_Boolean (I) then - raise Unimplemented; - -- TODO: convert tree to TOML, and get key from the first - -- entry, which will be a case (see Master above). Use that - -- case as key for the remainder of tree. - -- There are still no entries in the index that require this. - end if; - end loop; - end if; - - return Master; - end To_TOML; - -end Alire.Requisites.Cases; diff --git a/src/alire/alire-requisites-cases.ads b/src/alire/alire-requisites-cases.ads deleted file mode 100644 index 6fbe441b..00000000 --- a/src/alire/alire-requisites-cases.ads +++ /dev/null @@ -1,91 +0,0 @@ -with Alire.Interfaces; -with Alire.Properties; -with Alire.TOML_Adapters; - -with TOML; - -generic - -- Encapsulated enumeration type - type Enum is (<>); - - -- Encapsulating property that contains one of the enumerated values - type Property is new Properties.Property with private; - with function Element (P : Property) return Enum; - - Name : String; -- String used for Image (seen by the user). - TOML_Name : String; -- String used for case(toml-name) expressions in files. -package Alire.Requisites.Cases with Preelaborate is - - -- Requisites for use over enumerations that can appear in case - -- expressions. - - function TOML_Key return String is (TOML_Name); - -- Re-export this value due to visibility bug. - - package Enum_Requisites is new For_Property (Property); - - type Enumerable (<>) is - new Enum_Requisites.Requisite - and Interfaces.Tomifiable with private; - -- A requisite that stores a case with a further requisite for each enum - -- value. - - type Cases_Array is array (Enum) of Tree; - -- Every case points to a requisite tree, that at leaves will have a - -- Requisites.Booleans.Requisite. - - function New_Case (Cases : Cases_Array) return Enumerable; - -- Create the case expression requisite. - - function New_Case (Cases : Cases_Array) return Tree; - -- As previous, but wrapped already as a requisites tree. - - function Is_Satisfied (E : Enum; V : Properties.Vector) return Boolean; - -- Convenience for conditional trees to check if a case value is satisfied. - - overriding - function To_TOML (This : Enumerable) return TOML.TOML_Value; - -- Returns a table composed of another table with the values. E.g.: - -- ['case(toml-name)'] - -- 'enum1|enum3' = true - -- 'enum2|enum4' = false - -private - - function Is_Boolean (This : Enumerable; I : Enum) return Boolean; - - function As_Boolean (This : Enumerable; I : Enum) return Boolean; - - type Enumerable is new Enum_Requisites.Requisite and Interfaces.Tomifiable - with record - Cases : Cases_Array; - end record; - - function Image_Case (Cases : Cases_Array; I : Enum) return String is - (I'Img & " => " & Cases (I).Image - & (if I /= Cases'Last - then ", " & Image_Case (Cases, Enum'Succ (I)) - else "")); - - overriding - function Image (E : Enumerable) return String is - ("(case " & Name & " is " & Image_Case (E.Cases, E.Cases'First) & ")"); - - overriding - function Is_Satisfied (E : Enumerable; P : Property) return Boolean is - (E.Cases (Element (P)).Check (Properties.To_Vector (P))); - - overriding - function Children_Are_Satisfied (E : Enumerable; - P : Property; - V : Properties.Vector) - return Boolean is - (E.Cases (Element (P)).Check (V)); - - function New_Case (Cases : Cases_Array) return Enumerable is - (Cases => Cases); - - function New_Case (Cases : Cases_Array) return Tree is - (Trees.Leaf (New_Case (Cases))); - -end Alire.Requisites.Cases; diff --git a/src/alire/alire-requisites-comparables.ads b/src/alire/alire-requisites-comparables.ads deleted file mode 100644 index 80d3aa3c..00000000 --- a/src/alire/alire-requisites-comparables.ads +++ /dev/null @@ -1,119 +0,0 @@ -with Alire.Utils; - -with TOML; - -generic - -- Encapsulated basic type - type Value is private; - with function "<" (L, R : Value) return Boolean; - with function Image (V : Value) return String is <>; - - -- Encapsulating property - type Property is new Properties.Property with private; - with function Element (P : Property) return Value; - - Name : String; - -- used for image "Name (operation) Mixed_Case (Image (Value))" -package Alire.Requisites.Comparables with Preelaborate is - - package Value_Requisites is new For_Property (Property); - - type Comparable (<>) is new Value_Requisites.Requisite with private; - - overriding - function Is_Satisfied (R : Comparable; P : Property) return Boolean; - overriding - function Image (R : Comparable) return String; - - not overriding - function New_Comparable return Comparable; - -- This is the root function that can be renamed to a sensible name to - -- appear in expressions. - - generic - function Factory return Comparable; - -- Alternatively this makes for a simpler instantiation since no profile is - -- needed. - - function "=" (L : Comparable; R : Value) return Tree; - function "=" (L : Value; R : Comparable) return Tree; - - function "/=" (L : Comparable; R : Value) return Tree; - function "/=" (L : Value; R : Comparable) return Tree; - - function "<" (L : Comparable; R : Value) return Tree; - function "<" (L : Value; R : Comparable) return Tree; - - function "<=" (L : Comparable; R : Value) return Tree; - function "<=" (L : Value; R : Comparable) return Tree; - - function ">" (L : Comparable; R : Value) return Tree; - function ">" (L : Value; R : Comparable) return Tree; - - function ">=" (L : Comparable; R : Value) return Tree; - function ">=" (L : Value; R : Comparable) return Tree; - - function Is_Equal_To (V : Value) return Tree; - -- Non-operator function useful elsewhere for case statements - - overriding - function To_TOML (This : Comparable) return TOML.TOML_Value is - (raise Unimplemented); - -- Should not currently appear in the toml index, unless syntax changes. - -private - - type Kinds is (Base, Equality, Ordering); - - type Comparable (Kind : Kinds) is new Value_Requisites.Requisite with record - Value : Comparables.Value; - end record; - - not overriding - function New_Comparable return Comparable is (Kind => Base, Value => <>); - - overriding - function Is_Satisfied (R : Comparable; P : Property) return Boolean is - (case R.Kind is - when Base => raise Constraint_Error - with "Is_Satisfied: Requisite without operation", - when Equality => R.Value = Element (P), - when Ordering => Element (P) < R.Value - ); - - overriding function Image (R : Comparable) return String is - (case R.Kind is - when Base => raise Constraint_Error - with "Image: Requisite without operation", - when Equality => Name & " = " & Utils.To_Mixed_Case (Image (R.Value)), - when Ordering => Name & " < " & Utils.To_Mixed_Case (Image (R.Value)) - ); - - function Factory return Comparable is (New_Comparable); - - function "/=" (L : Comparable; R : Value) return Tree is (not (L = R)); - function "/=" (L : Value; R : Comparable) return Tree is (not (L = R)); - - function "<=" (L : Comparable; R : Value) return Tree is (L < R or L = R); - function "<=" (L : Value; R : Comparable) return Tree is (L < R or L = R); - - function ">" (L : Comparable; R : Value) return Tree is (not (L <= R)); - function ">" (L : Value; R : Comparable) return Tree is (not (L <= R)); - - function ">=" (L : Comparable; R : Value) return Tree is (not (L < R)); - function ">=" (L : Value; R : Comparable) return Tree is (not (L < R)); - - function "=" (L : Comparable; R : Value) return Tree is - (Trees.Leaf (Comparable'(Kind => Equality, Value => R))); - - function "=" (L : Value; R : Comparable) return Tree is (R = L); - - function "<" (L : Comparable; R : Value) return Tree is - (Trees.Leaf (Comparable'(Kind => Ordering, Value => R))); - - function "<" (L : Value; R : Comparable) return Tree is (R >= L); - - function Is_Equal_To (V : Value) return Tree is - (Trees.Leaf (Comparable'(Kind => Equality, Value => V))); - -end Alire.Requisites.Comparables; diff --git a/src/alire/alire-requisites-platform.ads b/src/alire/alire-requisites-platform.ads deleted file mode 100644 index 389ca0b6..00000000 --- a/src/alire/alire-requisites-platform.ads +++ /dev/null @@ -1,84 +0,0 @@ -with Alire.Conditional; -with Alire.Platforms; -with Alire.Properties.Platform; - -with Alire.Requisites.Cases; -with Alire.Requisites.Comparables; -with Alire.TOML_Keys; - -with TOML; - -package Alire.Requisites.Platform with Preelaborate is - - package Ps renames Platforms; - package PrPl renames Properties.Platform; - - -- Packages used in new index, purely case-based. - - package Distro_Cases is new Cases - (Enum => Ps.Distributions, - Property => PrPl.Distributions.Property, - Element => PrPl.Distributions.Element, - Name => "Distribution", - TOML_Name => TOML_Keys.Distribution); - - package OS_Cases is new Cases - (Enum => Ps.Operating_Systems, - Property => PrPl.Operating_Systems.Property, - Element => PrPl.Operating_Systems.Element, - Name => "OS", - TOML_Name => TOML_Keys.OS); - - package Toolchain_Cases is new Cases - (Enum => Ps.Toolchains, - Property => PrPl.Toolchains.Property, - Element => PrPl.Toolchains.Element, - Name => "Toolchain", - TOML_Name => TOML_Keys.Toolchain); - - package Word_Size_Cases is new Cases - (Enum => Ps.Word_Sizes, - Property => PrPl.Word_Sizes.Property, - Element => PrPl.Word_Sizes.Element, - Name => "Word_Size", - TOML_Name => TOML_Keys.Word_Size); - - -- Packages used in Alire.Index, e.g., old more general expressions. - -- TODO: remove during the old index Alire.Index dead code removal - - package Op_Systems is new Comparables - (Ps.Operating_Systems, Ps."<", Ps.Operating_Systems'Image, - PrPl.Operating_Systems.Property, - PrPl.Operating_Systems.Element, - "OS"); - - package Op_System_Cases is new Conditional.For_Properties.Case_Statements - (Ps.Operating_Systems, Op_Systems.Is_Equal_To); - - package Distributions is new Comparables - (Ps.Distributions, Ps."<", Ps.Distributions'Image, - PrPl.Distributions.Property, - PrPl.Distributions.Element, - "Distribution"); - - package Distribution_Cases_Deps - is new Conditional.For_Dependencies.Case_Statements - (Ps.Distributions, Distributions.Is_Equal_To); - - package Distribution_Cases_Props - is new Conditional.For_Properties.Case_Statements - (Ps.Distributions, Distributions.Is_Equal_To); - - package Targets is new Comparables - (Ps.Targets, Ps."<", Ps.Targets'Image, - PrPl.Targets.Property, - PrPl.Targets.Element, - "Target"); - - package Word_Sizes is new Comparables - (Ps.Word_Sizes, Ps."<", Ps.Word_Sizes'Image, - PrPl.Word_Sizes.Property, - PrPl.Word_Sizes.Element, - "Word_Size"); - -end Alire.Requisites.Platform; diff --git a/src/alire/alire-requisites.adb b/src/alire/alire-requisites.adb deleted file mode 100644 index 1178a87f..00000000 --- a/src/alire/alire-requisites.adb +++ /dev/null @@ -1,37 +0,0 @@ -package body Alire.Requisites is - - ---------------- - -- Default_To -- - ---------------- - - function Default_To (This : Tree; Default : Tree) return Tree is - (if This.Is_Empty - then Default - else This); - - --------------- - -- Satisfies -- - --------------- - - function Satisfies (R : Requisite'Class; - P : Properties.Vector) - return Boolean - is - begin - for Prop of P loop - if R.Satisfies (Prop) then - return True; - end if; - end loop; - - -- Attempt the alternative, more exhaustive form: - for Prop of P loop - if R.Satisfies (Prop, P) then - return True; - end if; - end loop; - - return False; - end Satisfies; - -end Alire.Requisites; diff --git a/src/alire/alire-requisites.ads b/src/alire/alire-requisites.ads deleted file mode 100644 index 7ddb83f6..00000000 --- a/src/alire/alire-requisites.ads +++ /dev/null @@ -1,132 +0,0 @@ -with Alire.Boolean_Trees; -with Alire.Interfaces; -with Alire.Properties; - -package Alire.Requisites with Preelaborate is - - use Properties; - - type Requisite is abstract new - Interfaces.Tomifiable with null record; - -- A Requisite verifies against some internally stored data that a property - -- is satisfied. Here we provide the basic storage of values but the actual - -- checking function must be overridden for particular checks. - - function Is_Applicable (R : Requisite; - P : Property'Class) - return Boolean - is abstract; - -- Initially there is no compatibility. See helper package below - - -- The following package is the building block to be used to define new - -- compatibility checks. Here we tie a class of properties and requisites - -- (e.g., versions and version sets) that make sense. A release has a - -- list of properties, and a tree of requisites to be applied to potential - -- dependencies. - - function Satisfies (R : Requisite; - P : Property'Class) - return Boolean - is abstract; - -- This function is used later in the generic implementation to - -- automatically downcast, so requisite implementations do not need to - -- deal with this MI-mess - - function Satisfies (R : Requisite; - Unused_P : Property'Class; - Unused_V : Properties.Vector) - return Boolean - is (False); - -- However, for the new case requisites, which in turn may contain other - -- trees, we need to pass all properties to each of these requisite nodes - -- so they can pass them down to their owned trees. - -- These special requisites must override this alternative version. - - function Image (R : Requisite) return String is abstract; - -- A necessary pain to be able to report - - -- Trees of requisites to be matched against a list of properties in a - -- release - - function Satisfies (R : Requisite'Class; - P : Properties.Vector) - return Boolean; - -- True if any of the properties in the vector satisfies the requisite - - function Image_Class (R : Requisite'Class) return String is (R.Image); - - package Trees is new Boolean_Trees (Properties.Vector, - Requisite'Class, - Satisfies, - Image_Class); - - subtype Tree is Trees.Tree; - use type Tree; - - function Default_To (This : Tree; Default : Tree) return Tree with - Post => (if This.Is_Empty - then Default_To'Result = Default - else Default_To'Result = This); - - function No_Requisites return Trees.Tree is (Trees.Empty_Tree); - -- Function instead of constant to keep Preelaborate - - ------------------ - -- For_Property -- - ------------------ - -- Using these we get free matching of properties to requisites - -- It is in essence a work around MI - - generic - type Matching_Property (<>) is new Property with private; - package For_Property is - - type Requisite is abstract new Requisites.Requisite with null record; - - not overriding - function Is_Satisfied (R : Requisite; - P : Matching_Property) - return Boolean - is abstract; - -- This is the important function to override by Requisite - -- implementations - - not overriding - function Children_Are_Satisfied (R : Requisite; - P : Matching_Property; - Unused_V : Properties.Vector) - return Boolean is - (Requisite'Class (R).Is_Satisfied (P)); - -- The exhaustive form used only by 'case(xx)' - -- It defaults to Is_Satisfied - - -- The remainder methods are utilities that do not require modifications - -- by the client. - - overriding - function Is_Applicable (R : Requisite; - P : Property'Class) - return Boolean - is (P in Matching_Property); - -- Convenience for the evaluator to determine which properties might - -- satisfy a requisite - - overriding - function Satisfies (R : Requisite; P : Property'Class) return Boolean is - (if R.Is_Applicable (P) - then Requisite'Class (R).Is_Satisfied (Matching_Property (P)) - else False); - - overriding - function Satisfies (R : Requisite; - P : Property'Class; - V : Properties.Vector) - return Boolean - is (if R.Is_Applicable (P) - then Requisite'Class (R) - .Children_Are_Satisfied (Matching_Property (P), V) - else False); - - end For_Property; - -end Alire.Requisites; diff --git a/src/alire/alire-roots.ads b/src/alire/alire-roots.ads index 079051a5..6c2e22d8 100644 --- a/src/alire/alire-roots.ads +++ b/src/alire/alire-roots.ads @@ -6,7 +6,6 @@ private with Alire.Lockfiles; with Alire.Paths; with Alire.Properties; with Alire.Releases; -with Alire.Requisites; with Alire.Solutions; with Alire.Solver; with Alire.Utils.User_Input; diff --git a/src/alire/alire-toml_expressions-cases.adb b/src/alire/alire-toml_expressions-cases.adb index 48d60ba3..7c781d4e 100644 --- a/src/alire/alire-toml_expressions-cases.adb +++ b/src/alire/alire-toml_expressions-cases.adb @@ -1,7 +1,6 @@ with Alire.Conditional_Trees.Cases; with Alire.Platforms; -with Alire.Requisites.Booleans; -with Alire.Requisites.Platform; +with Alire.Properties.Platform; with Alire.TOML_Keys; package body Alire.TOML_Expressions.Cases is @@ -15,113 +14,47 @@ package body Alire.TOML_Expressions.Cases is package Toolchains is new Enum_Cases (Platforms.Toolchains); package Word_Sizes is new Enum_Cases (Platforms.Word_Sizes); - ------------------------------------------------ - -- COMMON REQUISITES/PROPERTIES SCAFFOLDING -- - ------------------------------------------------ - - -- This generic saves duplication of instances for requisites and - -- properties. + -------------------------- + -- COMMON SCAFFOLDING -- + -------------------------- generic with package Condtrees is new Conditional_Trees (<>); package Common_Cases is package Distributions is - new Condtrees.Cases (Requisites.Platform.Distro_Cases); + new Condtrees.Cases (Properties.Platform.Distro_Cases); package Operating_Systems is - new Condtrees.Cases (Requisites.Platform.OS_Cases); + new Condtrees.Cases (Properties.Platform.OS_Cases); package Toolchains is - new Condtrees.Cases (Requisites.Platform.Toolchain_Cases); + new Condtrees.Cases (Properties.Platform.Toolchain_Cases); package Word_Sizes is - new Condtrees.Cases (Requisites.Platform.Word_Size_Cases); + new Condtrees.Cases (Properties.Platform.Word_Size_Cases); end Common_Cases; -- The following packages create the actual Case_Node classes for the - -- respective conditional trees of properties and dependencies. - -- These instances are later used in TOML loading of expressions. + -- respective conditional trees. These instances are later used in TOML + -- loading of expressions. package Cases_Deps is new Common_Cases (Conditional.For_Dependencies); package Cases_Props is new Common_Cases (Conditional.For_Properties); - - ----------------------------------- - -- CASE REQUISITES SCAFFOLDING -- - ----------------------------------- - - package Reqs is - - -- Requisites have differences in regard to Conditional_Trees that - -- make a common generic impossible (or not evident). - - package Trees is new Enum_Trees - (Tree => Requisites.Tree, - "and" => Requisites.Trees."and", - Default => Requisites.Booleans.Always_True); - - Loaders : array (Case_Loader_Keys) of Trees.Recursive_Case_Loader := - (others => null); - - function Loader (Key : Case_Loader_Keys) - return Trees.Recursive_Case_Loader is (Loaders (Key)); - - function Load_Instance is new Trees.Load - (Case_Keys => Case_Loader_Keys, - Loaders => Loader); - - -- Requisite loader instances: - package Distro_Loader is new Tree_Builders - (Trees => Trees, - Cases => Distributions, - Enum_Array => Requisites.Platform.Distro_Cases.Cases_Array, - New_Leaf => Requisites.Platform.Distro_Cases.New_Case, - Load => Load_Instance); - package OS_Loader is new Tree_Builders - (Trees => Trees, - Cases => Operating_Systems, - Enum_Array => Requisites.Platform.OS_Cases.Cases_Array, - New_Leaf => Requisites.Platform.OS_Cases.New_Case, - Load => Load_Instance); - package Toolchain_Loader is new Tree_Builders - (Trees => Trees, - Cases => Toolchains, - Enum_Array => Requisites.Platform.Toolchain_Cases.Cases_Array, - New_Leaf => Requisites.Platform.Toolchain_Cases.New_Case, - Load => Load_Instance); - package WS_Loader is new Tree_Builders - (Trees => Trees, - Cases => Word_Sizes, - Enum_Array => Requisites.Platform.Word_Size_Cases.Cases_Array, - New_Leaf => Requisites.Platform.Word_Size_Cases.New_Case, - Load => Load_Instance); - - end Reqs; - - --------------------- - -- Load_Requisites -- - --------------------- - - function Load_Requisites (From : TOML_Adapters.Key_Queue) - return Requisites.Tree is - begin - Set_Up_Loaders; - return Reqs.Load_Instance (TOML_Keys.Available, - From, - Requisites.Booleans.From_TOML'Access); - end Load_Requisites; + package Cases_Avail is new Common_Cases (Conditional.For_Available); ------------------------------------------- -- CASE CONDITIONAL COMMON SCAFFOLDING -- ------------------------------------------- - -- The following actually provides all that is necessary to load cases of - -- dependencies or properties. + -- The following provides all that is necessary to load cases of + -- conditional trees (dependencies, properties, availability). generic with package Condtrees is new Conditional_Trees (<>); with package Condcases is new Common_Cases (Condtrees); + with function Default return Condtrees.Tree; package Conditional_Instances is -- Given the common base of Dependencies and Properties, we can reuse @@ -129,7 +62,7 @@ package body Alire.TOML_Expressions.Cases is package Trees is new Enum_Trees (Tree => Condtrees.Tree, "and" => Condtrees."and", - Default => Condtrees.Empty); + Default => Default); -- I.e., Conditional.Dependencies & Conditional.Properties Loaders : array (Case_Loader_Keys) of Trees.Recursive_Case_Loader := @@ -188,8 +121,10 @@ package body Alire.TOML_Expressions.Cases is -- CASE DEPENDENCIES SCAFFOLDING -- ------------------------------------- - package Deps is new Conditional_Instances (Conditional.For_Dependencies, - Cases_Deps); + package Deps is new Conditional_Instances + (Conditional.For_Dependencies, + Cases_Deps, + Conditional.For_Dependencies.Empty); ----------------------- -- Load_Dependencies -- @@ -205,12 +140,44 @@ package body Alire.TOML_Expressions.Cases is Conditional.Deps_From_TOML'Access); end Load_Dependencies; + ------------------------------------- + -- CASE AVAILABILITY SCAFFOLDING -- + ------------------------------------- + + function Available_Default return Conditional.For_Available.Tree + is (Conditional.For_Available.Tree (Conditional.Available_Default)); + -- We need an explicit default for available, or conditional expressions + -- show an ugly (empty) in user output. + + package Avail is new Conditional_Instances + (Conditional.For_Available, + Cases_Avail, + Available_Default); + + ----------------------- + -- Load_Availability -- + ----------------------- + + function Load_Availability (From : TOML_Adapters.Key_Queue) + return Conditional.Availability is + begin + Set_Up_Loaders; + return + (Avail.Load_Instance + (TOML_Keys.Available, + From, + Conditional.Available_From_TOML'Access) + with null record); + end Load_Availability; + ------------------------------------- -- CASE PROPERTIES SCAFFOLDING -- ------------------------------------- - package Props is new Conditional_Instances (Conditional.For_Properties, - Cases_Props); + package Props is new Conditional_Instances + (Conditional.For_Properties, + Cases_Props, + Conditional.For_Properties.Empty); ------------------- -- Load_Property -- @@ -243,10 +210,7 @@ package body Alire.TOML_Expressions.Cases is begin Deps.Set_Up_Loaders; Props.Set_Up_Loaders; - Reqs.Loaders := (Distribution => Reqs.Distro_Loader.Load_Cases'Access, - OS => Reqs.OS_Loader.Load_Cases'Access, - Toolchain => Reqs.Toolchain_Loader.Load_Cases'Access, - Word_Size => Reqs.WS_Loader.Load_Cases'Access); + Avail.Set_Up_Loaders; end Set_Up_Loaders; end Alire.TOML_Expressions.Cases; diff --git a/src/alire/alire-toml_expressions-cases.ads b/src/alire/alire-toml_expressions-cases.ads index dfa028a9..35968524 100644 --- a/src/alire/alire-toml_expressions-cases.ads +++ b/src/alire/alire-toml_expressions-cases.ads @@ -20,8 +20,8 @@ package Alire.TOML_Expressions.Cases with Preelaborate is -- key and values must agree). We explicitly pass a Loader for the property -- that is being resolved. - function Load_Requisites (From : TOML_Adapters.Key_Queue) - return Requisites.Tree; + function Load_Availability (From : TOML_Adapters.Key_Queue) + return Conditional.Availability; -- From is an "available = ..." table. end Alire.TOML_Expressions.Cases; diff --git a/src/alire/alire-toml_expressions.ads b/src/alire/alire-toml_expressions.ads index 0b86e6c6..8a7b8997 100644 --- a/src/alire/alire-toml_expressions.ads +++ b/src/alire/alire-toml_expressions.ads @@ -1,5 +1,4 @@ with Alire.TOML_Adapters; -with Alire.Requisites; with TOML; @@ -85,6 +84,11 @@ package Alire.TOML_Expressions with Preelaborate is -- but used down the road by other instances. package Enum_Trees is + -- TODO: this was used to abstract the two kinds of trees mentioned in + -- the next paragraph. Now, only Conditional_Trees remain, so this is + -- unnecessary. To be removed when the case expressions are reworked + -- to remove generics. + -- A tree of values that will be have leaves containing cases with -- values. Either Boolean_Trees, for requisites, or Conditional_Trees, -- for Dependencies and Properties. diff --git a/src/alire/alire-toml_index.ads b/src/alire/alire-toml_index.ads index bbade5c0..34a2b938 100644 --- a/src/alire/alire-toml_index.ads +++ b/src/alire/alire-toml_index.ads @@ -3,7 +3,6 @@ private with TOML; with Alire.Index_On_Disk; with Alire.Crates; with Alire.Releases; -with Alire.Requisites; with Alire.TOML_Adapters; with Semantic_Versioning; diff --git a/src/alire/alire-toml_load.adb b/src/alire/alire-toml_load.adb index e1d617a3..7456b642 100644 --- a/src/alire/alire-toml_load.adb +++ b/src/alire/alire-toml_load.adb @@ -46,12 +46,11 @@ package body Alire.TOML_Load is From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; - Avail : in out Requisites.Tree) + Avail : in out Conditional.Availability) is use TOML; use type Conditional.Dependencies; use type Conditional.Properties; - use type Requisites.Tree; TOML_Avail : TOML.TOML_Value; TOML_Deps : TOML.TOML_Value; @@ -98,17 +97,22 @@ package body Alire.TOML_Load is -- Process Available - if Allowed_Tables (Section, Available) then - if From.Pop (TOML_Keys.Available, TOML_Avail) then - Avail := Avail and - TOML_Expressions.Cases.Load_Requisites - (TOML_Adapters.From (TOML_Avail, - From.Message (TOML_Keys.Available))); + declare + use Conditional; + -- use type Conditional.Availability fails to make "and" visible (?) + begin + if Allowed_Tables (Section, Available) then + if From.Pop (TOML_Keys.Available, TOML_Avail) then + Avail := Avail and + TOML_Expressions.Cases.Load_Availability + (TOML_Adapters.From (TOML_Avail, + From.Message (TOML_Keys.Available))); + end if; + elsif From.Unwrap.Has (TOML_Keys.Available) then + From.Checked_Error ("found field not allowed in manifest section: " + & TOML_Keys.Available); end if; - elsif From.Unwrap.Has (TOML_Keys.Available) then - From.Checked_Error ("found field not allowed in manifest section: " - & TOML_Keys.Available); - end if; + end; -- Process remaining keys, which must be properties diff --git a/src/alire/alire-toml_load.ads b/src/alire/alire-toml_load.ads index 2534e613..fb160da4 100644 --- a/src/alire/alire-toml_load.ads +++ b/src/alire/alire-toml_load.ads @@ -1,6 +1,5 @@ with Alire.Conditional; with Alire.Crates; -with Alire.Requisites; with Alire.TOML_Adapters; with TOML; @@ -21,7 +20,7 @@ package Alire.TOML_Load is From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; - Avail : in out Requisites.Tree); + Avail : in out Conditional.Availability); -- Loads parts of a manifest, taking into account if we are loading -- a indexed release, a local release, a external shared section or -- a external private section. diff --git a/src/alr/alr-commands-show.adb b/src/alr/alr-commands-show.adb index 70f17e23..e43f0840 100644 --- a/src/alr/alr-commands-show.adb +++ b/src/alr/alr-commands-show.adb @@ -1,10 +1,10 @@ +with Alire.Conditional; with Alire.Dependencies; with Alire.Index; with Alire.Milestones; with Alire.Platform; with Alire.Platforms; with Alire.Releases; -with Alire.Requisites.Booleans; with Alire.Root; with Alire.Roots.Optional; with Alire.Solutions; @@ -130,7 +130,7 @@ package body Alr.Commands.Show is (if Cmd.System then Alire.Platform.Distribution else Alire.Platforms.Distro_Unknown); - Available : constant Alire.Requisites.Tree := + Available : constant Alire.Conditional.Availability := (if Cmd.System then External.On_Platform (Platform.Properties).Available @@ -147,9 +147,7 @@ package body Alr.Commands.Show is else "") .Append (Detail (I)) .Append (if I = Detail.First_Index - then Alire.Requisites.Default_To - (Available, - Alire.Requisites.Booleans.Always_True).Image + then Available.Image_One_Line else ""); if I /= Detail.Last_Index then Table.New_Row; diff --git a/testsuite/tests/index/case-expressions/test.py b/testsuite/tests/index/case-expressions/test.py index 244b0960..53e32678 100644 --- a/testsuite/tests/index/case-expressions/test.py +++ b/testsuite/tests/index/case-expressions/test.py @@ -22,14 +22,14 @@ assert_match(".*Available when: .case OS is LINUX => True, MACOS => False, " # Properties -assert_match(".*case Word_Size is .* when Bits_32 => .Executable: hello32.*", +assert_match(".*case Word_Size is .* when Bits_32 => Executable: hello32.*", p.out, flags=re.S) -assert_match(".*case OS is .* when Linux => .GPR External: OS := linux.*", +assert_match(".*case OS is .* when Linux => GPR External: OS := linux.*", p.out, flags=re.S) # Dependencies -assert_match(".*Dependencies .direct.:.*case OS is.*when Linux => .libhello\^1.*", +assert_match(".*Dependencies .direct.:.*case OS is.*when Linux => libhello\^1.*", p.out, flags=re.S) # Check that evaluation for the current platform does work diff --git a/testsuite/tests/index/environment/test.py b/testsuite/tests/index/environment/test.py index 57c306c8..615fd9e7 100644 --- a/testsuite/tests/index/environment/test.py +++ b/testsuite/tests/index/environment/test.py @@ -13,7 +13,7 @@ import os p = run_alr('show', 'hello') assert_match('.*' - ' when Linux => \(Environment: CONDVAR=uvw\)\n' + ' when Linux => Environment: CONDVAR=uvw\n' '.*' ' Environment: VAR1=\${VAR1}:abc\n' ' Environment: VAR2=xyz:\${VAR2}\n' diff --git a/testsuite/tests/show/jekyll/test.py b/testsuite/tests/show/jekyll/test.py index cee9485f..605a4f5c 100644 --- a/testsuite/tests/show/jekyll/test.py +++ b/testsuite/tests/show/jekyll/test.py @@ -21,7 +21,7 @@ assert_eq( '"other-tag"]\n' 'version: "1.0.1"\n' 'short_description: "\\"Hello, world!\\" demonstration project"\n' - 'dependencies: [{crate: "libhello", version: "^1.0"}]\n' + 'dependencies: {crate: "libhello", version: "^1.0"}\n' 'configuration_variables: [{name: \'Var1\', type: \'Boolean\'},\n' '{name: \'Var2\', type: \'String\', default: "str"},\n' '{name: \'Var3\', type: \'Enum (A, B)\', default: "A"},\n' diff --git a/testsuite/tests/with/dynamic-dependencies/test.py b/testsuite/tests/with/dynamic-dependencies/test.py index bcced744..a7b4f7d3 100644 --- a/testsuite/tests/with/dynamic-dependencies/test.py +++ b/testsuite/tests/with/dynamic-dependencies/test.py @@ -45,9 +45,9 @@ p = run_alr('with', '--del', 'superhello', assert_match(".*" + re.escape("Skipping unsupported conditional dependency: " - "(case OS is LINUX => (superhello*), " - "MACOS => (superhello*), WINDOWS => (superhello*), " - "OS_UNKNOWN => (superhello*))") + + "(case OS is LINUX => superhello*, " + "MACOS => superhello*, WINDOWS => superhello*, " + "OS_UNKNOWN => superhello*)") + ".*" + re.escape("Crate slated for removal is not among" " direct static dependencies: superhello") + -- 2.39.5