From 556c9b8b136ac4c84f1b4a1db73f8370d7628c1f Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Tue, 9 Mar 2021 19:36:29 +0100 Subject: [PATCH] Refactor the expression loader (#702) * Pseudotypes specs * Preparations to replace the generics mesh * Buildable with the new design, still unimplemented Only stub bodies * New expression loader complete, pending ptypes * Renamed packages Pseudotypes.* to Expressions.* * Alire.Expressions.* implementation complete * All functionality complete, tests missing * System externals now reuse dynamic loaders * Fixes found by the testsuite, and output tweaks There is a functional difference that affects the output for some tests: before, all enum cases received a value, even if it came from an "others" clause. This meant that all cases were explicitly listed. Now, the "others" is stored as is, and the output reproduces the contents of the TOML structure. A few tests had to be adjusted for this. * Fixes found testing the current stable index * Remove obsolete documentation * Implement and test 'x|y' expressions * Improve output of `alr show` for system packages * Fixes found during self-review: comments, dead code * Fix for system externals report * Alternative implementation for older GNATs --- doc/catalog-format-spec.md | 16 -- src/alire/alire-conditional.ads | 7 - .../alire-conditional_trees-case_nodes.adb | 227 ++++++++++++++++ .../alire-conditional_trees-case_nodes.ads | 20 ++ src/alire/alire-conditional_trees-cases.adb | 129 --------- src/alire/alire-conditional_trees-cases.ads | 20 -- .../alire-conditional_trees-toml_load.adb | 185 +++++++++++++ .../alire-conditional_trees-toml_load.ads | 25 ++ src/alire/alire-conditional_trees.adb | 22 +- src/alire/alire-conditional_trees.ads | 18 +- src/alire/alire-crates.adb | 17 +- src/alire/alire-crates.ads | 6 +- src/alire/alire-dependencies-states.adb | 3 +- src/alire/alire-expressions-enums.adb | 26 ++ src/alire/alire-expressions-enums.ads | 13 + src/alire/alire-expressions-maps.adb | 78 ++++++ src/alire/alire-expressions-maps.ads | 128 +++++++++ src/alire/alire-expressions.adb | 66 +++++ src/alire/alire-expressions.ads | 80 ++++++ src/alire/alire-externals-from_system.adb | 230 ++++++++-------- src/alire/alire-externals-from_system.ads | 50 ++-- src/alire/alire-externals.adb | 7 +- src/alire/alire-externals.ads | 6 +- src/alire/alire-features-index.adb | 12 +- src/alire/alire-features-index.ads | 7 +- src/alire/alire-index_on_disk.adb | 3 +- src/alire/alire-index_on_disk.ads | 2 +- src/alire/alire-manifest.adb | 4 +- src/alire/alire-platforms.ads | 2 +- src/alire/alire-properties-from_toml.adb | 39 +-- src/alire/alire-properties-from_toml.ads | 57 ++-- src/alire/alire-properties-labeled.adb | 49 ---- src/alire/alire-properties-labeled.ads | 12 - src/alire/alire-publish.adb | 12 +- src/alire/alire-releases.adb | 61 ++--- src/alire/alire-releases.ads | 5 +- src/alire/alire-roots-optional.adb | 3 +- src/alire/alire-toml_adapters.adb | 13 + src/alire/alire-toml_adapters.ads | 22 +- src/alire/alire-toml_expressions-cases.adb | 216 --------------- src/alire/alire-toml_expressions-cases.ads | 27 -- src/alire/alire-toml_expressions.adb | 256 ------------------ src/alire/alire-toml_expressions.ads | 162 ----------- src/alire/alire-toml_index.adb | 30 +- src/alire/alire-toml_index.ads | 4 +- src/alire/alire-toml_keys.ads | 1 + src/alire/alire-toml_load.adb | 82 ++++-- src/alire/alire-toml_load.ads | 3 +- src/alire/alire-utils.adb | 13 +- src/alire/alire-utils.ads | 6 +- src/alr/alr-commands-index.adb | 4 +- src/alr/alr-commands-show.adb | 7 +- src/alr/alr-commands-withing.adb | 8 +- src/alr/alr-commands.adb | 10 +- src/alr/alr-commands.ads | 4 +- .../cases_index/he/hello/hello-0.9.0.toml | 11 + .../cases_index/he/hello/hello-1.0.1.toml | 2 +- .../li/libhello/libhello-1.0.0-linuxonly.toml | 2 +- .../tests/index/case-expressions/test.py | 17 +- testsuite/tests/index/environment/test.py | 2 +- .../tests/index/external-available/test.py | 2 +- .../index/origin-filesystem-bad-path/test.py | 4 +- .../index/too-long-short-description/test.py | 4 +- .../tests/with/dynamic-dependencies/test.py | 4 +- 64 files changed, 1321 insertions(+), 1242 deletions(-) create mode 100644 src/alire/alire-conditional_trees-case_nodes.adb create mode 100644 src/alire/alire-conditional_trees-case_nodes.ads delete mode 100644 src/alire/alire-conditional_trees-cases.adb delete mode 100644 src/alire/alire-conditional_trees-cases.ads create mode 100644 src/alire/alire-conditional_trees-toml_load.adb create mode 100644 src/alire/alire-conditional_trees-toml_load.ads create mode 100644 src/alire/alire-expressions-enums.adb create mode 100644 src/alire/alire-expressions-enums.ads create mode 100644 src/alire/alire-expressions-maps.adb create mode 100644 src/alire/alire-expressions-maps.ads create mode 100644 src/alire/alire-expressions.adb create mode 100644 src/alire/alire-expressions.ads delete mode 100644 src/alire/alire-toml_expressions-cases.adb delete mode 100644 src/alire/alire-toml_expressions-cases.ads delete mode 100644 src/alire/alire-toml_expressions.adb delete mode 100644 src/alire/alire-toml_expressions.ads create mode 100644 testsuite/fixtures/cases_index/he/hello/hello-0.9.0.toml diff --git a/doc/catalog-format-spec.md b/doc/catalog-format-spec.md index a7e69209..069a9ce3 100644 --- a/doc/catalog-format-spec.md +++ b/doc/catalog-format-spec.md @@ -415,22 +415,6 @@ static, i.e. they cannot depend on the context. hashes = ["sha512:bf6082573dc537836ea8506a2c9a75dc7837440c35c5b02a52add52e38293640d99e90a9706690591f8899b8b4935824b195f230b3aa1c4da10911e3caf954c04ac"] ``` - If the package only maps a package from the system package manager, - (for instance `make`), use: - - ```toml - origin = "native:make" - ``` - - Have the expression evaluate to an empty string to indicate that the package is - not available, or just leave the alternative out. For instance, to state - that `make` is available on Debian/Ubuntu and not on the other platforms: - - ```toml - [origin.'case(distribution)'] - 'debian|ubuntu' = "native:make" - ``` - - `available`: optional dynamic boolean expression. If it evaluates to `false`, the package is not available for the current platform. diff --git a/src/alire/alire-conditional.ads b/src/alire/alire-conditional.ads index f6042773..3b816dae 100644 --- a/src/alire/alire-conditional.ads +++ b/src/alire/alire-conditional.ads @@ -76,13 +76,6 @@ package Alire.Conditional with Preelaborate is function No_Properties return Properties is (For_Properties.Empty); - type Property_Loader is access - function (From : TOML_Adapters.Key_Queue) - return Conditional.Properties; - -- Function provided by each concrete Property class for TOML loading. - -- From is always a table "prop-name = whatever". - -- These may raise Checked_Error. - -------------------- -- Availability -- -------------------- diff --git a/src/alire/alire-conditional_trees-case_nodes.adb b/src/alire/alire-conditional_trees-case_nodes.adb new file mode 100644 index 00000000..1416c4e6 --- /dev/null +++ b/src/alire/alire-conditional_trees-case_nodes.adb @@ -0,0 +1,227 @@ +with Alire.TOML_Adapters; + +with GNAT.IO; + +package body Alire.Conditional_Trees.Case_Nodes is + + type Case_Node is new Node with record + Cases : Map; + end record; + + overriding + function Evaluate (This : Case_Node; + Against : Properties.Vector) + return Tree'Class; + + overriding + function Flatten (This : Case_Node) return Node'Class; + + overriding + function Image (This : Case_Node) return String; + + overriding + function Leaf_Count (This : Case_Node) return Positive; + + overriding + procedure Print (This : Case_Node; + Prefix : String; + Verbose : Boolean; + Sorted : Boolean); + + overriding + procedure To_TOML (This : Case_Node; Parent : TOML.TOML_Value); + + overriding + function To_YAML (This : Case_Node) return String; + + ------------------ + -- Contains_ORs -- + ------------------ + + overriding + function Contains_ORs (This : Case_Node) return Boolean is (False); + + -------------------- + -- Is_Conditional -- + -------------------- + + overriding + function Is_Conditional (This : Case_Node) return Boolean is (True); + + -------------------- + -- Image_One_Line -- + -------------------- + + function Image_One_Line (This : Map) return String is + Result : UString; + use UStrings; + + Keys : constant Case_Maps.Key_Array := + This.Keys (Ada_Like => True, Exclude_Others => False); + begin + for I in Keys'Range loop + Append (Result, + String'( + TOML_Adapters.Adafy (+Keys (I)) + & " => " & This.Element (+Keys (I)).Image_One_Line)); + if I /= Keys'Last then + Append (Result, ", "); + end if; + end loop; + + return +Result; + end Image_One_Line; + + ----------- + -- Image -- + ----------- + + overriding + function Image (This : Case_Node) return String is + ("(case " & This.Cases.Base.Name & " is " + & Image_One_Line (This.Cases) & ")"); + + ----------- + -- Print -- + ----------- + + overriding + procedure Print (This : Case_Node; + Prefix : String; + Verbose : Boolean; + Sorted : Boolean) + is + use GNAT.IO; + Tab : constant String := " "; + begin + Put_Line (Prefix & "case " & This.Cases.Base.Name & " is"); + for Key of This.Cases.Keys (Ada_Like => True, Exclude_Others => False) + loop + Put_Line (Prefix & Tab & "when " + & TOML_Adapters.Adafy (+Key) & " => " + & (if not Verbose + then This.Cases.Element (+Key).Image_One_Line + else "")); + if Verbose then + Print (This.Cases.Element (+Key), + Prefix & Tab & Tab, Verbose, Sorted); + end if; + end loop; + end Print; + + -------------- + -- Evaluate -- + -------------- + + overriding + function Evaluate (This : Case_Node; + Against : Properties.Vector) + return Tree'Class + is + Var_Seen : Boolean := False; + Val_Seen : Boolean := False; + begin + return Eval : Tree := Empty do + for Prop of Against loop + + -- Mark that we have seen a property with a value for this case + if Prop.Key = This.Cases.Base.Key then + Var_Seen := True; + end if; + + for Value of This.Cases.Keys (Ada_Like => False, + Exclude_Others => True) + loop + if Expressions.Satisfies (Property => Prop, + Var_Key => This.Cases.Base.Key, + Value => +Value) + then + Val_Seen := True; -- We take one of the explicit branches + Eval.Append (This.Cases.Element (+Value).Evaluate (Against)); + end if; + end loop; + end loop; + + -- Use others clause? + + if Var_Seen then + if not Val_Seen and then This.Cases.Has_Others then + Eval.Append (This.Cases.Other.Evaluate (Against)); + end if; + else + Trace.Warning + ("Missing variable in environment: " + & This.Cases.Base.Key & "; 'other' expressions discarded"); + -- Not sure if this may happen and what we should do in that case; + -- take the others branch or drop it as if the var was NaN + end if; + end return; + end Evaluate; + + ---------------- + -- Leaf_Count -- + ---------------- + + overriding + function Leaf_Count (This : Case_Node) return Positive + is + function Count (This : Tree) return Natural renames Leaf_Count; + begin + return This.Cases.Size (Count'Access); + end Leaf_Count; + + ------------- + -- Flatten -- + ------------- + + overriding + function Flatten (This : Case_Node) return Node'Class is + Flat : Tree; + begin + for Key of This.Cases.Keys (Exclude_Others => True, Ada_Like => False) + loop + if not This.Cases.Element (+Key).Is_Empty then + Flat := Flat and To_Tree (This.Cases.Element (+Key).Root.Flatten); + end if; + end loop; + + if This.Cases.Has_Others then + if not This.Cases.Other.Is_Empty then + Flat := Flat and To_Tree (This.Cases.Other.Root.Flatten); + end if; + end if; + + return Flat.Root; + end Flatten; + + ------------- + -- To_TOML -- + ------------- + + overriding + procedure To_TOML (This : Case_Node; Parent : TOML.TOML_Value) is + begin + raise Unimplemented; + -- Not yet needed, unless we implement full-fledged case exports + end To_TOML; + + ------------- + -- To_YAML -- + ------------- + + overriding + function To_YAML (This : Case_Node) return String is + begin + raise Unimplemented; + -- Not yet needed, unless we implement full-fledged case exports + return ""; + end To_YAML; + + -------------- + -- New_Case -- + -------------- + + function New_Case (Cases : Map) return Tree + is (To_Tree (Case_Node'(Cases => Cases))); + +end Alire.Conditional_Trees.Case_Nodes; diff --git a/src/alire/alire-conditional_trees-case_nodes.ads b/src/alire/alire-conditional_trees-case_nodes.ads new file mode 100644 index 00000000..4fc44400 --- /dev/null +++ b/src/alire/alire-conditional_trees-case_nodes.ads @@ -0,0 +1,20 @@ +with Alire.Expressions.Maps; + +private generic +package Alire.Conditional_Trees.Case_Nodes with Preelaborate is + + -- NOTE: this package must be instantiated at library level + + -- 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. + + package Case_Maps is new Expressions.Maps (Tree); + -- Every case value points to a subtree + + subtype Map is Case_Maps.Map; + + function New_Case (Cases : Map) return Tree; + -- Wrap an expression map as a case node for the conditional tree + +end Alire.Conditional_Trees.Case_Nodes; diff --git a/src/alire/alire-conditional_trees-cases.adb b/src/alire/alire-conditional_trees-cases.adb deleted file mode 100644 index 1261fe59..00000000 --- a/src/alire/alire-conditional_trees-cases.adb +++ /dev/null @@ -1,129 +0,0 @@ -with GNAT.IO; - -package body Alire.Conditional_Trees.Cases is - - use all type Enum; - - type Case_Node is new Node with record - Cases : Cases_Array; - end record; - -- A new node class to store a case statement. - - overriding - function Evaluate (This : Case_Node; - Against : Properties.Vector) - return Tree'Class; - - overriding - procedure To_TOML (This : Case_Node; Parent : TOML.TOML_Value); - - overriding - function To_YAML (This : Case_Node) return String; - - overriding - function Contains_ORs (This : Case_Node) return Boolean is (False); - - overriding - function Flatten (This : Case_Node) return Node'Class; - - overriding - function Is_Conditional (This : Case_Node) return Boolean is (True); - - function Image_Case (Cases : Cases_Array; - I : Enum) return String is - (I'Img & " => " & Cases (I).Image_One_Line - & (if I /= Cases'Last - then ", " & Image_Case (Cases, Enum'Succ (I)) - else "")); - - overriding - function Image (This : Case_Node) return String is - ("(case " & Enum_Cases.Name & " is " - & Image_Case (This.Cases, This.Cases'First) & ")"); - - overriding - function Leaf_Count (This : Case_Node) return Positive; - - overriding - procedure Print (This : Case_Node; - Prefix : String; - Verbose : Boolean; - Sorted : Boolean) - is - use GNAT.IO; - Tab : constant String := " "; - begin - 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 " - & Utils.To_Mixed_Case (I'Img) & " => " - & (if not Verbose - then This.Cases (I).Image_One_Line - else "")); - if Verbose then - Print (This.Cases (I), Prefix & Tab & Tab, Verbose, Sorted); - end if; - end if; - end loop; - end Print; - - overriding - function Evaluate (This : Case_Node; - Against : Properties.Vector) - return Tree'Class is - begin - return Eval : Tree := Empty do - for I in This.Cases'Range loop - if Enum_Cases.Is_Satisfied (I, Against) then - Eval := Eval and This.Cases (I).Evaluate (Against); - end if; - end loop; - end return; - end Evaluate; - - overriding - function Leaf_Count (This : Case_Node) return Positive is - Count : Natural := 0; - begin - for Tree of This.Cases loop - Count := Count + Tree.Leaf_Count; - end loop; - - return Count; - end Leaf_Count; - - overriding - function Flatten (This : Case_Node) return Node'Class is - Flat : Tree; - begin - for T of This.Cases loop - if not T.Is_Empty then - Flat := Flat and To_Tree (T.Root.Flatten); - end if; - end loop; - - return Flat.Root; - end Flatten; - - overriding - procedure To_TOML (This : Case_Node; Parent : TOML.TOML_Value) is - begin - raise Unimplemented; - end To_TOML; - - overriding - function To_YAML (This : Case_Node) return String is - begin - raise Unimplemented; - return ""; - end To_YAML; - - -------------- - -- New_Case -- - -------------- - - function New_Case (Cases : Cases_Array) return Tree is - (To_Tree (Case_Node'(Cases => Cases))); - -end Alire.Conditional_Trees.Cases; diff --git a/src/alire/alire-conditional_trees-cases.ads b/src/alire/alire-conditional_trees-cases.ads deleted file mode 100644 index d54d0b64..00000000 --- a/src/alire/alire-conditional_trees-cases.ads +++ /dev/null @@ -1,20 +0,0 @@ -with Alire.Properties.Cases; - -generic - 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 Enum_Cases.Enum; - - type Cases_Array is array (Enum) of Tree; - -- Every case points to a dependency tree, that at leaves will have - -- a single dependency. - - function New_Case (Cases : Cases_Array) return Tree; - -- This function is needed by the case(xx) expression loaders. - -end Alire.Conditional_Trees.Cases; diff --git a/src/alire/alire-conditional_trees-toml_load.adb b/src/alire/alire-conditional_trees-toml_load.adb new file mode 100644 index 00000000..044bcf0c --- /dev/null +++ b/src/alire/alire-conditional_trees-toml_load.adb @@ -0,0 +1,185 @@ +with Alire.Conditional_Trees.Case_Nodes; +with Alire.TOML_Keys; + +package body Alire.Conditional_Trees.TOML_Load is + + Others_Key : String renames TOML_Keys.Case_Others; + + package Case_Nodes is new Conditional_Trees.Case_Nodes; + + ---------- + -- Load -- + ---------- + + function Load (From : TOML_Adapters.Key_Queue; + Loader : not null Static_Loader; + Resolve : Boolean; + Strict : Boolean) + return Tree + is + use TOML; + + ------------------ + -- Process_Case -- + ------------------ + -- Resolve a single case expression, creating a case node. For the + -- leaves, it may recursively call Load. + function Process_Case (Parent : TOML_Adapters.Key_Queue; + Root_Key : String; + Case_Key : String; + Case_Val : TOML_Value) + return Tree + is + use Utils; + + --------------------- + -- Process_Entries -- + --------------------- + + function Process_Entries (Case_Table : TOML_Adapters.Key_Queue) + return Tree + is + Var : constant Expressions.Variable := + Expressions.From + (Key => Head (Tail (Case_Key, '('), ')')); + Map : Case_Nodes.Map := Case_Nodes.Case_Maps.Empty (Var); + -- The map only accepts values matching the Variable + begin + loop + declare + Item_Val : TOML_Value; + Item_Key : constant String := Case_Table.Pop (Item_Val); + Values : constant Utils.String_Vector := + Utils.Split (Item_Key, '|', Trim => True); + -- A single item may store several cases separated by '|' + begin + exit when Item_Key = ""; + + -- Do an initial vetting before loading + + for Value of Values loop + if Value /= Others_Key and then + not Map.Base.Is_Valid (Value) + then + if Strict then + Case_Table.Recoverable_Error + ("invalid enumeration value: " & Item_Key); + else + Trace.Debug + (Case_Table.Message + ("unknown enumeration value: " & Item_Key)); + end if; + end if; + end loop; + + -- Load the value and assign to the appropriate entries + + declare + Branch : constant Tree := + Load -- recursively load the branch + (From => Case_Table.Descend + (Key => Root_Key, + Value => Item_Val, + Context => Item_Key), + Loader => Loader, + Resolve => Resolve, + Strict => Strict); + begin + for Value of Values loop + Map.Insert (Value, Branch); + end loop; + end; + end; + end loop; + + return Case_Nodes.New_Case (Map); + end Process_Entries; + + begin + if Starts_With (Case_Key, "case(") and then + Case_Key (Case_Key'Last) = ')' + then + return Process_Entries (Parent.Descend (Case_Val, Case_Key)); + else + Parent.Checked_Error ("'case(..)' expected; got: " & Case_Key); + end if; + end Process_Case; + + -------------------------- + -- Process_Nested_Table -- + -------------------------- + -- Val is a table that holds either values to be directly loaded by the + -- static loader, or expressions to be resolved by us prior to loading. + function Process_Nested_Table (Key : String; Val : TOML_Value) + return Tree + is + Table : constant TOML_Adapters.Key_Queue := + From.Descend (Val, "values"); + begin + return Result : Tree do + + -- We need to pop and resolve expressions, and send all the + -- remaining keys together to the static loader. + + loop + declare + Case_Val : TOML_Value; + Case_Key : constant String := + Table.Pop_Expr ("case(", Case_Val); + begin + exit when Case_Key = ""; -- Table contains no more cases + + Result.Append + (Process_Case (From, Key, Case_Key, Case_Val)); + end; + end loop; + + -- Finally, process remaining contents as a single static value + + if Val.Keys'Length > 0 then + Result.Append + (Loader + (From.Descend + (Key => Key, + Value => Val, + Context => Key))); + end if; + end return; + end Process_Nested_Table; + + begin + + -- Ensure only one top-level value provided + + From.Assert + (From.Unwrap.Kind = TOML_Table, + "Expected a table but got: " & From.Unwrap.Kind'Image); + + From.Assert + (From.Unwrap.Keys'Length = 1, + "Expected a single entry in table, but got:" + & From.Unwrap.Keys'Length'Image); + + -- Get the key = ... and process it + + declare + Val : TOML_Value; + Key : constant String := From.Pop (Val); + begin + -- Val might be a dynamic expression, or a value to be processed by + -- the static loader. If the value isn't a table, certainly it isn't + -- an expression. + + if Val.Kind /= TOML_Table then + return Loader (From.Descend + (Key => Key, + Value => Val, + Context => Key)); + else + -- See what the Val table holds + return Process_Nested_Table (Key, Val); + end if; + end; + end Load; + +end Alire.Conditional_Trees.TOML_Load; diff --git a/src/alire/alire-conditional_trees-toml_load.ads b/src/alire/alire-conditional_trees-toml_load.ads new file mode 100644 index 00000000..43f9281d --- /dev/null +++ b/src/alire/alire-conditional_trees-toml_load.ads @@ -0,0 +1,25 @@ +with Alire.TOML_Adapters; + +generic +package Alire.Conditional_Trees.TOML_Load is + + -- NOTE: this package must be instantiated at library level + + type Static_Loader is access + function (From : TOML_Adapters.Key_Queue) return Tree; + -- A function that receives a table "key = ...", with key being the name of + -- the value in the index (e.g., available, depends-on, executables, ...). + -- The loaded values are returned already as an (unconditional) tree. + + function Load (From : TOML_Adapters.Key_Queue; + Loader : not null Static_Loader; + Resolve : Boolean; + Strict : Boolean) + return Tree; + -- Expects a "key = val" or "key.expr = val" table. Takes care of resolving + -- any dynamic expressions. Currently, only 'case()' is understood. When + -- resolve, dynamic expressions are resolved; otherwise Checked_Error will + -- be raised. When Resolve and Strict, unknown values in cases are not + -- allowed. If not Resolve, Strict is ignored. + +end Alire.Conditional_Trees.TOML_Load; diff --git a/src/alire/alire-conditional_trees.adb b/src/alire/alire-conditional_trees.adb index 12bb1bdc..f5c9e6c7 100644 --- a/src/alire/alire-conditional_trees.adb +++ b/src/alire/alire-conditional_trees.adb @@ -300,6 +300,17 @@ package body Alire.Conditional_Trees is return Col; end Enumerate; + ------------- + -- As_List -- + ------------- + + function As_List (This : Tree) return Value_Lists.List is + function Enumerate is + new Conditional_Trees.Enumerate (Value_Lists.List, Value_Lists.Append); + begin + return Enumerate (This); + end As_List; + -------------- -- Evaluate -- -------------- @@ -430,15 +441,16 @@ package body Alire.Conditional_Trees is -- Print -- ----------- - procedure Print (This : Tree; - Prefix : String := ""; - And_Or : Boolean := True; - Sorted : Boolean := False) is + procedure Print (This : Tree; + Prefix : String := ""; + Verbose : Boolean := False; + And_Or : Boolean := True; + Sorted : Boolean := False) is begin if This.Is_Empty then GNAT.IO.Put_Line (Prefix & "(empty)"); else - Print (This.Root, Prefix, And_Or, Sorted); + Print (This.Root, Prefix, And_Or or Verbose, Sorted); end if; end Print; diff --git a/src/alire/alire-conditional_trees.ads b/src/alire/alire-conditional_trees.ads index e05b2bba..d3c4c33d 100644 --- a/src/alire/alire-conditional_trees.ads +++ b/src/alire/alire-conditional_trees.ads @@ -1,4 +1,4 @@ -with Ada.Containers; use Ada.Containers; +with Ada.Containers.Indefinite_Doubly_Linked_Lists; use Ada.Containers; with Ada.Iterator_Interfaces; with Alire.Interfaces; @@ -152,10 +152,11 @@ package Alire.Conditional_Trees with Preelaborate is -- Check properties in conditional nodes to return the applicable elements. -- Returns a Tree because it could result in an empty tree. - procedure Print (This : Tree; - Prefix : String := ""; - And_Or : Boolean := True; - Sorted : Boolean := False); + procedure Print (This : Tree; + Prefix : String := ""; + Verbose : Boolean := False; + And_Or : Boolean := True; + Sorted : Boolean := False); -- Use And_Or = false when only And can appear, in which case there is no -- need to distinguish and the output is slightly more compact. @@ -257,6 +258,13 @@ package Alire.Conditional_Trees with Preelaborate is function To_Tree (N : Node'Class) return Tree; + package Value_Lists is + new Ada.Containers.Indefinite_Doubly_Linked_Lists (Values); + + function As_List (This : Tree) return Value_Lists.List; + -- Default Enumerate implementation. Remember that this does not resolve + -- expressions; merely flattens all leaf nodes. + private type Node is abstract new Interfaces.Yamlable with null record; diff --git a/src/alire/alire-crates.adb b/src/alire/alire-crates.adb index e4c9b351..81a0e2dd 100644 --- a/src/alire/alire-crates.adb +++ b/src/alire/alire-crates.adb @@ -80,8 +80,9 @@ package body Alire.Crates is -- From_Externals_Manifest -- ----------------------------- - function From_Externals_Manifest (From : TOML_Adapters.Key_Queue) - return Crate + function From_Externals_Manifest (From : TOML_Adapters.Key_Queue; + Strict : Boolean) + return Crate is begin From.Assert_Key (TOML_Keys.Name, TOML.TOML_String); @@ -89,7 +90,7 @@ package body Alire.Crates is return This : Crate := New_Crate (+From.Unwrap.Get (TOML_Keys.Name).As_String) do - This.Load_Externals (From); + This.Load_Externals (From, Strict); end return; end From_Externals_Manifest; @@ -100,6 +101,7 @@ package body Alire.Crates is procedure Load_Externals (This : in out Crate; From : TOML_Adapters.Key_Queue; + Strict : Boolean; Policy : Policies.For_Index_Merging := Policies.Merge_Priorizing_Existing) is @@ -119,8 +121,10 @@ package body Alire.Crates is for I in 1 .. TOML_Externals.Length loop This.Externals.Detectors.Append (Alire.Externals.From_TOML - (From.Descend (TOML_Externals.Item (I), - "external index" & I'Img))); + (From.Descend + (TOML_Externals.Item (I), + "external index" & I'Img), + Strict)); end loop; end if; end if; @@ -143,7 +147,8 @@ package body Alire.Crates is Properties : Conditional.Properties; begin TOML_Load.Load_Crate_Section - (Section => External_Shared_Section, + (Strict => Strict, + Section => External_Shared_Section, From => From, Props => Properties, Deps => Unused_Deps, diff --git a/src/alire/alire-crates.ads b/src/alire/alire-crates.ads index d179ac27..3bf8d3a7 100644 --- a/src/alire/alire-crates.ads +++ b/src/alire/alire-crates.ads @@ -64,13 +64,15 @@ package Alire.Crates is function Externals (This : Crate) return Alire.Externals.Lists.List; - function From_Externals_Manifest (From : TOML_Adapters.Key_Queue) - return Crate; + function From_Externals_Manifest (From : TOML_Adapters.Key_Queue; + Strict : Boolean) + return Crate; -- Load a manifest containing only external definitions for a crate procedure Load_Externals (This : in out Crate; From : TOML_Adapters.Key_Queue; + Strict : Boolean; Policy : Policies.For_Index_Merging := Policies.Merge_Priorizing_Existing); -- Load externals detectors into an existing crate diff --git a/src/alire/alire-dependencies-states.adb b/src/alire/alire-dependencies-states.adb index 63fa14df..508db73a 100644 --- a/src/alire/alire-dependencies-states.adb +++ b/src/alire/alire-dependencies-states.adb @@ -110,7 +110,8 @@ package body Alire.Dependencies.States is (From.Descend (From.Checked_Pop (Keys.Release, TOML_Table), "release: " & (+Crate)), - Manifest.Index)); + Manifest.Index, + Strict => False)); -- because it may come from elsewhere end case; return Data; diff --git a/src/alire/alire-expressions-enums.adb b/src/alire/alire-expressions-enums.adb new file mode 100644 index 00000000..8ba39b70 --- /dev/null +++ b/src/alire/alire-expressions-enums.adb @@ -0,0 +1,26 @@ +with Alire.Utils; + +package body Alire.Expressions.Enums is + + type Enum_Values is new Expressions.Values with record + Values : Utils.String_Set; + end record; + + overriding + function Is_Valid (This : Enum_Values; Image : String) return Boolean + is (This.Values.Contains (TOML_Adapters.Tomify (Image))); + +begin + declare + Values : Enum_Values; + begin + for Enum_Value in Ada_Enum'Range loop + Values.Values.Insert (TOML_Adapters.Tomify (Enum_Value'Image)); + end loop; + + Trace.Debug ("Registering variable for expressions: " & Key); + Expressions.Register (Var_Key => Key, + Var_Name => Name, + Var_Values => Values); + end; +end Alire.Expressions.Enums; diff --git a/src/alire/alire-expressions-enums.ads b/src/alire/alire-expressions-enums.ads new file mode 100644 index 00000000..286f7120 --- /dev/null +++ b/src/alire/alire-expressions-enums.ads @@ -0,0 +1,13 @@ +with Alire.TOML_Adapters; + +generic + Key : String; -- The TOML key used in the index for this enum + Name : String := TOML_Adapters.Adafy (Key); -- An Ada-like name, overridable + type Ada_Enum is (<>); +package Alire.Expressions.Enums with Elaborate_Body is + + -- Declares a pseudotype that encapsulates an actual Ada enumeration. By + -- instancing this package the type becomes recognizable by the index + -- loading functions. + +end Alire.Expressions.Enums; diff --git a/src/alire/alire-expressions-maps.adb b/src/alire/alire-expressions-maps.adb new file mode 100644 index 00000000..6612f486 --- /dev/null +++ b/src/alire/alire-expressions-maps.adb @@ -0,0 +1,78 @@ +package body Alire.Expressions.Maps is + + ------------ + -- Insert -- + ------------ + + procedure Insert (M : in out Map; V : String; E : Elements) + is + begin + if V = TOML_Keys.Case_Others or else V = "others" then + M.Set_Others (E); + else + if not M.Base.Is_Valid (V) and then Force then + Trace.Debug ("Storing unknown value '" & V & "' for enumeration '" + & Key (M.Base) & "'"); + end if; + M.Entries.Insert (V, E); + end if; + end Insert; + + ---------- + -- Keys -- + ---------- + + function Keys (M : Map; + Ada_Like : Boolean; + Exclude_Others : Boolean) + return Key_Array + is + Pos : Positive := 1; + Result : Key_Array (1 .. Natural (M.Entries.Length) + 1); + begin + for I in M.Entries.Iterate loop + Result (Pos) := +Maps.Key (I); + Pos := Pos + 1; + end loop; + + if M.Has_Others then + if Ada_Like then + Result (Result'Last) := +"others"; + else + Result (Result'Last) := +TOML_Keys.Case_Others; + end if; + end if; + + if Exclude_Others or else not M.Has_Others then + return Result (Result'First .. Result'Last - 1); + else + return Result; + end if; + end Keys; + + ---------------- + -- Set_Others -- + ---------------- + + procedure Set_Others (M : in out Map; E : Elements) is + begin + M.Other.Insert (TOML_Keys.Case_Others, E); + end Set_Others; + + ---------- + -- Size -- + ---------- + + function Size (M : Map; + Count : access function (E : Elements) return Natural) + return Natural + is + begin + return Total : Natural := 0 do + for Elem of M.Entries loop + Total := Total + Count (Elem); + end loop; + end return; + end Size; + +end Alire.Expressions.Maps; diff --git a/src/alire/alire-expressions-maps.ads b/src/alire/alire-expressions-maps.ads new file mode 100644 index 00000000..152d9cae --- /dev/null +++ b/src/alire/alire-expressions-maps.ads @@ -0,0 +1,128 @@ +private with Ada.Containers.Indefinite_Ordered_Maps; + +with Alire.Errors; + +generic + type Elements (<>) is private; +package Alire.Expressions.Maps with Preelaborate is + + type Map is tagged private; + -- The main operation we need in our index expressions is to look up a + -- value from the Variable and get the associated value (a dependency, + -- a property...). These Maps replace the old arrays over a real enum. + + function Empty (V : Variable) return Map; + -- Initialize a map for a particular type, containing no mapping + + function Base (M : Map) return Variable; + -- Retrieve the type for which this Map was declared + + function Contains (M : Map; V : String) return Boolean; + + function Element (M : Map; V : String) return Elements; + -- Get an element from the map. If the key V is not in the map, return the + -- Other value. If no Other has been set, raise Checked_Error. Conditions + -- not given in contract form due to bug in older GNATs. + + type Key_Array is array (Positive range <>) of UString; + + function Keys (M : Map; + Ada_Like : Boolean; + Exclude_Others : Boolean) + return Key_Array; + -- Lazy solution to avoid full-fledged iteration. We don't expect to + -- have more than a few keys anyway. When Ada_Like, "..." is returned as + -- "others" instead. When Exclude_Others, only explicit keys are returned. + + function Other (M : Map) return Elements with + Pre => M.Has_Others; + -- Retrieve the default value for this map + + function Has_Others (M : Map) return Boolean; + -- Say if a default has been set for this map + + procedure Insert (M : in out Map; V : String; E : Elements) with + Post => M.Element (V) = E; + -- Store the mapping V -> E in M. Will fail if the value is already stored. + -- If V = "..." or "others", M.Set_Others is called internally. + + function Size (M : Map; + Count : access function (E : Elements) return Natural) + return Natural; + -- Count how many elements are in the map, with custom Count function (as + -- elements may require recursive counting). + + procedure Set_Others (M : in out Map; E : Elements) with + Post => M.Other = E; + -- Set the default mapping for this map + +private + + package Maps is + new Ada.Containers.Indefinite_Ordered_Maps (String, Elements); + + type Map is tagged record + Valid : Boolean := False; + Base : Variable; + Entries : Maps.Map; + Other : Maps.Map; -- At most one element, key irrelevant + end record; + + ---------- + -- Base -- + ---------- + + function Base (M : Map) return Variable + is (if M.Valid + then M.Base + else raise Checked_Error with "Map is uninitialized"); + + ----------- + -- Empty -- + ----------- + + function Empty (V : Variable) return Map + is (Valid => True, + Base => V, + Entries => <>, + Other => <>); + + -------------- + -- Contains -- + -------------- + + function Contains (M : Map; V : String) return Boolean + is (M.Entries.Contains (V)); + + ------------- + -- Element -- + ------------- + + function Element (M : Map; V : String) return Elements + is (if M.Contains (V) then + M.Entries (V) + elsif M.Has_Others then + Other (M) + else + raise Checked_Error with + Errors.Set ("Map for " & Name (M.Base) + & " does not have a value for " & V)); + + ----------- + -- Other -- + ----------- + + function Other (M : Map) return Elements + is (if M.Other.Is_Empty + then raise Checked_Error with + Errors.Set ("default value in case not set") + else M.Other.First_Element); + + ---------------- + -- Has_Others -- + ---------------- + + function Has_Others (M : Map) return Boolean + is (not M.Other.Is_Empty); + +end Alire.Expressions.Maps; diff --git a/src/alire/alire-expressions.adb b/src/alire/alire-expressions.adb new file mode 100644 index 00000000..a9d22947 --- /dev/null +++ b/src/alire/alire-expressions.adb @@ -0,0 +1,66 @@ +with Ada.Containers.Indefinite_Ordered_Maps; + +with Alire.Errors; +with Alire.TOML_Adapters; + +package body Alire.Expressions is + + package Key_Variable_Maps is + new Ada.Containers.Indefinite_Ordered_Maps (String, Variable); + + package Variable_Value_Maps is + new Ada.Containers.Indefinite_Ordered_Maps (String, Values'Class); + + Variables : Key_Variable_Maps.Map; + + Variable_Values : Variable_Value_Maps.Map; + -- Stores values for all types that have been declared. Indexed by the + -- Variable key. + + ---------- + -- From -- + ---------- + + function From (Key : String) return Variable + is (if not Variables.Contains (Key) + then raise Checked_Error with + Errors.Set ("Expression variable '" & Key & "' is unknown") + else Variables (Key)); + + -------------- + -- Is_Valid -- + -------------- + + function Is_Valid (This : Variable; Value : String) return Boolean + is (if not Variable_Values.Contains (Key (This)) + then raise Checked_Error with + Errors.Set ("Expression variable '" & Key (This) & "' is unknown") + else Variable_Values (Key (This)).Is_Valid (Value)); + + ----------------------- + -- Register_Variable -- + ----------------------- + + procedure Register (Var_Key : String; + Var_Name : String; + Var_Values : Values'Class) + is + begin + Variables.Insert (Var_Key, Variable'(Key => +Var_Key, + Name => +Var_Name)); + Variable_Values.Insert (Var_Key, Var_Values); + end Register; + + --------------- + -- Satisfies -- + --------------- + + function Satisfies (Property : Properties.Property'Class; + Var_Key : String; + Value : String) return Boolean + is (Property.Key = Var_Key and then + Variables.Contains (Var_Key) and then + From (Var_Key).Is_Valid (Value) and then + TOML_Adapters.Tomify (Property.Image) = TOML_Adapters.Tomify (Value)); + +end Alire.Expressions; diff --git a/src/alire/alire-expressions.ads b/src/alire/alire-expressions.ads new file mode 100644 index 00000000..f4eb69a4 --- /dev/null +++ b/src/alire/alire-expressions.ads @@ -0,0 +1,80 @@ +with Alire.Properties; +with Alire.TOML_Keys; + +package Alire.Expressions with Preelaborate is + + -- Support for the distinct enums/types that may appear in a case + -- expression. This was originally done with proper Ada enumerations, for + -- the old Ada index that exposed these types to users. Now, by using these + -- pseudotypes we may remove all the nightmarish instantiations and have a + -- much simpler to maintain/understand code base. + + type Variable is tagged private; + -- A Variable is a set of values belonging to a category. E.g., + -- Operating_System is formed by (Linux, Windows. MacOS). Currently, only + -- enums are supported, but to allow cases on configuration variables + -- other types may be added in the future. + + function From (Key : String) return Variable; + -- Retrieve a previously declared type by its TOML key + + function Is_Valid (This : Variable; Value : String) return Boolean; + -- Says if Value is among the values in This + + function Key (This : Variable) return String; + -- The key that is used in TOML files for this variable + + function Name (This : Variable) return String; + -- The Ada-like name of this variable + + function Satisfies (Property : Properties.Property'Class; + Var_Key : String; + Value : String) return Boolean + with Pre => Value /= TOML_Keys.Case_Others and then + Value /= "others"; + -- Say if a property is satisfied by the value, which must match the + -- Variable and property type (keys must match). Doesn't accept defaults. + +private + + -- Internally, the Variable is registered in a private storage (see + -- Variables map in body), whereas the Variable type simply stores the + -- key to access its declared values. This way it isn't onerous to store + -- instances in every case node in the index. Incidentally, this makes the + -- whole thing thread-unsafe. + + type Variable is tagged record + Key : UString; + Name : UString; + end record; + + ------------ + -- Values -- + ------------ + + type Values is interface; + -- Stores the valid representations for a Variable + + function Is_Valid (V : Values; Image : String) return Boolean is abstract; + -- Say if a value, given as its string image, matches a value of a type + + procedure Register (Var_Key : String; + Var_Name : String; + Var_Values : Values'Class); + -- Makes Alire aware of the existence of a variable usable in expressions + + --------- + -- Key -- + --------- + + function Key (This : Variable) return String + is (+This.Key); + + ---------- + -- Name -- + ---------- + + function Name (This : Variable) return String + is (+This.Name); + +end Alire.Expressions; diff --git a/src/alire/alire-externals-from_system.adb b/src/alire/alire-externals-from_system.adb index e514b17d..03925dde 100644 --- a/src/alire/alire-externals-from_system.adb +++ b/src/alire/alire-externals-from_system.adb @@ -1,32 +1,14 @@ +with Alire.Conditional_Trees.TOML_Load; with Alire.Index; with Alire.Origins.Deployers.System; with Alire.Platform; +with Alire.Properties.Platform; with Alire.Releases; +with Alire.Root; with Alire.TOML_Adapters; -with Alire.TOML_Expressions; -with Alire.TOML_Keys; - -with TOML; package body Alire.Externals.From_System is - --------------------- - -- Candidate_Count -- - --------------------- - - function Candidate_Count (This : Packages) return Natural is - begin - if This.Is_Case then - return Total : Natural := 0 do - for Distro of This.Distro_Candidates loop - Total := Total + Natural (Distro.Length); - end loop; - end return; - else - return Natural (This.Common_Candidates.Length); - end if; - end Candidate_Count; - ------------ -- Detect -- ------------ @@ -48,109 +30,85 @@ package body Alire.Externals.From_System is & (+Name)); return Releases : Containers.Release_Set do - for Candidate of This.System_Candidates (Platform.Distribution) loop - Trace.Detail ("Looking for system package: " & Candidate); - declare - Detector : constant System.Deployer'Class := - System.Platform_Deployer (Candidate); - Result : constant System.Version_Outcomes.Outcome := - Detector.Detect; - begin - if Result.Success then - Trace.Detail ("Success with system package: " & Candidate); - - Releases.Insert - (Index.Crate (Name).Base - .Retagging (Result.Value) - .Replacing (Origins.New_System (Candidate)) - .Replacing (Notes => "Provided by system package: " - & Candidate)); - end if; - end; - end loop; + declare + Origin : constant Conditional_Packages.Tree := + This.Origin.Evaluate (Root.Platform_Properties); + begin + if Origin.Is_Empty then + Trace.Debug ("No system packages for current platform"); + else + for Candidate of Origin.Value.Packages loop + Trace.Detail ("Looking for system package: " & Candidate); + declare + Detector : constant System.Deployer'Class := + System.Platform_Deployer (Candidate); + Result : constant System.Version_Outcomes.Outcome := + Detector.Detect; + begin + if Result.Success then + Trace.Detail ("Success with system package: " + & Candidate); + + Releases.Insert + (Index.Crate (Name).Base + .Retagging (Result.Value) + .Replacing (Origins.New_System (Candidate)) + .Replacing (Notes => "Provided by system package: " + & Candidate)); + end if; + end; + end loop; + end if; + end; end return; end Detect; - --------------- - -- From_TOML -- - --------------- - - function From_TOML (From : TOML_Adapters.Key_Queue) return External is + ---------------------- + -- From_TOML_Static -- + ---------------------- + -- Loads a simple origin = [] origin, for reuse in the dynamic expr loader + function From_TOML_Static (From : TOML_Adapters.Key_Queue) + return Conditional_Packages.Tree + is ---------------- -- From_Array -- ---------------- - function From_Array (Values : TOML.TOML_Value) return External is - (Externals.External with - Origin => - (Is_Case => False, - Common_Candidates => TOML_Adapters.To_Vector (Values))); - - --------------- - -- From_Case -- - --------------- - - function From_Case (Case_From : TOML.TOML_Value) return External is - package Distros is new TOML_Expressions.Enum_Cases - (Platforms.Known_Distributions); - - Result : External := (Externals.External with - Origin => (Is_Case => True, - others => <>)); - begin - if Case_From.Keys'Length /= 1 or else - +Case_From.Keys (1) /= "case(distribution)" - then - From.Checked_Error - ("system origins can only be distribution-specific"); - end if; - - -- Get an array of TOML values that will each point to a distribution - -- specific array of candidate packages: - - declare - use type TOML.TOML_Value; - Distro_Origins : constant Distros.TOML_Array := - Distros.Load_Cases - (TOML_Adapters.From - (Case_From.Get (Case_From.Keys (1)), - From.Message ("case"))); - begin - for Distro in Distro_Origins'Range loop - if Distro_Origins (Distro) /= TOML.No_TOML_Value then - - if Distro_Origins (Distro).Kind not in TOML.TOML_Array then - From.Checked_Error - ("case(distribution): " - & "array of candidate packages expected, but got: " - & Distro_Origins (Distro).Kind'Img); - end if; - - Result.Origin.Distro_Candidates (Distro) := - TOML_Adapters.To_Vector (Distro_Origins (Distro)); - end if; - end loop; - - return Result; - end; - end From_Case; + function From_Array (Values : TOML.TOML_Value) return Package_Vector + is (Packages => TOML_Adapters.To_Vector (Values)); Value : TOML.TOML_Value; begin if not From.Pop (TOML_Keys.Origin, Value) then From.Checked_Error ("mandatory origin missing"); - - elsif Value.Kind in TOML.TOML_Table then - -- A table: a case origin. - return From_Case (Value); - elsif Value.Kind in TOML.TOML_Array then -- List of possible packages - return From_Array (Value); + return Conditional_Packages.New_Value (From_Array (Value)); else - From.Checked_Error ("origin: expected array or case table"); + From.Checked_Error ("origin: expected array of candidate packages"); end if; + end From_TOML_Static; + + --------------- + -- From_TOML -- + --------------- + + package Loader is new Conditional_Packages.TOML_Load; + + function From_TOML (From : TOML_Adapters.Key_Queue) return External is + begin + return (Externals.External with + Origin => Loader.Load + (From => + -- We detach the 'origin' entry by itself to avoid the + -- expression parser to complain about too many entries. + From.Descend (Key => TOML_Keys.Origin, + Value => From.Pop (TOML_Keys.Origin), + Context => TOML_Keys.Origin), + Loader => From_TOML_Static'Access, + Resolve => True, + Strict => False)); end From_TOML; ----------- @@ -159,8 +117,17 @@ package body Alire.Externals.From_System is overriding function Image (This : External) return String is - (Utils.Trim (Candidate_Count (This.Origin)'Img) - & " candidate system packages"); + Candidates : Natural := 0; + begin + for Packages of This.Origin.As_List loop + Candidates := Candidates + Natural (Packages.Packages.Length); + end loop; + + return Utils.Trim (Candidates'Image) + & (if Candidates = 1 + then " candidate system package" + else " candidate system packages"); + end Image; ------------ -- Detail -- @@ -171,22 +138,41 @@ package body Alire.Externals.From_System is Distro : Platforms.Distributions) return Utils.String_Vector is - use all type Platforms.Distributions; + Result : Utils.String_Vector; + use Alire.Properties; + use type Platforms.Distributions; begin - if This.Origin.Is_Case then - return Result : Utils.String_Vector do - for I in This.Origin.Distro_Candidates'Range loop - if Distro = I or else Distro = Distro_Unknown then + for Concrete_Distro in Platforms.Known_Distributions loop + + -- We show either the requested Distro only, or all distros, which is + -- signaled by Distro = Unknown. + + if Concrete_Distro = Distro or else Distro = Platforms.Distro_Unknown + then + declare + On_Distro : constant Conditional_Packages.Tree := + This.Origin.Evaluate + (To_Vector + (Properties.Platform.Distributions + .New_Property (Concrete_Distro))); + begin + if not On_Distro.Is_Empty then Result.Append - (Utils.To_Mixed_Case (I'Img) & ": " - & This.Origin.Distro_Candidates (I).Flatten (", ")); + (TOML_Adapters.Adafy (Concrete_Distro'Image) & ": " + & On_Distro.Image_One_Line); end if; - end loop; - end return; - else - return Utils.Empty_Vector.Append - (This.Origin.Common_Candidates.Flatten (", ")); - end if; + end; + end if; + end loop; + Result.Append ("others: unavailable"); + return Result; end Detail; + ----------- + -- Image -- + ----------- + + function Image (This : Package_Vector) return String + is (This.Packages.Flatten (", ")); + end Alire.Externals.From_System; diff --git a/src/alire/alire-externals-from_system.ads b/src/alire/alire-externals-from_system.ads index d0c55889..273e4e93 100644 --- a/src/alire/alire-externals-from_system.ads +++ b/src/alire/alire-externals-from_system.ads @@ -1,6 +1,11 @@ +private with Alire.Conditional_Trees; +private with Alire.Interfaces; private with Alire.Platforms; +private with Alire.TOML_Keys; private with Alire.Utils; +private with TOML; + package Alire.Externals.From_System is -- A system-provided package, installed via a platform-specific method such @@ -28,31 +33,36 @@ package Alire.Externals.From_System is private - subtype Package_Vector is Utils.String_Vector; - - type Candidates is array (Platforms.Known_Distributions) of Package_Vector; + -- To reuse the conditional expressions parser we need a bit of boilerplate - type Packages (Is_Case : Boolean := False) is record - case Is_Case is - when False => - Common_Candidates : Package_Vector; - when True => - Distro_Candidates : Candidates; - end case; + type Package_Vector is + new Interfaces.Classificable + and Interfaces.Tomifiable + and Interfaces.Yamlable with record + Packages : Utils.String_Vector; end record; - function Candidate_Count (This : Packages) return Natural; + overriding + function Key (This : Package_Vector) return String + is (TOML_Keys.Origin); + + overriding + function To_TOML (This : Package_Vector) return TOML.TOML_Value + is (raise Unimplemented); -- Not needed + + overriding + function To_YAML (This : Package_Vector) return String + is (raise Unimplemented); -- Not needed + + function Image (This : Package_Vector) return String; + + package Conditional_Packages is new Conditional_Trees (Package_Vector, + Image); + + type Candidates is array (Platforms.Known_Distributions) of Package_Vector; type External is new Externals.External with record - Origin : Packages; + Origin : Conditional_Packages.Tree; end record; - function System_Candidates (This : External; - Distro : Platforms.Known_Distributions) - return Package_Vector - is - (if This.Origin.Is_Case - then This.Origin.Distro_Candidates (Distro) - else This.Origin.Common_Candidates); - end Alire.Externals.From_System; diff --git a/src/alire/alire-externals.adb b/src/alire/alire-externals.adb index bc518a33..6ea3746d 100644 --- a/src/alire/alire-externals.adb +++ b/src/alire/alire-externals.adb @@ -23,7 +23,9 @@ package body Alire.Externals is -- From_TOML -- --------------- - function From_TOML (From : TOML_Adapters.Key_Queue) return External'Class is + function From_TOML (From : TOML_Adapters.Key_Queue; + Strict : Boolean) + return External'Class is --------------- -- From_TOML -- @@ -76,7 +78,8 @@ package body Alire.Externals is -- Load common external fields TOML_Load.Load_Crate_Section - (Section => Crates.External_Private_Section, + (Strict => Strict, + Section => Crates.External_Private_Section, From => From, Props => Ext.Properties, Deps => Deps, diff --git a/src/alire/alire-externals.ads b/src/alire/alire-externals.ads index eadc0b40..66db2d61 100644 --- a/src/alire/alire-externals.ads +++ b/src/alire/alire-externals.ads @@ -58,7 +58,9 @@ package Alire.Externals is -- These kinds are used during TOML loading, and exposed in the spec for -- documentation purposes only. - function From_TOML (From : TOML_Adapters.Key_Queue) return External'Class; + function From_TOML (From : TOML_Adapters.Key_Queue; + Strict : Boolean) + return External'Class; function On_Platform (This : External'Class; Env : Properties.Vector) return External'Class; @@ -68,7 +70,7 @@ private type External is abstract tagged record Properties : Conditional.Properties; - Available : Conditional.Availability := Conditional.Available_Default; + Available : Conditional.Availability; end record; end Alire.Externals; diff --git a/src/alire/alire-features-index.adb b/src/alire/alire-features-index.adb index e9a8ba7b..28a45772 100644 --- a/src/alire/alire-features-index.adb +++ b/src/alire/alire-features-index.adb @@ -187,8 +187,9 @@ package body Alire.Features.Index is -- Setup_And_Load -- -------------------- - procedure Setup_And_Load (From : Absolute_Path; - Force : Boolean := False) + procedure Setup_And_Load (From : Absolute_Path; + Strict : Boolean; + Force : Boolean := False) is Result : Outcome; Indexes : Features.Index.Index_On_Disk_Set; @@ -221,7 +222,8 @@ package body Alire.Features.Index is declare Outcome : constant Alire.Outcome := Features.Index.Load_All - (From => Alire.Config.Edit.Indexes_Directory); + (From => Alire.Config.Edit.Indexes_Directory, + Strict => Strict); begin if not Outcome.Success then Raise_Checked_Error (Message (Outcome)); @@ -313,7 +315,7 @@ package body Alire.Features.Index is -- Load_All -- -------------- - function Load_All (From : Absolute_Path) return Outcome + function Load_All (From : Absolute_Path; Strict : Boolean) return Outcome is Result : Outcome; Indexes : constant Index_On_Disk_Set := Find_All (From, Result); @@ -324,7 +326,7 @@ package body Alire.Features.Index is for Index of Indexes loop declare - Result : constant Outcome := Index.Load; + Result : constant Outcome := Index.Load (Strict); begin if not Result.Success then return Result; diff --git a/src/alire/alire-features-index.ads b/src/alire/alire-features-index.ads index 792f869b..a03bfbb3 100644 --- a/src/alire/alire-features-index.ads +++ b/src/alire/alire-features-index.ads @@ -28,13 +28,14 @@ package Alire.Features.Index is -- instead of proceeding with default behaviors, such as getting the -- community index. - procedure Setup_And_Load (From : Absolute_Path; - Force : Boolean := False); + procedure Setup_And_Load (From : Absolute_Path; + Strict : Boolean; + Force : Boolean := False); -- If there are no crates loaded, load from all configured indexes at the -- configured location. If Force, load even if some crates are already -- loaded. If no index is configured, set up the default community index. - function Load_All (From : Absolute_Path) return Outcome; + function Load_All (From : Absolute_Path; Strict : Boolean) return Outcome; -- Load all indexes available at the given location function Update_All (Under : Absolute_Path) return Outcome; diff --git a/src/alire/alire-index_on_disk.adb b/src/alire/alire-index_on_disk.adb index f8def774..8956f23b 100644 --- a/src/alire/alire-index_on_disk.adb +++ b/src/alire/alire-index_on_disk.adb @@ -103,12 +103,13 @@ package body Alire.Index_On_Disk is -- Load -- ---------- - function Load (This : Index'Class) return Outcome + function Load (This : Index'Class; Strict : Boolean) return Outcome is begin return Result : Outcome := Outcome_Success do TOML_Index.Load (Index => This, + Strict => Strict, Result => Result); end return; exception diff --git a/src/alire/alire-index_on_disk.ads b/src/alire/alire-index_on_disk.ads index 0391b851..12e9a8fc 100644 --- a/src/alire/alire-index_on_disk.ads +++ b/src/alire/alire-index_on_disk.ads @@ -67,7 +67,7 @@ package Alire.Index_On_Disk is function Delete (This : Index'Class) return Outcome; -- Remove index from current configuration and delete its folder - function Load (This : Index'Class) return Outcome; + function Load (This : Index'Class; Strict : Boolean) return Outcome; -- Loads the actual index contents into the in-memory index function Update (This : Index) return Outcome is abstract; diff --git a/src/alire/alire-manifest.adb b/src/alire/alire-manifest.adb index 4744ea33..3bca84ef 100644 --- a/src/alire/alire-manifest.adb +++ b/src/alire/alire-manifest.adb @@ -64,7 +64,9 @@ package body Alire.Manifest is function Is_Valid (Name : Any_Path; Source : Sources) return Boolean is begin -- Check we are able to load the manifest file - if Releases.From_Manifest (Name, Source).Version_Image /= "" then + if Releases.From_Manifest + (Name, Source, Strict => False).Version_Image /= "" + then Trace.Debug ("Checked valid manifest at " & Name); return True; else diff --git a/src/alire/alire-platforms.ads b/src/alire/alire-platforms.ads index f14af406..be26e599 100644 --- a/src/alire/alire-platforms.ads +++ b/src/alire/alire-platforms.ads @@ -7,7 +7,7 @@ package Alire.Platforms with Preelaborate is Windows, OS_Unknown); subtype Known_Operating_Systems is - Operating_Systems range Linux .. Windows; + Operating_Systems range Linux .. Windows; type Targets is (Native, Unknown_Cross_Target); diff --git a/src/alire/alire-properties-from_toml.adb b/src/alire/alire-properties-from_toml.adb index 8e6296df..d84d704f 100644 --- a/src/alire/alire-properties-from_toml.adb +++ b/src/alire/alire-properties-from_toml.adb @@ -1,6 +1,5 @@ with AAA.Enum_Tools; -with Alire.TOML_Expressions.Cases; with Alire.Utils; package body Alire.Properties.From_TOML is @@ -11,11 +10,10 @@ package body Alire.Properties.From_TOML is function Loader (From : TOML_Adapters.Key_Queue; Loaders : Loader_Array; - Section : Crates.Sections) + Section : Crates.Sections; + Strict : Boolean) return Conditional.Properties is - use type Conditional.Properties; - use type Conditional.Property_Loader; begin return Props : Conditional.Properties do loop @@ -32,14 +30,14 @@ package body Alire.Properties.From_TOML is end if; -- Extract property name from string - Trace.Debug ("Loading property key = " & Key); + Process_Property : -- Single-pass loop to emulate Continue loop if Is_Valid (Ada_Key) then Prop := Property_Keys'Value (TOML_Adapters.Adafy (Key)); -- Check that the property is expected in this section. - if Loaders (Prop) = null then + if Loaders (Prop) in null then From.Recoverable_Error ("property '" & Key & "' must not appear in section " @@ -47,25 +45,18 @@ package body Alire.Properties.From_TOML is exit Process_Property; end if; - -- Divert to the expr resolver if prop can be dynamic: - if Loaders_During_Case (Prop) /= null then - Props := Props and - TOML_Expressions.Cases.Load_Property - (Key => Key, - From => From.Descend (Val, "property"), - Loader => Loaders_During_Case (Prop)); - else - -- Ensure no dynamic expression in the incoming values - if TOML_Expressions.Contains_Expression (Val) then - From.Checked_Error - ("property '" & Key - & "' must not contain dynamic expressions"); - end if; + -- Load property once we know its exact name, allowing + -- expressions were appropriate. - -- Actually load the property: - Props := Props and - Loaders (Prop) (From.Descend (Key, Val, Key)); - end if; + Props.Append + (Prop_Loader.Load + (From => From.Descend + (Key => Key, + Value => Val, + Context => Key), + Loader => Loaders (Prop), + Resolve => Is_Dynamic (Prop), + Strict => Strict)); else From.Recoverable_Error ("invalid property: " & Key); diff --git a/src/alire/alire-properties-from_toml.ads b/src/alire/alire-properties-from_toml.ads index 71ac9f0e..73ab3919 100644 --- a/src/alire/alire-properties-from_toml.ads +++ b/src/alire/alire-properties-from_toml.ads @@ -1,4 +1,5 @@ with Alire.Conditional; +with Alire.Conditional_Trees.TOML_Load; with Alire.Crates; with Alire.Properties.Actions; with Alire.Properties.Configurations; @@ -11,7 +12,9 @@ with Alire.TOML_Adapters; package Alire.Properties.From_TOML is - subtype Property_Loader is Conditional.Property_Loader; + package Prop_Loader is new Conditional.For_Properties.TOML_Load; + + subtype Property_Loader is Prop_Loader.Static_Loader; type Property_Keys is (Actions, Authors, @@ -129,48 +132,56 @@ package Alire.Properties.From_TOML is -- The following array determines which properties accept dynamic -- expressions, per index semantics. All other properties must be static. - Loaders_During_Case : constant array (Property_Keys) of Property_Loader - := (Actions => Properties.Actions.From_TOML'Access, - Configuration => - Properties.Configurations.Config_Entry_From_TOML'Access, - Environment => Properties.Environment.From_TOML'Access, - Executables => Labeled.From_TOML_Executable_Cases'Access, - GPR_Set_Externals => Scenarios.From_TOML_Cases'Access, - Hint => Labeled.From_TOML_Hint_Cases'Access, - Project_Files => Labeled.From_TOML_Project_File_Cases'Access, - others => null); + Is_Dynamic : constant array (Property_Keys) of Boolean + := (Actions | + Configuration | + Environment | + Executables | + GPR_Set_Externals | + Hint | + Project_Files => True, + others => False); function Loader (From : TOML_Adapters.Key_Queue; Loaders : Loader_Array; - Section : Crates.Sections) + Section : Crates.Sections; + Strict : Boolean) return Conditional.Properties; -- Takes a table of mixed properties and dispatches to each concrete - -- property loader. Takes into account dynamic properties. + -- property loader. Takes into account dynamic properties. Indirectly + -- called from Alire.TOML_Load to load each individual property, with + -- the appropriate static loaders for the section. -- Following functions are wrappers on Loader that conform to the signature - -- expected by the dynamic expression loaders. + -- expected by the dynamic expression loader. Merely used to associate the + -- appropriate section to the Loader. use all type Crates.Sections; - function External_Private_Loader (From : TOML_Adapters.Key_Queue) + function External_Private_Loader (From : TOML_Adapters.Key_Queue; + Strict : Boolean) return Conditional.Properties is - (Loader (From, External_Private_Loaders, External_Private_Section)); + (Loader + (From, External_Private_Loaders, External_Private_Section, Strict)); - function External_Shared_Loader (From : TOML_Adapters.Key_Queue) + function External_Shared_Loader (From : TOML_Adapters.Key_Queue; + Strict : Boolean) return Conditional.Properties is - (Loader (From, External_Shared_Loaders, External_Shared_Section)); + (Loader (From, External_Shared_Loaders, External_Shared_Section, Strict)); - function Index_Release_Loader (From : TOML_Adapters.Key_Queue) + function Index_Release_Loader (From : TOML_Adapters.Key_Queue; + Strict : Boolean) return Conditional.Properties is - (Loader (From, Release_Loaders, Index_Release)); + (Loader (From, Release_Loaders, Index_Release, Strict)); - function Local_Release_Loader (From : TOML_Adapters.Key_Queue) + function Local_Release_Loader (From : TOML_Adapters.Key_Queue; + Strict : Boolean) return Conditional.Properties is - (Loader (From, Release_Loaders, Local_Release)); + (Loader (From, Release_Loaders, Local_Release, Strict)); Section_Loaders : constant array (Crates.Sections) of access - function (From : TOML_Adapters.Key_Queue) + function (From : TOML_Adapters.Key_Queue; Strict : Boolean) return Conditional.Properties := (External_Private_Section => External_Private_Loader'Access, External_Shared_Section => External_Shared_Loader'Access, diff --git a/src/alire/alire-properties-labeled.adb b/src/alire/alire-properties-labeled.adb index 10b84751..bf132cba 100644 --- a/src/alire/alire-properties-labeled.adb +++ b/src/alire/alire-properties-labeled.adb @@ -95,55 +95,6 @@ package body Alire.Properties.Labeled is From.Checked_Error ("Cannot read valid property from " & Key); end From_TOML; - ------------------------ - -- Loader_During_Case -- - ------------------------ - - generic - Key : String; - function Loader_During_Case (From : TOML_Adapters.Key_Queue) - return Conditional.Properties; - -- We use this wrapper to ensure that the labels and values match after - -- traversing a dynamic case expression. - - function Loader_During_Case (From : TOML_Adapters.Key_Queue) - return Conditional.Properties - is - -- In the case of labeled properties, the key will be the case entry, - -- that we don't need. - Key_Got : constant String := +From.Unwrap.Keys (1); - begin - if Key = Key_Got then - return From_TOML (From); - else - From.Checked_Error ("expected " & Key & " but got " & Key_Got); - end if; - end Loader_During_Case; - - function From_TOML_Hint_Cases_Internal is - new Loader_During_Case (TOML_Keys.Hint); - - function From_TOML_Hint_Cases - (From : TOML_Adapters.Key_Queue) - return Conditional.Properties - renames From_TOML_Hint_Cases_Internal; - - function From_TOML_Executable_Cases_Internal is - new Loader_During_Case (TOML_Keys.Executable); - - function From_TOML_Executable_Cases - (From : TOML_Adapters.Key_Queue) - return Conditional.Properties - renames From_TOML_Executable_Cases_Internal; - - function From_TOML_Project_File_Cases_Internal is - new Loader_During_Case (TOML_Keys.Project_File); - - function From_TOML_Project_File_Cases - (From : TOML_Adapters.Key_Queue) - return Conditional.Properties - renames From_TOML_Project_File_Cases_Internal; - -------------- -- Validate -- -------------- diff --git a/src/alire/alire-properties-labeled.ads b/src/alire/alire-properties-labeled.ads index 709a8ebc..02dc0bf0 100644 --- a/src/alire/alire-properties-labeled.ads +++ b/src/alire/alire-properties-labeled.ads @@ -110,18 +110,6 @@ package Alire.Properties.Labeled with Preelaborate is return Conditional.Properties; -- Loads any labeled property. May raise Checked_Error. - function From_TOML_Hint_Cases (From : TOML_Adapters.Key_Queue) - return Conditional.Properties; - -- Loads a hint property; used during resolution of cases. - - function From_TOML_Executable_Cases (From : TOML_Adapters.Key_Queue) - return Conditional.Properties; - -- Loads only executable properties; used during resolution of cases. - - function From_TOML_Project_File_Cases (From : TOML_Adapters.Key_Queue) - return Conditional.Properties; - -- Loads only project-file properties; used during resolution of cases. - generic Name : Labels; function Cond_New_Label (Value : String) return Conditional.Properties; diff --git a/src/alire/alire-publish.adb b/src/alire/alire-publish.adb index 95386cf2..8953c353 100644 --- a/src/alire/alire-publish.adb +++ b/src/alire/alire-publish.adb @@ -160,7 +160,8 @@ package body Alire.Publish is -- Check not duplicated - Features.Index.Setup_And_Load (From => Config.Edit.Indexes_Directory); + Features.Index.Setup_And_Load (From => Config.Edit.Indexes_Directory, + Strict => True); if Index.Exists (Release.Name, Release.Version) then Raise_Checked_Error ("Target release " & Release.Milestone.TTY_Image @@ -287,7 +288,8 @@ package body Alire.Publish is if Context.Options.Nonstandard_Manifest then Check_Release (Releases.From_Manifest (Starting_Manifest (Context), - Alire.Manifest.Local)); + Alire.Manifest.Local, + Strict => True)); -- Will have raised if the release is not loadable or incomplete else declare @@ -487,7 +489,8 @@ package body Alire.Publish is Paths.Working_Folder_Inside_Root / "archives"; Release : constant Releases.Release := Releases.From_Manifest (Context.Options.Manifest, - Alire.Manifest.Local); + Alire.Manifest.Local, + Strict => True); Milestone : constant String := TOML_Index.Manifest_File (Release.Name, Release.Version, @@ -652,7 +655,8 @@ package body Alire.Publish is Releases .From_Manifest (Packaged_Manifest (Context), - Alire.Manifest.Local) + Alire.Manifest.Local, + Strict => True) .Replacing (Origin => Context.Origin); begin Check_Release (Release); diff --git a/src/alire/alire-releases.adb b/src/alire/alire-releases.adb index 7b38f893..ca9cf654 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.TOML_Expressions; with Alire.TOML_Load; with Alire.Utils.YAML; with Alire.Warnings; @@ -585,7 +584,9 @@ package body Alire.Releases is -- PROPERTIES if not R.Properties.Is_Empty then Put_Line ("Properties:"); - R.Properties.Print (" ", False); + R.Properties.Print (" ", + And_Or => False, + Verbose => Alire.Log_Level >= Detail); end if; -- DEPENDENCIES @@ -648,7 +649,8 @@ package body Alire.Releases is ------------------- function From_Manifest (File_Name : Any_Path; - Source : Manifest.Sources) + Source : Manifest.Sources; + Strict : Boolean) return Release is begin @@ -657,6 +659,7 @@ package body Alire.Releases is (TOML_Load.Load_File (File_Name), "Loading release from manifest: " & File_Name), Source, + Strict, File_Name); exception when E : others => @@ -672,6 +675,7 @@ package body Alire.Releases is function From_TOML (From : TOML_Adapters.Key_Queue; Source : Manifest.Sources; + Strict : Boolean; File : Any_Path := "") return Release is begin @@ -680,7 +684,7 @@ package body Alire.Releases is return This : Release := New_Empty_Release (Name => +From.Unwrap.Get (TOML_Keys.Name).As_String) do - Assert (This.From_TOML (From, Source, File)); + Assert (This.From_TOML (From, Source, Strict, File)); end return; end From_TOML; @@ -691,25 +695,15 @@ package body Alire.Releases is function From_TOML (This : in out Release; From : TOML_Adapters.Key_Queue; Source : Manifest.Sources; + Strict : Boolean; File : Any_Path := "") return Outcome is package Dirs renames Ada.Directories; package Labeled renames Alire.Properties.Labeled; - - Strict_Before : constant Boolean := TOML_Expressions.Strict_Enums; - -- Initial value of TOML_Expressions.Strict_Enums, to restore it after - -- loading this particular release. begin Trace.Debug ("Loading release " & This.Milestone.Image); - -- For local manifests we don't allow unknown enum values. For indexes - -- we do not complain, as that allows backward compatibility for new - -- configurations found in the index but unknown to this Alire. This way - -- local errors by the user are caught on the spot. - TOML_Expressions.Strict_Enums := - TOML_Expressions.Strict_Enums or else Source in Manifest.Local; - -- Origin case Source is @@ -727,13 +721,14 @@ package body Alire.Releases is -- Properties TOML_Load.Load_Crate_Section - ((case Source is - when Manifest.Index => Crates.Index_Release, - when Manifest.Local => Crates.Local_Release), - From, - This.Properties, - This.Dependencies, - This.Available); + (Strict => Strict or else Source in Manifest.Local, + Section => (case Source is + when Manifest.Index => Crates.Index_Release, + when Manifest.Local => Crates.Local_Release), + From => From, + Props => This.Properties, + Deps => This.Dependencies, + Avail => This.Available); -- Consolidate/validate some properties as fields: @@ -742,30 +737,8 @@ package body Alire.Releases is This.Version := Semver.New_Version (This.Property (Labeled.Version)); - -- Restore Strict-ness - - TOML_Expressions.Strict_Enums := Strict_Before; - -- Check for remaining keys, which must be erroneous: return From.Report_Extra_Keys; - exception - when E : others => - Log_Exception (E); - - TOML_Expressions.Strict_Enums := Strict_Before; - - case Source is - when Manifest.Index => - raise Program_Error with - Errors.Set - ("Cannot load manifest " & This.Name_Str & - " from index with proper version: ", E); - when Manifest.Local => - raise Checked_Error with - Errors.Set - ("Cannot load manifest " & This.Name_Str & - ", please review contents: ", E); - end case; end From_TOML; ------------------- diff --git a/src/alire/alire-releases.ads b/src/alire/alire-releases.ads index 7f1fa5fb..5ce47359 100644 --- a/src/alire/alire-releases.ads +++ b/src/alire/alire-releases.ads @@ -269,11 +269,13 @@ package Alire.Releases is -- wrapped as a dependency tree with a single value. function From_Manifest (File_Name : Any_Path; - Source : Manifest.Sources) + Source : Manifest.Sources; + Strict : Boolean) return Release; function From_TOML (From : TOML_Adapters.Key_Queue; Source : Manifest.Sources; + Strict : Boolean; File : Any_Path := "") return Release with Pre => Source not in Manifest.Local or else File /= ""; @@ -342,6 +344,7 @@ private function From_TOML (This : in out Release; From : TOML_Adapters.Key_Queue; Source : Manifest.Sources; + Strict : Boolean; File : Any_Path := "") return Outcome with Pre => Source not in Manifest.Local or else File /= ""; diff --git a/src/alire/alire-roots-optional.adb b/src/alire/alire-roots-optional.adb index 6264d220..96c790f3 100644 --- a/src/alire/alire-roots-optional.adb +++ b/src/alire/alire-roots-optional.adb @@ -38,7 +38,8 @@ package body Alire.Roots.Optional is Outcome_Success (Roots.New_Root (R => Releases.From_Manifest (Crate_File, - Manifest.Local), + Manifest.Local, + Strict => True), Path => Ada.Directories.Full_Name (Path), Env => Alire.Root.Platform_Properties)) do diff --git a/src/alire/alire-toml_adapters.adb b/src/alire/alire-toml_adapters.adb index 3a0b75e7..e111c835 100644 --- a/src/alire/alire-toml_adapters.adb +++ b/src/alire/alire-toml_adapters.adb @@ -168,6 +168,19 @@ package body Alire.TOML_Adapters is end if; end Pop; + --------- + -- Pop -- + --------- + + function Pop (Queue : Key_Queue; Key : String) return TOML.TOML_Value is + Val : TOML.TOML_Value; + begin + if not Queue.Pop (Key, Val) then + Raise_Checked_Error ("Requested key not found: " & Key); + end if; + return Val; + end Pop; + -------------- -- Pop_Expr -- -------------- diff --git a/src/alire/alire-toml_adapters.ads b/src/alire/alire-toml_adapters.ads index 821f1117..bb79270f 100644 --- a/src/alire/alire-toml_adapters.ads +++ b/src/alire/alire-toml_adapters.ads @@ -86,10 +86,13 @@ package Alire.TOML_Adapters with Preelaborate is -- Remove Key from the given set of keys and set Value to the -- corresponding value in Queue. Return whether Key was present. + function Pop (Queue : Key_Queue; Key : String) return TOML.TOML_Value; + -- Pop a key, that must exist, without checking its type (see Checked_Pop); + function Pop_Expr (Queue : Key_Queue; Prefix : String; Value : out TOML.TOML_Value) return String; - -- Return a entry in the underlying table which key starts with Prefix, + -- Return a entry in the underlying table whose key starts with Prefix, -- or No_TOML_Value if not a table or does not contain such a key. The -- intended use is to process keys beginning with "case(" in the table. @@ -140,7 +143,8 @@ package Alire.TOML_Adapters with Preelaborate is -- Create a table with a single key=val entry function Adafy (Key : String) return String; - -- Take a toml key and replace every '-' and '.' with a '_'; + -- Take a toml key and replace every '-' and '.' with a '_'; Use Title_Case + -- unless key = "others". function Tomify (Image : String) return String; -- Take some enumeration image and turn it into a TOML-style key, replacing @@ -208,12 +212,16 @@ private ----------- function Adafy (Key : String) return String is - (Utils.Replace + (if Utils.To_Lower_Case (Key) = "others" + then Utils.To_Lower_Case (Key) + else + Utils.To_Mixed_Case (Utils.Replace - (Key, - Match => "-", - Subst => "_"), - Match => ".", Subst => "_")); + (Utils.Replace + (Key, + Match => "-", + Subst => "_"), + Match => ".", Subst => "_"))); ---------------------- -- Tomify_As_String -- diff --git a/src/alire/alire-toml_expressions-cases.adb b/src/alire/alire-toml_expressions-cases.adb deleted file mode 100644 index 7c781d4e..00000000 --- a/src/alire/alire-toml_expressions-cases.adb +++ /dev/null @@ -1,216 +0,0 @@ -with Alire.Conditional_Trees.Cases; -with Alire.Platforms; -with Alire.Properties.Platform; -with Alire.TOML_Keys; - -package body Alire.TOML_Expressions.Cases is - - procedure Set_Up_Loaders; - -- MUST be called before attempting to load anything. - -- Needed to keep the package in Preelaborable. - - package Distributions is new Enum_Cases (Platforms.Distributions); - package Operating_Systems is new Enum_Cases (Platforms.Operating_Systems); - package Toolchains is new Enum_Cases (Platforms.Toolchains); - package Word_Sizes is new Enum_Cases (Platforms.Word_Sizes); - - -------------------------- - -- COMMON SCAFFOLDING -- - -------------------------- - - generic - with package Condtrees is new Conditional_Trees (<>); - package Common_Cases is - - package Distributions is - new Condtrees.Cases (Properties.Platform.Distro_Cases); - - package Operating_Systems is - new Condtrees.Cases (Properties.Platform.OS_Cases); - - package Toolchains is - new Condtrees.Cases (Properties.Platform.Toolchain_Cases); - - package Word_Sizes is - 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. 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); - package Cases_Avail is new Common_Cases (Conditional.For_Available); - - ------------------------------------------- - -- CASE CONDITIONAL COMMON SCAFFOLDING -- - ------------------------------------------- - - -- 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 - -- some structure here. - - package Trees is new Enum_Trees (Tree => Condtrees.Tree, - "and" => Condtrees."and", - Default => Default); - -- I.e., Conditional.Dependencies & Conditional.Properties - - 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 => Condcases.Distributions.Cases_Array, - New_Leaf => Condcases.Distributions.New_Case, - Load => Load_Instance); - package OS_Loader is new Tree_Builders - (Trees => Trees, - Cases => Operating_Systems, - Enum_Array => Condcases.Operating_Systems.Cases_Array, - New_Leaf => Condcases.Operating_Systems.New_Case, - Load => Load_Instance); - package Toolchain_Loader is new Tree_Builders - (Trees => Trees, - Cases => Toolchains, - Enum_Array => Condcases.Toolchains.Cases_Array, - New_Leaf => Condcases.Toolchains.New_Case, - Load => Load_Instance); - package WS_Loader is new Tree_Builders - (Trees => Trees, - Cases => Word_Sizes, - Enum_Array => Condcases.Word_Sizes.Cases_Array, - New_Leaf => Condcases.Word_Sizes.New_Case, - Load => Load_Instance); - - procedure Set_Up_Loaders; - - end Conditional_Instances; - - package body Conditional_Instances is - - procedure Set_Up_Loaders is - begin - Loaders := (Distribution => Distro_Loader.Load_Cases'Access, - OS => OS_Loader.Load_Cases'Access, - Toolchain => Toolchain_Loader.Load_Cases'Access, - Word_Size => WS_Loader.Load_Cases'Access); - end Set_Up_Loaders; - - end Conditional_Instances; - - ------------------------------------- - -- CASE DEPENDENCIES SCAFFOLDING -- - ------------------------------------- - - package Deps is new Conditional_Instances - (Conditional.For_Dependencies, - Cases_Deps, - Conditional.For_Dependencies.Empty); - - ----------------------- - -- Load_Dependencies -- - ----------------------- - - function Load_Dependencies (From : TOML_Adapters.Key_Queue) - return Conditional.Dependencies - is - begin - Set_Up_Loaders; - return Deps.Load_Instance (TOML_Keys.Depends_On, - From, - 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, - Conditional.For_Properties.Empty); - - ------------------- - -- Load_Property -- - ------------------- - - function Load_Property (Key : String; - From : TOML_Adapters.Key_Queue; - Loader : Static_Loader) - return Conditional.Properties - is - use all type TOML.Any_Value_Kind; - begin - Set_Up_Loaders; - return Prop : constant Conditional.Properties := - Props.Load_Instance (Key, From, Loader.all'Access) - -- The Loader type is structurally equivalent, so we can circumvent - -- the type check without consequences. This is merely for clarity. - do - if From.Unwrap.Kind = TOML.TOML_Table then - From.Report_Extra_Keys; - end if; - end return; - end Load_Property; - - -------------------- - -- Set_Up_Loaders -- - -------------------- - - procedure Set_Up_Loaders is - begin - Deps.Set_Up_Loaders; - Props.Set_Up_Loaders; - 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 deleted file mode 100644 index 35968524..00000000 --- a/src/alire/alire-toml_expressions-cases.ads +++ /dev/null @@ -1,27 +0,0 @@ -with Alire.Conditional; -with Alire.TOML_Adapters; - -package Alire.TOML_Expressions.Cases with Preelaborate is - - function Load_Dependencies (From : TOML_Adapters.Key_Queue) - return Conditional.Dependencies; - -- From is the RHS of a "depends-on = { ... }" table. - - subtype Static_Loader is Conditional.Property_Loader; - - function Load_Property (Key : String; - From : TOML_Adapters.Key_Queue; - Loader : Static_Loader) - return Conditional.Properties; - -- Expects a "key = from" table. - -- To be used during resolution of a dynamic property expression. Only a - -- particular property static value is accepted when in an expr - -- (because the syntax is key.expr.values, and not expr.key.values, so - -- key and values must agree). We explicitly pass a Loader for the property - -- that is being resolved. - - 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.adb b/src/alire/alire-toml_expressions.adb deleted file mode 100644 index 07f3390c..00000000 --- a/src/alire/alire-toml_expressions.adb +++ /dev/null @@ -1,256 +0,0 @@ -with Alire.Errors; -with Alire.Utils; - -package body Alire.TOML_Expressions is - - use all type TOML.Any_Value_Kind; - - ------------------------- - -- Contains_Expression -- - ------------------------- - - function Contains_Expression (Value : TOML.TOML_Value) return Boolean is - (Value.Kind = TOML_Table and then - (for some Key of Value.Keys => - Utils.Starts_With (+Key, Case_Prefix))); - - --------------- - -- Enum_Tree -- - --------------- - - package body Enum_Trees is - - generic - type Case_Keys is (<>); - with function Loaders (Key : Case_Keys) return Recursive_Case_Loader; - function Get_Case (Selector : String; - Context : String) return Recursive_Case_Loader; - -- Identifies which loader corresponds to a case(xx) Selector. - -- May raise Checked_Error. - - -------------- - -- Get_Case -- - -------------- - - function Get_Case (Selector : String; - Context : String) return Recursive_Case_Loader - is - use Utils; - Case_Var : constant String := Tail (Head (Selector, ')'), '('); - Case_Key : Case_Keys; - begin - if Utils.Starts_With (Selector, Case_Prefix) and then - Selector (Selector'Last) = ')' - then - Case_Key := Case_Keys'Value (TOML_Adapters.Adafy (Case_Var)); - -- Converts a variable to the Case_Keys enumeration, hence it may - -- fail (see exception handler below). - - return Loader : constant Recursive_Case_Loader := - Loaders (Case_Key) - do - if Loader = null then - raise Checked_Error with - Context & ": null loader for case argument: " & Case_Var; - end if; - end return; - else - raise Checked_Error with - Errors.Set (Context & "'case(..)' expected; got: " & Selector); - end if; - exception - when Constraint_Error => - raise Checked_Error with - Errors.Set ("invalid case variable: " & Case_Var); - end Get_Case; - - ---------- - -- Load -- - ---------- - - function Load (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Static_Tree_Loader) return Tree is - use TOML; - function Find_Case is new Get_Case (Case_Keys, Loaders); - Val : constant TOML.TOML_Value := From.Unwrap; - begin - return T : Tree do - -- Identify and process case expressions in the table: - loop - declare - Case_Tab : TOML.TOML_Value; - Case_Key : constant String := - From.Pop_Expr (Case_Prefix, Case_Tab); - begin - exit when Case_Key = ""; - Trace.Debug ("Master load (case): " & Case_Key); - - -- A case table: - T := T and Find_Case (Case_Key, From.Message ("case")) - (Parent, - From.Descend (Case_Tab, Case_Key), - Static_Loader); - end; - end loop; - - -- Process remainder keys as static values: - if Val.Kind /= TOML_Table or else Val.Keys'Length > 0 then - Trace.Debug ("Master load (static)"); - T := T and Static_Loader - (From.Descend (Parent, From.Unwrap, "static")); - end if; - end return; - end Load; - - end Enum_Trees; - - ---------------- - -- Enum_Cases -- - ---------------- - - package body Enum_Cases is - - ---------------- - -- Load_Cases -- - ---------------- - - function Load_Cases (From : TOML_Adapters.Key_Queue) return TOML_Array - is - Cases : TOML_Array := (others => TOML.No_TOML_Value); - -- Cases not seen need an empty default. - - Seen : array (Enum) of Boolean := (others => False); - -- Track case entries that have appeared. - -- This is currently used for a debug trace; we might decide that - -- we prefer not having missing cases, like in regular Ada. - - ----------------- - -- Reduce_Seen -- - ----------------- - - -- This recursive function creates a single line saying the case - -- entries missing in the case expression. - function Reduce_Seen (I : Enum := Enum'First; - Comma : Boolean := False) - return String is - ((if not Seen (I) - then (if Comma - then ", " - else "") & TOML_Adapters.Tomify (I'Img) - else "") & - (if I = Enum'Last - then "" - else Reduce_Seen (Enum'Succ (I), Comma or not Seen (I)))); - - use TOML; - - begin - -- Treat the "..." case first - declare - RHS : TOML.TOML_Value; - begin - if From.Pop (Dots, RHS) then - Seen := (others => True); - Cases := (others => RHS); - end if; - end; - - -- Treat explicit cases - loop - declare - RHS : TOML_Value; - LHS : constant String := From.Pop (RHS); - begin - exit when LHS = ""; - -- We have the value, store it in all pertinent keys: - for E_Str of Utils.String_Vector'(Utils.Split (LHS, '|')) - loop - declare - E : Enum; - begin - E := Enum'Value (TOML_Adapters.Adafy (E_Str)); - Seen (E) := True; - Cases (E) := RHS; - exception - when others => - if Strict_Enums then - From.Recoverable_Error - ("invalid enumeration value: " & E_Str); - else - Trace.Debug - (From.Message - ("unknown enumeration value: " & E_Str)); - end if; - end; - end loop; - end; - end loop; - - if (for some E of Seen => E = False) then - Trace.Debug - (From.Message ("missing enumeration cases: " & Reduce_Seen)); - end if; - - return Cases; - end Load_Cases; - - end Enum_Cases; - - ------------------- - -- Tree_Builders -- - ------------------- - - package body Tree_Builders is - - ---------------- - -- Load_Cases -- - ---------------- - - -- This function loads a case expression and then recursively - -- redispatchs to load the TOML value for every case entry. - - function Load_Cases (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Trees.Static_Tree_Loader; - Unused_Marker : Integer := 0) - return Trees.Tree - is - TOML_Cases : constant Cases.TOML_Array := Cases.Load_Cases (From); - Tree_Cases : Enum_Array; - begin - -- TODO: we are reloading all cases here, even when several of them - -- may point to the same TOML value. For that reason (also) we need - -- deep copies below, or otherwise the unsetting of already processed - -- nested tables breaks things. - -- TL;DR: there is an optimization opportunity here to only load - -- actually different TOML values (in which case deep copies wouldn't - -- be necessary any longer). - for I in TOML_Cases'Range loop - declare - Key : constant String := TOML_Adapters.Adafy (I'Img); - Val : constant TOML.TOML_Value := TOML_Cases (I); - begin - if Val.Is_Present then - Trace.Debug ("Loading key: " & Parent - & " in case: " & Key - & " from a: " & Val.Kind'Img); - Tree_Cases (I) := - Load - (Parent, - From.Descend (TOML_Cases (I).Clone, From.Message (Key)), - Static_Loader); - else - Trace.Debug ("Applying default to key: " & Parent - & " for missing case: " & Key); - Tree_Cases (I) := Trees.Default; - end if; - end; - end loop; - - return New_Leaf (Tree_Cases); - end Load_Cases; - - end Tree_Builders; - -end Alire.TOML_Expressions; diff --git a/src/alire/alire-toml_expressions.ads b/src/alire/alire-toml_expressions.ads deleted file mode 100644 index 8a7b8997..00000000 --- a/src/alire/alire-toml_expressions.ads +++ /dev/null @@ -1,162 +0,0 @@ -with Alire.TOML_Adapters; - -with TOML; - -package Alire.TOML_Expressions with Preelaborate is - - -- This package is the core of loading and holding unresolved dynamic case - -- expressions. This is achieved through three generic packages below. - - -- The first one, Enum_Cases, defines a loader for TOML case expressions - -- that only loads one such expression, for a concrete enumeration type. - - -- The second one, Enum_Trees, takes a tree that can hold case expressions - -- and defines a Load function that is able to detect case expressions in - -- the midst of loading a tree. As argument, this function must receive - -- a function that redirects to the loader for a particular case-typed - -- expression. - - -- Finally, Tree_Builders defines a function that can load any case(xx) - -- expression, and that for non-case values (or expressions of a different - -- case type) redirects to the loader in Enum_Trees, which in turn will - -- either load a static value, or redirect to the proper case type loader. - - -- Since there is a circularity here (Enum_Trees requires all case loaders, - -- for all known types, which are provided by Tree_Builders, which in turn - -- cannot be instantiated without first instantiating Tree_Builders), this - -- circularity is broken by Enum_Trees accepting a function that returns - -- the pointers to Tree_Builders.Load_Case instances. This function is - -- defined externally, and relies on information gathered after all - -- instances have been created. - - -- TODO: we can drop the strong-typing for these expressions, which is no - -- longer necessary with the new index since these types are not seen by - -- users of the index or used after a conditional tree is resolved for - -- use with the dependency solver. This will greatly reduce the convoluted - -- generics that we have currently. We can do this transparently at a later - -- time since it only concerns internals. I (álex) also would like to - -- be completely sure that indeed we do not need the strong typing for - -- anything useful. - - Strict_Enums : Boolean := False; - -- This ugly global enormously simplifies the detection of unexpected enum - -- values without huge rippling changes through all the generics. Since - -- these generics are due for a refactoring at some point, this should be - -- acceptable for the time being. TODO: remove this global during the case - -- expressions refactoring. - - Case_Prefix : constant String := "case("; - Dots : constant String := "..."; - - type Case_Loader_Keys is (Distribution, - OS, - Toolchain, - Word_Size); - -- The variables that can be used in index cases. Must match the toml text. - - function Contains_Expression (Value : TOML.TOML_Value) return Boolean; - -- Check if Value contains some case(xx) key. - - generic - type Enum is (<>); - package Enum_Cases is - - -- This package is the simplest one, just loading a single case(xx). - - type TOML_Array is array (Enum) of TOML.TOML_Value; - -- Immediate TOML value for each case. - - function Load_Cases (From : TOML_Adapters.Key_Queue) return TOML_Array; - -- Intermediate loader that does not resolve leaves. - -- May raise Checked_Error if a case entry is missing. - - end Enum_Cases; - - generic - type Tree is private; - with function "and" (L, R : Tree) return Tree; - with function Default return Tree with Warnings => Off; - -- We allow omitting alternatives in cases, even without '...'. This - -- default applies then; which is True for boolean expressions (like - -- in Ada (if Cond then Bool [else True]), and also like when the - -- "available" field is not given. For Props/Deps, it is an empty list. - -- Warnings (Off) applied because it is unreferenced in this package, - -- 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. - - type Static_Tree_Loader is not null access - function (From : TOML_Adapters.Key_Queue) return Tree; - -- Static loaders receive the pair data (key = whatever} that has to be - -- used to build values. For some, key may be redundant, but properties - -- need it to discriminate among them. - - type Recursive_Case_Loader is access - function (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Static_Tree_Loader; - Unused_Marker : Integer := 0) return Tree; - -- The recursive loader prototype matches the Tree_Builders.Load_Cases - -- function, with an extra dummy parameter to avoid confusion with the - -- following Load function. The difference between the following Load - -- and Tree_Builders.Load_Cases is as follows: Load_Cases does the - -- actual loading of a case, recursively invoking Load for the actual - -- case values. Load, in turn dispatches to the proper type Load_Cases - -- when a case is encountered. These functions could both be in - -- this package but the we could not use proper named types for the - -- function prototypes, making everything (even more) confusing. - -- Recursive_Case_Loaders are all known at runtime, and so they can - -- be returned by the following Loaders formal to the Load function. - - generic - type Case_Keys is (<>); - with function Loaders (Key : Case_Keys) return Recursive_Case_Loader; - function Load (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Static_Tree_Loader) return Tree; - -- Entry point into loading expression trees. Identifies case(xx) - -- expressions, which are recursively loaded using the Loaders, or using - -- Static_Loader for final values. Parent is the "key" being loaded. - -- From points to the RHS value or case expr. May raise Checked_Error. - - end Enum_Trees; - - generic - with package Trees is new Enum_Trees (<>); - with package Cases is new Enum_Cases (<>); - -- Instances for the enumeration we are loading. - - type Enum_Array is array (Cases.Enum) of Trees.Tree; - with function New_Leaf (Cases : Enum_Array) return Trees.Tree; - -- Creation of a leaf holding a case expression. - - with function Load (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Trees.Static_Tree_Loader) - return Trees.Tree; - -- The static loader for values of the enumeration type (the one - -- instantiated from the above Enum_Trees instance, that knows how - -- to redispatch in case of a different type case expression. - package Tree_Builders is - - function Load_Cases (Parent : String; - From : TOML_Adapters.Key_Queue; - Static_Loader : Trees.Static_Tree_Loader; - Unused_Marker : Integer := 0) - return Trees.Tree; - -- Parent is the actual key of the expr being loaded ("case(xx)" text). - -- From points to a case(xx) table of alternatives for Enum_Cases. Each - -- case value will be recursively loaded, be it static or an expr, using - -- the Load generic formal. - - end Tree_Builders; - -end Alire.TOML_Expressions; diff --git a/src/alire/alire-toml_index.adb b/src/alire/alire-toml_index.adb index 1d7ed25f..589fb62f 100644 --- a/src/alire/alire-toml_index.adb +++ b/src/alire/alire-toml_index.adb @@ -30,6 +30,10 @@ package body Alire.TOML_Index is package Semver renames Semantic_Versioning; package TTY renames Utils.TTY; + Strict : Boolean := False; + -- Allow or not unknown values in enums. This isn't easily moved to an + -- argument given the current design. + procedure Set_Error (Result : out Load_Result; Filename, Message : String; @@ -44,15 +48,16 @@ package body Alire.TOML_Index is -- Check that Catalog_Dir contains a file called "index.toml" and that it -- describes a supported catalog. - procedure Load_Manifest (Item : Ada.Directories.Directory_Entry_Type; - Stop : in out Boolean); + procedure Load_Manifest (Item : Ada.Directories.Directory_Entry_Type; + Stop : in out Boolean); -- Check if entry is a candidate to manifest file, and in that case load -- its contents. May raise Checked_Error. procedure Load_From_Catalog_Internal (File_Name : Absolute_Path; Name : Crate_Name; - Version : String); + Version : String; + Strict : Boolean); -- Do the actual loading of a file that pass tests based on name/location. -- Name and version have been deduced from the file name and will be used -- for double-checks. @@ -185,6 +190,7 @@ package body Alire.TOML_Index is procedure Load (Index : Index_On_Disk.Index'Class; + Strict : Boolean; Result : out Load_Result) is @@ -226,6 +232,8 @@ package body Alire.TOML_Index is return; end if; + TOML_Index.Strict := Load.Strict; + Trace.Detail ("Loading full catalog from " & Root); Check_Index (Index, Root, Result); @@ -251,8 +259,8 @@ package body Alire.TOML_Index is -- Load_Manifest -- ------------------- - procedure Load_Manifest (Item : Ada.Directories.Directory_Entry_Type; - Stop : in out Boolean) + procedure Load_Manifest (Item : Ada.Directories.Directory_Entry_Type; + Stop : in out Boolean) is pragma Unreferenced (Stop); use Ada.Directories; @@ -322,7 +330,8 @@ package body Alire.TOML_Index is Load_From_Catalog_Internal (File_Name => Path, Name => FS_Name, - Version => FS_Version); + Version => FS_Version, + Strict => Strict); end; end; end Load_Manifest; @@ -334,7 +343,8 @@ package body Alire.TOML_Index is procedure Load_From_Catalog_Internal (File_Name : Absolute_Path; Name : Crate_Name; - Version : String) + Version : String; + Strict : Boolean) is ------------------- @@ -394,14 +404,16 @@ package body Alire.TOML_Index is (TOML_Adapters.From (Value, Context => - "Loading externals from " & File_Name))); + "Loading externals from " & File_Name), + Strict)); else Index_Release (File_Name, Releases.From_TOML (TOML_Adapters.From (Value, Context => "Loading release from " & File_Name), - Manifest.Index)); + Manifest.Index, + Strict)); end if; end Load_From_Catalog_Internal; diff --git a/src/alire/alire-toml_index.ads b/src/alire/alire-toml_index.ads index 34a2b938..6a032b0c 100644 --- a/src/alire/alire-toml_index.ads +++ b/src/alire/alire-toml_index.ads @@ -24,8 +24,10 @@ package Alire.TOML_Index is procedure Load (Index : Index_On_Disk.Index'Class; + Strict : Boolean; Result : out Load_Result); - -- Load the whole TOML catalog for the given index. + -- Load the whole TOML catalog for the given index. If Strict, don't allow + -- unknown enum values. private diff --git a/src/alire/alire-toml_keys.ads b/src/alire/alire-toml_keys.ads index 4dd3d610..21cd4707 100644 --- a/src/alire/alire-toml_keys.ads +++ b/src/alire/alire-toml_keys.ads @@ -9,6 +9,7 @@ package Alire.TOML_Keys with Preelaborate is Author : constant String := "authors"; Auto_GPR_With : constant String := "auto-gpr-with"; Available : constant String := "available"; + Case_Others : constant String := "..."; Compiler : constant String := "compiler"; Configuration : constant String := "configuration"; Config_Vars : constant String := "configuration.variables"; diff --git a/src/alire/alire-toml_load.adb b/src/alire/alire-toml_load.adb index 7456b642..59ffa23c 100644 --- a/src/alire/alire-toml_load.adb +++ b/src/alire/alire-toml_load.adb @@ -1,6 +1,8 @@ +with Alire.Conditional_Trees.TOML_Load; +with Alire.Expressions.Enums; with Alire.Errors; +with Alire.Platforms; with Alire.Properties.From_TOML; -with Alire.TOML_Expressions.Cases; with Alire.TOML_Keys; with Alire.Utils; @@ -8,6 +10,30 @@ with TOML.File_IO; package body Alire.TOML_Load is + -- Instantiate loaders at library level + + package Available_Loader is new Conditional.For_Available.TOML_Load; + package Dependency_Loader is new Conditional.For_Dependencies.TOML_Load; + + -- Register predefined environment variables so they're recognized on load + + package Distro_Expressions is new Expressions.Enums + (Key => TOML_Keys.Distribution, + Ada_Enum => Platforms.Distributions) with Unreferenced; + + package OS_Expressions is new Expressions.Enums + (Key => TOML_Keys.OS, + Name => "OS", + Ada_Enum => Platforms.Operating_Systems) with Unreferenced; + + package Toolchain_Expressions is new Expressions.Enums + (Key => TOML_Keys.Toolchain, + Ada_Enum => Platforms.Toolchains) with Unreferenced; + + package Word_Size_Expressions is new Expressions.Enums + (Key => TOML_Keys.Word_Size, + Ada_Enum => Platforms.Word_Sizes) with Unreferenced; + -- The following are entries in the manifest that are not loaded as -- properties, but stored separately as complex types. @@ -42,7 +68,8 @@ package body Alire.TOML_Load is -- Load_Crate_Section -- ------------------------ - procedure Load_Crate_Section (Section : Crates.Sections; + procedure Load_Crate_Section (Strict : Boolean; + Section : Crates.Sections; From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; @@ -76,16 +103,20 @@ package body Alire.TOML_Load is if Allowed_Tables (Section, Dependencies) then if From.Pop (TOML_Keys.Depends_On, TOML_Deps) then - From.Assert (TOML_Deps.Kind = TOML_Array, - "dependencies must be specified as array of tables"); + From.Assert + (TOML_Deps.Kind = TOML_Array, + "dependencies must be specified as array of tables"); for I in 1 .. TOML_Deps.Length loop Deps := Deps and - TOML_Expressions.Cases.Load_Dependencies - (TOML_Adapters.From - (TOML_Deps.Item (I), - From.Message (TOML_Keys.Depends_On) - & "(group" & I'Img & ")")); + Dependency_Loader.Load + (From => From.Descend + (Key => TOML_Keys.Depends_On, + Value => TOML_Deps.Item (I), + Context => "(group" & I'Img & ")"), + Loader => Conditional.Deps_From_TOML'Access, + Resolve => True, + Strict => Strict); end loop; end if; elsif From.Unwrap.Has (TOML_Keys.Depends_On) then @@ -97,27 +128,28 @@ package body Alire.TOML_Load is -- Process 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); + if Allowed_Tables (Section, Available) then + if From.Pop (TOML_Keys.Available, TOML_Avail) then + Avail.Append + (Conditional.Availability' + (Available_Loader.Load + (From => From.Descend + (Key => TOML_Keys.Available, + Value => TOML_Avail, + Context => TOML_Keys.Available), + Loader => Conditional.Available_From_TOML'Access, + Resolve => True, + Strict => Strict) with null record)); end if; - end; + elsif From.Unwrap.Has (TOML_Keys.Available) then + From.Checked_Error ("found field not allowed in manifest section: " + & TOML_Keys.Available); + end if; -- Process remaining keys, which must be properties Props := Props and - Properties.From_TOML.Section_Loaders (Section) (From); + Properties.From_TOML.Section_Loaders (Section) (From, Strict); end Load_Crate_Section; diff --git a/src/alire/alire-toml_load.ads b/src/alire/alire-toml_load.ads index fb160da4..775580bb 100644 --- a/src/alire/alire-toml_load.ads +++ b/src/alire/alire-toml_load.ads @@ -16,7 +16,8 @@ package Alire.TOML_Load is function Load_File (File_Name : Any_Path) return TOML.TOML_Value; -- Will raise Checked_Error if file contents aren't valid TOML - procedure Load_Crate_Section (Section : Crates.Sections; + procedure Load_Crate_Section (Strict : Boolean; + Section : Crates.Sections; From : TOML_Adapters.Key_Queue; Props : in out Conditional.Properties; Deps : in out Conditional.Dependencies; diff --git a/src/alire/alire-utils.adb b/src/alire/alire-utils.adb index 2dd4e13f..2a242e33 100644 --- a/src/alire/alire-utils.adb +++ b/src/alire/alire-utils.adb @@ -392,17 +392,24 @@ package body Alire.Utils is -- Split -- ----------- - function Split (S : String; Separator : Character) return String_Vector is + function Split (S : String; + Separator : Character; + Trim : Boolean := False) + return String_Vector + is + function Do_Trim (S : String) return String + is (if Trim then Utils.Trim (S) else S); + Prev : Integer := S'First - 1; begin return V : String_Vector do for I in S'Range loop if S (I) = Separator then - V.Append (S (Prev + 1 .. I - 1)); + V.Append (Do_Trim (S (Prev + 1 .. I - 1))); Prev := I; end if; end loop; - V.Append (S (Prev + 1 .. S'Last)); + V.Append (Do_Trim (S (Prev + 1 .. S'Last))); end return; end Split; diff --git a/src/alire/alire-utils.ads b/src/alire/alire-utils.ads index b83e0c22..616db500 100644 --- a/src/alire/alire-utils.ads +++ b/src/alire/alire-utils.ads @@ -177,9 +177,13 @@ package Alire.Utils with Preelaborate is function New_Line (V : String_Vector) return String_Vector; -- Append an empty line to V - function Split (S : String; Separator : Character) return String_Vector; + function Split (S : String; + Separator : Character; + Trim : Boolean := False) + return String_Vector; -- Split a string in substrings at Separator positions. A Separator at -- S'First or S'Last will result in an empty string also being included. + -- If Trim, whitespace is removed around entries. function Tail (V : String_Vector) return String_Vector with Pre => not V.Is_Empty or else diff --git a/src/alr/alr-commands-index.adb b/src/alr/alr-commands-index.adb index 3757d9d5..a9505656 100644 --- a/src/alr/alr-commands-index.adb +++ b/src/alr/alr-commands-index.adb @@ -3,7 +3,6 @@ with AAA.Table_IO; with Alire.Config.Edit; with Alire.Features.Index; with Alire.Index_On_Disk; -with Alire.TOML_Expressions; with Alire.Utils; package body Alr.Commands.Index is @@ -123,8 +122,7 @@ package body Alr.Commands.Index is procedure Check (Cmd : in out Command) is begin - Alire.TOML_Expressions.Strict_Enums := True; - Cmd.Requires_Full_Index; + Cmd.Requires_Full_Index (Strict => True); Alire.Log_Success ("No unknown values found in index contents."); end Check; diff --git a/src/alr/alr-commands-show.adb b/src/alr/alr-commands-show.adb index e43f0840..768dc407 100644 --- a/src/alr/alr-commands-show.adb +++ b/src/alr/alr-commands-show.adb @@ -130,12 +130,17 @@ package body Alr.Commands.Show is (if Cmd.System then Alire.Platform.Distribution else Alire.Platforms.Distro_Unknown); - Available : constant Alire.Conditional.Availability := + Available : Alire.Conditional.Availability := (if Cmd.System then External.On_Platform (Platform.Properties).Available else External.Available); begin + -- Improve the looks of a default Available + if Available.Is_Empty then + Available := Alire.Conditional.Available_Default; + end if; + for I in Detail.First_Index .. Detail.Last_Index loop -- Skip last element, which is unknown distro Table diff --git a/src/alr/alr-commands-withing.adb b/src/alr/alr-commands-withing.adb index 9f12c04a..75473a6e 100644 --- a/src/alr/alr-commands-withing.adb +++ b/src/alr/alr-commands-withing.adb @@ -456,9 +456,11 @@ package body Alr.Commands.Withing is Root_Release : constant Alire.Releases.Release := Cmd.Root.Release; begin Put_Line ("Dependencies (direct):"); - Root_Release.Dependencies.Print (" ", - Root_Release.Dependencies.Contains_ORs, - Sorted => True); + Root_Release.Dependencies.Print + (Prefix => " ", + Verbose => False, + And_Or => Root_Release.Dependencies.Contains_ORs, + Sorted => True); if Cmd.Solve then Cmd.Requires_Full_Index; -- Load possible hints diff --git a/src/alr/alr-commands.adb b/src/alr/alr-commands.adb index 44a9cbcc..b9d7bbc0 100644 --- a/src/alr/alr-commands.adb +++ b/src/alr/alr-commands.adb @@ -522,12 +522,14 @@ package body Alr.Commands is ------------------------- procedure Requires_Full_Index (Cmd : in out Command'Class; + Strict : Boolean := False; Force_Reload : Boolean := False) is pragma Unreferenced (Cmd); begin Alire.Features.Index.Setup_And_Load - (From => Alire.Config.Edit.Indexes_Directory, - Force => Force_Reload); + (From => Alire.Config.Edit.Indexes_Directory, + Strict => Strict, + Force => Force_Reload); end Requires_Full_Index; ---------------------------- @@ -607,7 +609,7 @@ package body Alr.Commands is if Checked.Solution.Is_Attempted then -- Check deps on disk match those in lockfile - Cmd.Requires_Full_Index; + Cmd.Requires_Full_Index (Strict => False); Checked.Sync_Solution_And_Deps; return; else @@ -665,7 +667,7 @@ package body Alr.Commands is -- upcoming) we are done. Otherwise, do a silent update. if Sync then - Cmd.Requires_Full_Index; + Cmd.Requires_Full_Index (Strict => False); Checked.Update_Dependencies (Silent => True); end if; end; diff --git a/src/alr/alr-commands.ads b/src/alr/alr-commands.ads index e9236b96..d29ef866 100644 --- a/src/alr/alr-commands.ads +++ b/src/alr/alr-commands.ads @@ -92,8 +92,10 @@ package Alr.Commands is -- resetting the root. procedure Requires_Full_Index (Cmd : in out Command'Class; + Strict : Boolean := False; Force_Reload : Boolean := False); - -- Unless Force_Reload, if the index is not empty we no nothing + -- Unless Force_Reload, if the index is not empty we no nothing. When + -- strict, don't allow unknown values in enums. procedure Requires_Valid_Session (Cmd : in out Command'Class; Sync : Boolean := True); diff --git a/testsuite/fixtures/cases_index/he/hello/hello-0.9.0.toml b/testsuite/fixtures/cases_index/he/hello/hello-0.9.0.toml new file mode 100644 index 00000000..6cd3b36d --- /dev/null +++ b/testsuite/fixtures/cases_index/he/hello/hello-0.9.0.toml @@ -0,0 +1,11 @@ +description = "\"Hello, world!\" demonstration project" +name = "hello" +version = "0.9" +maintainers = ["alire@developers.com"] +maintainers-logins = ["mylogin"] + +[executables."case(os)"] +"linux| windows " = ["hello"] # Without and with whitespace + +[origin] +url = "file:../../../crates/hello_1.0.1" diff --git a/testsuite/fixtures/cases_index/he/hello/hello-1.0.1.toml b/testsuite/fixtures/cases_index/he/hello/hello-1.0.1.toml index 63c1989b..c7b4f7fd 100644 --- a/testsuite/fixtures/cases_index/he/hello/hello-1.0.1.toml +++ b/testsuite/fixtures/cases_index/he/hello/hello-1.0.1.toml @@ -23,7 +23,7 @@ command = ["hello"] [available."case(os)"] "..." = false linux = true -[available."case(os)".windows."case(word_size)"] +[available."case(os)".windows."case(word-size)"] "..." = false bits_64 = true [executables."case(word-size)"] diff --git a/testsuite/fixtures/cases_index/li/libhello/libhello-1.0.0-linuxonly.toml b/testsuite/fixtures/cases_index/li/libhello/libhello-1.0.0-linuxonly.toml index d0a6149e..42e65fc6 100644 --- a/testsuite/fixtures/cases_index/li/libhello/libhello-1.0.0-linuxonly.toml +++ b/testsuite/fixtures/cases_index/li/libhello/libhello-1.0.0-linuxonly.toml @@ -6,7 +6,7 @@ maintainers-logins = ["mylogin"] [available."case(os)"] "..." = false linux = true -[available."case(os)".windows."case(word_size)"] +[available."case(os)".windows."case(word-size)"] "..." = false bits_64 = true diff --git a/testsuite/tests/index/case-expressions/test.py b/testsuite/tests/index/case-expressions/test.py index 53e32678..7cf3db04 100644 --- a/testsuite/tests/index/case-expressions/test.py +++ b/testsuite/tests/index/case-expressions/test.py @@ -16,8 +16,9 @@ p = run_alr('show', 'hello') # Check a few substrings for more certainty: # Available -assert_match(".*Available when: .case OS is LINUX => True, MACOS => False, " - "WINDOWS => .case Word_Size is BITS_32 => False, BITS_64 => True.*", +assert_match(".*Available when: .case OS is Linux => True, " + "Windows => \(case Word_Size is Bits_64 => True, others => False\)" + ", others => False.*", p.out, flags=re.S) # Properties @@ -46,4 +47,16 @@ else: assert_match(".*GPR External: OS := linux.*", p.out, flags=re.S) +# Check that a case given as "x|y" is properly loaded and shown +p = run_alr("show", "hello=0.9") +assert_match( + '.*' + 'Properties:\n' + ' Description: "Hello, world!" demonstration project\n' + ' case OS is\n' + ' when Linux => Executable: hello\n' + ' when Windows => Executable: hello\n' + '.*', + p.out) + print('SUCCESS') diff --git a/testsuite/tests/index/environment/test.py b/testsuite/tests/index/environment/test.py index 615fd9e7..d8226e7a 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 others => Environment: CONDVAR=uvw\n' '.*' ' Environment: VAR1=\${VAR1}:abc\n' ' Environment: VAR2=xyz:\${VAR2}\n' diff --git a/testsuite/tests/index/external-available/test.py b/testsuite/tests/index/external-available/test.py index 8c62303e..8ddeccec 100644 --- a/testsuite/tests/index/external-available/test.py +++ b/testsuite/tests/index/external-available/test.py @@ -15,7 +15,7 @@ import platform p = run_alr('show', 'crate', '--external') assert_match(".*Executable make --version .*" - "(case Toolchain is SYSTEM => False, USER => False).*", + "(case Toolchain is others => False).*", p.out, flags=re.S) # 2nd test: showing available information on current platform diff --git a/testsuite/tests/index/origin-filesystem-bad-path/test.py b/testsuite/tests/index/origin-filesystem-bad-path/test.py index 14466abe..88b59285 100644 --- a/testsuite/tests/index/origin-filesystem-bad-path/test.py +++ b/testsuite/tests/index/origin-filesystem-bad-path/test.py @@ -15,9 +15,7 @@ def run(i, error): config_dir, '.', {'bad_index_{}'.format(i): {'in_fixtures': False}}) p = run_alr("search", "--crates", complain_on_error=False, debug=False) assert_match( - 'ERROR: {}\n' - 'ERROR: alr encountered an unexpected error,' - ' re-run with -d for details.\n$'.format(error), + 'ERROR: {}\n'.format(error), p.out) diff --git a/testsuite/tests/index/too-long-short-description/test.py b/testsuite/tests/index/too-long-short-description/test.py index 891e5e8c..ac1257b0 100644 --- a/testsuite/tests/index/too-long-short-description/test.py +++ b/testsuite/tests/index/too-long-short-description/test.py @@ -10,9 +10,7 @@ p = run_alr('show', 'hello_world', complain_on_error=False, debug=False, quiet=True) assert_match('.*Loading .*hello_world-0.1.0.toml:' '.*description:.*Description string is too long' - ' \(must be no more than [0-9]+\)\n' - '.*alr encountered an unexpected error,' - ' re-run with -d for details.', + ' \(must be no more than [0-9]+\)\n', p.out) print('SUCCESS') diff --git a/testsuite/tests/with/dynamic-dependencies/test.py b/testsuite/tests/with/dynamic-dependencies/test.py index a7b4f7d3..e1d11ca4 100644 --- a/testsuite/tests/with/dynamic-dependencies/test.py +++ b/testsuite/tests/with/dynamic-dependencies/test.py @@ -45,9 +45,7 @@ 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 others => superhello*)") + ".*" + re.escape("Crate slated for removal is not among" " direct static dependencies: superhello") + -- 2.39.5