From ad943967e5ecd48e13c34d42e625757c083c37c3 Mon Sep 17 00:00:00 2001 From: Alejandro R Mosteo Date: Fri, 2 Mar 2018 14:58:46 +0100 Subject: [PATCH] About to implode --- src/alire-conditional-vectors.adb | 42 ------ src/alire-conditional-vectors.ads | 30 ----- src/alire-conditional.ads | 61 ++------- src/alire-conditional_values.adb | 45 +++++++ src/alire-conditional_values.ads | 206 ++++++++++++++++++++++++++++++ src/alire-conditions.ads | 21 --- src/alire-index.adb | 10 +- src/alire-index.ads | 84 ++++-------- src/alire-properties-labeled.ads | 21 ++- src/alire-releases.adb | 77 +++++------ src/alire-releases.ads | 48 ++++--- src/alire-root_project.adb | 3 +- src/alire-root_project.ads | 5 +- 13 files changed, 372 insertions(+), 281 deletions(-) delete mode 100644 src/alire-conditional-vectors.adb delete mode 100644 src/alire-conditional-vectors.ads create mode 100644 src/alire-conditional_values.adb create mode 100644 src/alire-conditional_values.ads delete mode 100644 src/alire-conditions.ads diff --git a/src/alire-conditional-vectors.adb b/src/alire-conditional-vectors.adb deleted file mode 100644 index 549bebda..00000000 --- a/src/alire-conditional-vectors.adb +++ /dev/null @@ -1,42 +0,0 @@ -package body Alire.Conditional.Vectors is - - ---------------- - -- All_Values -- - ---------------- - - function All_Values (V : Vector) return Values is - begin - return Result : Values do - for Cond of V loop - Result := Result & Cond.Then_Value & Cond.Else_Value; - end loop; - end return; - end All_Values; - - -------------- - -- Evaluate -- - -------------- - - function Evaluate (V : Vector; On : Properties.Vector) return Values is - begin - return Result : Values do - for Cond of V loop - Result := Result & Cond.Evaluate (On); - end loop; - end return; - end Evaluate; - - -------------- - -- Evaluate -- - -------------- - - function Evaluate (V : Vector; On : Properties.Vector) return Vector is - begin - return Result : Vector do - for Cond of V loop - Result.Append (Conditional_Value'(New_Unconditional (Values'(Cond.Evaluate (On))))); - end loop; - end return; - end Evaluate; - -end Alire.Conditional.Vectors; diff --git a/src/alire-conditional-vectors.ads b/src/alire-conditional-vectors.ads deleted file mode 100644 index be3d6934..00000000 --- a/src/alire-conditional-vectors.ads +++ /dev/null @@ -1,30 +0,0 @@ -with Ada.Containers.Indefinite_Vectors; - -generic -package Alire.Conditional.Vectors with Preelaborate is - - package Condition_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Conditional_Value); - - type Vector is new Condition_Vectors.Vector with null record; - - function All_Values (V : Vector) return Values; - - function Evaluate (V : Vector; On : Properties.Vector) return Values; - -- Return the values that pass evaluation - - function Evaluate (V : Vector; On : Properties.Vector) return Vector; - -- Take the values that pass evaluation and make a vector of inconditionals - - function New_Conditional (If_X : Requisites.Tree; - Then_X : Values; - Else_X : Values) return Vector is - (To_Vector (New_Conditional (If_X, Then_X, Else_X), 1)); - - function New_Unconditional (V : Values) return Vector is (To_Vector (New_Unconditional (V), 1)); - - function "+" (V : Conditional_Value) return Vector is (To_Vector (V, 1)); - function "and" (L, R : Vector) return Vector is (L & R); - - Empty_Vector : constant Vector := (Condition_Vectors.Empty_Vector with null record); - -end Alire.Conditional.Vectors; diff --git a/src/alire-conditional.ads b/src/alire-conditional.ads index 44657211..14e2794b 100644 --- a/src/alire-conditional.ads +++ b/src/alire-conditional.ads @@ -1,61 +1,16 @@ +with Alire.Conditional_Values; +with Alire.Dependencies.Vectors; with Alire.Properties; with Alire.Requisites; -generic - type Values is private; - with function "&" (L, R : Values) return Values with Unreferenced; -- used in child vectors - -- FIXME: we'll have to keep an eye on the overhead of this (append to be considered instead) package Alire.Conditional with Preelaborate is - type Conditional_Value (<>) is tagged private; + package For_Dependencies is new Conditional_Values (Dependencies.Vectors.Vector, + Dependencies.Vectors."and"); + subtype Dependencies is For_Dependencies.Conditional_Value; - function New_Conditional (If_X : Requisites.Tree; - Then_X : Values; - Else_X : Values) return Conditional_Value; - - function New_Unconditional (V : Values) return Conditional_Value; - - function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values; - - function Condition (This : Conditional_Value) return Requisites.Tree; - - function Is_Unconditional (This : Conditional_Value) return Boolean; - - function True_Value (This : Conditional_Value) return Values; - - function False_Value (This : Conditional_Value) return Values; - -private - - type Conditional_Value is tagged record - Condition : Requisites.Tree; - Then_Value : Values; - Else_Value : Values; - end record; - - function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values is - (if This.Condition.Check (Against) - then This.Then_Value - else This.Else_Value); - - function New_Conditional (If_X : Requisites.Tree; - Then_X : Values; - Else_X : Values) return Conditional_Value is - (Condition => If_X, - Then_Value => Then_X, - Else_Value => Else_X); - - function New_Unconditional (V : Values) return Conditional_Value is - (Condition => Requisites.No_Requisites, - Then_Value => V, - Else_Value => <>); - - function Condition (This : Conditional_Value) return Requisites.Tree is (This.Condition); - - function Is_Unconditional (This : Conditional_Value) return Boolean is (This.Condition.Is_Empty); - - function True_Value (This : Conditional_Value) return Values is (This.Then_Value); - - function False_Value (This : Conditional_Value) return Values is (This.Else_Value); + package For_Properties is new Conditional_Values (Properties.Vector, + Properties."and"); + subtype Properties is For_Properties.Conditional_Value; end Alire.Conditional; diff --git a/src/alire-conditional_values.adb b/src/alire-conditional_values.adb new file mode 100644 index 00000000..e910b3a2 --- /dev/null +++ b/src/alire-conditional_values.adb @@ -0,0 +1,45 @@ +package body Alire.Conditional_Values is + + -------------- + -- Evaluate -- + -------------- + + function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values is + + function Evaluate (This : Inner_Value'Class) return Values is + begin + case This.Kind is + when Condition => + declare + Cond : Conditional_Inner renames Conditional_Inner (This); + begin + if Cond.Condition.Check (Against) then + return Cond.Then_Value.Evaluate (Against); + else + return Cond.Else_Value.Evaluate (Against); + end if; + end; + when Value => + return Value_Inner (This).Value; + when Vector => + return Result : Values do + for Cond of Vector_Inner (This).Values loop + Result := Result & Evaluate (Cond); + end loop; + end return; + end case; + end Evaluate; + + begin + return Evaluate (This.Constant_Reference); + end Evaluate; + + -------------- + -- Evaluate -- + -------------- + + function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Conditional_Value is + (New_Value (This.Evaluate (Against))); + + +end Alire.Conditional_Values; diff --git a/src/alire-conditional_values.ads b/src/alire-conditional_values.ads new file mode 100644 index 00000000..650a77e5 --- /dev/null +++ b/src/alire-conditional_values.ads @@ -0,0 +1,206 @@ +with Alire.Properties; +with Alire.Requisites; + +private with Ada.Containers.Indefinite_Holders; +private with Ada.Containers.Indefinite_Vectors; + +generic + type Values is private; + with function "&" (L, R : Values) return Values; +package Alire.Conditional_Values with Preelaborate is + + type Kinds is (Condition, Value, Vector); + + type Conditional_Value is tagged private; + -- Recursive type that stores conditions (requisites) and values/further conditions if they are met or not + + function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Values; + -- Materialize against the given properties + + function Evaluate (This : Conditional_Value; Against : Properties.Vector) return Conditional_Value; + -- Materialize against the given properties, returning values as an unconditional vector + + function Kind (This : Conditional_Value) return Kinds; + + function Is_Empty (This : Conditional_Value) return Boolean; + + function Empty return Conditional_Value; + + --------------- + -- SINGLES -- + --------------- + + function New_Value (V : Values) return Conditional_Value; -- when we don't really need a condition + + function Is_Value (This : Conditional_Value) return Boolean; + + function Value (This : Conditional_Value) return Values + with Pre => This.Is_Value; + + --------------- + -- VECTORS -- + --------------- + + function "and" (L, R : Conditional_Value) return Conditional_Value; + -- Concatenation + + -------------------- + -- CONDITIONALS -- + -------------------- + + function New_Conditional (If_X : Requisites.Tree; + Then_X : Conditional_Value; + Else_X : Conditional_Value) return Conditional_Value; + + function Condition (This : Conditional_Value) return Requisites.Tree + with Pre => This.Kind = Condition; + + function True_Value (This : Conditional_Value) return Conditional_Value + with Pre => This.Kind = Condition; + + function False_Value (This : Conditional_Value) return Conditional_Value + with Pre => This.Kind = Condition; + +private + + type Inner_Value is abstract tagged null record; + + function Kind (This : Inner_Value'Class) return Kinds; + + package Holders is new Ada.Containers.Indefinite_Holders (Inner_Value'Class); + package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, Inner_Value'Class); + + type Conditional_Value is new Holders.Holder with null record; + -- Instead of dealing with pointers and finalization, we use this class-wide container + + type Value_Inner is new Inner_Value with record + Value : Values; + end record; + + type Vector_Inner is new Inner_Value with record + Values : Vectors.Vector; + end record; + + type Conditional_Inner is new Inner_Value with record + Condition : Requisites.Tree; + Then_Value : Conditional_Value; + Else_Value : Conditional_Value; + end record; + + -------------- + -- As_Value -- + -------------- + + function As_Value (This : Conditional_Value) return Values + is + (Value_Inner (This.Constant_Reference.Element.all).Value) + with Pre => This.Kind = Value; + + -------------------- + -- As_Conditional -- + -------------------- + + function As_Conditional (This : Conditional_Value) return Conditional_Inner'Class is + (Conditional_Inner'Class (This.Element)) + with Pre => This.Kind = Condition; + + --------------- + -- As_Vector -- + --------------- + + function As_Vector (This : Conditional_Value) return Vectors.Vector is + (Vector_Inner'Class (This.Element).Values) + with Pre => This.Kind = Vector; + + --------------------- + -- New_Conditional -- + --------------------- + + function New_Conditional (If_X : Requisites.Tree; + Then_X : Conditional_Value; + Else_X : Conditional_Value) return Conditional_Value is + (To_Holder (Conditional_Inner'(Condition => If_X, + Then_Value => Then_X, + Else_Value => Else_X))); + + --------------- + -- New_Value -- + --------------- + + function New_Value (V : Values) return Conditional_Value is + (To_Holder (Value_Inner'(Value => V))); + + --------------- + -- Condition -- + --------------- + + function Condition (This : Conditional_Value) return Requisites.Tree is + (This.As_Conditional.Condition); + + -------------- + -- Is_Value -- + -------------- + + function Is_Value (This : Conditional_Value) return Boolean is + (This.Kind = Value); + + ----------- + -- Value -- + ----------- + + function Value (This : Conditional_Value) return Values renames As_Value; + + ---------------- + -- True_Value -- + ---------------- + + function True_Value (This : Conditional_Value) return Conditional_Value is + (This.As_Conditional.Then_Value); + + ----------------- + -- False_Value -- + ----------------- + + function False_Value (This : Conditional_Value) return Conditional_Value is + (This.As_Conditional.Else_Value); + + ----------- + -- "and" -- + ----------- + + use all type Vectors.Vector; + + function "and" (L, R : Conditional_Value) return Conditional_Value is + (To_Holder (Vector_Inner'(Values => L.Element & R.Element))); + + ----------- + -- Empty -- + ----------- + + function Empty return Conditional_Value is + (Holders.Empty_Holder with null record); + + -------------- + -- Is_Empty -- + -------------- + + overriding function Is_Empty (This : Conditional_Value) return Boolean is + (Holders.Holder (This).Is_Empty); + + ---------- + -- Kind -- + ---------- + + function Kind (This : Inner_Value'Class) return Kinds is + (if This in Value_Inner'Class + then Value + else (if This in Vector_Inner'Class + then Vector + else Condition)); + + function Kind (This : Conditional_Value) return Kinds is + (This.Constant_Reference.Kind); + + -- The price of doing this without pointers is this manual dispatching... + +end Alire.Conditional_Values; diff --git a/src/alire-conditions.ads b/src/alire-conditions.ads deleted file mode 100644 index 8acffc6f..00000000 --- a/src/alire-conditions.ads +++ /dev/null @@ -1,21 +0,0 @@ -with Alire.Conditional; -with Alire.Conditional.Vectors; -with Alire.Dependencies.Vectors; -with Alire.Properties; -with Alire.Requisites; - -private with Semantic_Versioning; - -package Alire.Conditions with Preelaborate is - - package For_Dependencies is new Conditional (Dependencies.Vectors.Vector, - Dependencies.Vectors."and"); - package Dependencies is new For_Dependencies.Vectors; - -- Conditional dependencies - - package For_Properties is new Conditional (Properties.Vector, - Properties."and"); - package Properties is new For_Properties.Vectors; - -- Conditional properties declared therein - -end Alire.Conditions; diff --git a/src/alire-index.adb b/src/alire-index.adb index 5834d0b4..1528716f 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -1,5 +1,7 @@ package body Alire.Index is + use all type Version; + ------------ -- Exists -- ------------ @@ -8,7 +10,7 @@ package body Alire.Index is Version : Semantic_Versioning.Version) return Boolean is begin - for R of Releases loop + for R of Catalog loop if R.Project = Project and then R.Version = Version then return True; end if; @@ -24,7 +26,7 @@ package body Alire.Index is function Find (Project : Project_Name; Version : Semantic_Versioning.Version) return Release is begin - for R of Releases loop + for R of Catalog loop if R.Project = Project and then R.Version = Version then return R; end if; @@ -58,10 +60,10 @@ package body Alire.Index is Properties => Properties, Available => Available_When) do - if Releases.Contains (Rel) then + if Catalog.Contains (Rel) then Log ("Attempt to register duplicate versions: " & Rel.Milestone.Image, Warning); else - Releases.Insert (Rel); + Catalog.Insert (Rel); end if; end return; end Register; diff --git a/src/alire-index.ads b/src/alire-index.ads index 7b247f51..b9597c54 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -2,7 +2,7 @@ private with Alire_Early_Elaboration; pragma Unreferenced (Alire_Early_Elaborati with Ada.Directories; -with Alire.Conditions; +with Alire.Conditional; with Alire.Containers; with Alire.Dependencies.Vectors; with Alire.GPR; @@ -24,11 +24,11 @@ package Alire.Index is Catalog : Containers.Release_Set; - subtype Release_Dependencies is Conditions.Dependencies.Vector; - subtype Release_Properties is Conditions.Properties.Vector; + subtype Release_Dependencies is Conditional.Dependencies; + subtype Release_Properties is Conditional.Properties; - No_Dependencies : constant Release_Dependencies := Conditions.Dependencies.Empty_Vector; - No_Properties : constant Release_Properties := Conditions.Properties.Empty_Vector; + No_Dependencies : constant Release_Dependencies := Conditional.For_Dependencies.Empty; + No_Properties : constant Release_Properties := Conditional.For_Properties.Empty; No_Requisites : constant Requisites.Tree := Requisites.Trees.Empty_Tree; subtype Release is Alire.Releases.Release; @@ -78,7 +78,7 @@ package Alire.Index is function On (Name : Project_Name; Versions : Semver.Version_Set) - return Conditions.Dependencies.Vector renames Releases.On; + return Conditional.Dependencies renames Releases.On; -- We provide two easy shortcut forms: -- One, using another release, from which we'll take name and version @@ -137,53 +137,42 @@ package Alire.Index is -- Function for introducing conditional properties depending on platform conditions function If_Platform (Condition : Requisites.Tree; - When_True : Dependencies.Vector; - When_False : Dependencies.Vector := Dependencies.Vectors.No_Dependencies) - return Release_Dependencies; + When_True : Release_Dependencies; + When_False : Release_Dependencies := No_Dependencies) + return Release_Dependencies renames Conditional.For_Dependencies.New_Conditional; function If_Platform (Condition : Requisites.Tree; - When_True : Properties.Vector; - When_False : Properties.Vector := Properties.No_Properties) - return Release_Properties; + When_True : Release_Properties; + When_False : Release_Properties := No_Properties) + return Release_Properties renames Conditional.For_Properties.New_Conditional; -- Attributes (named pairs of label-value) -- We need them as Properties.Vector (inside conditionals) but also as -- Conditional vectors (although with unconditional value inside) package PL renames Properties.Labeled; - function Author is new PL.Generic_New_Label (Properties.Labeled.Author); - function Author is new PL.Unconditional_New_Label (Properties.Labeled.Comment); - - function Comment is new PL.Generic_New_Label (Properties.Labeled.Comment); - function Comment is new PL.Unconditional_New_Label (Properties.Labeled.Comment); - - function Executable is new PL.Generic_New_Label (Properties.Labeled.Executable); - function Executable is new PL.Unconditional_New_Label (Properties.Labeled.Executable); - - function GPR_File is new PL.Generic_New_Label (Properties.Labeled.GPR_File); - function GPR_File is new PL.Unconditional_New_Label (Properties.Labeled.Executable); - - function Maintainer is new PL.Generic_New_Label (Properties.Labeled.Maintainer); - function Maintainer is new PL.Unconditional_New_Label (Properties.Labeled.Maintainer); - - function Website is new PL.Generic_New_Label (Properties.Labeled.Website); - function Website is new PL.Unconditional_New_Label (Properties.Labeled.Website); + function Author is new PL.Cond_New_Label (Properties.Labeled.Author); + function Comment is new PL.Cond_New_Label (Properties.Labeled.Comment); + function Executable is new PL.Cond_New_Label (Properties.Labeled.Executable); + function GPR_File is new PL.Cond_New_Label (Properties.Labeled.GPR_File); + function Maintainer is new PL.Cond_New_Label (Properties.Labeled.Maintainer); + function Website is new PL.Cond_New_Label (Properties.Labeled.Website); - function U (Prop : Properties.Vector) return Conditions.Properties.Vector - renames Conditions.Properties.New_Unconditional; + function U (Prop : Properties.Vector) return Conditional.Properties + renames Conditional.For_Properties.New_Value; -- Non-label attributes require a custom builder function function GPR_Free_Scenario (Name : String) return Properties.Vector is (+Properties.Scenarios.New_Variable (GPR.Free_Variable (Name))); - function GPR_Free_Scenario (Name : String) return Conditions.Properties.Vector is (U (GPR_Free_Scenario (Name))); + function GPR_Free_Scenario (Name : String) return Conditional.Properties is (U (GPR_Free_Scenario (Name))); function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Properties.Vector is (+Properties.Scenarios.New_Variable (GPR.Enum_Variable (Name, Values))); - function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Conditions.Properties.Vector is (U (GPR_Scenario (Name, Values))); + function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Conditional.Properties is (U (GPR_Scenario (Name, Values))); function License (L : Licensing.Licenses) return Properties.Vector is (+Properties.Licenses.Values.New_Property (L)); - function License (L : Licensing.Licenses) return Conditions.Properties.Vector is (U (License (L))); + function License (L : Licensing.Licenses) return Conditional.Properties is (U (License (L))); - function "and" (D1, D2 : Dependencies.Vector) return Dependencies.Vector renames Alire.Dependencies.Vectors."and"; - function "and" (P1, P2 : Properties.Vector) return Properties.Vector renames Alire.Properties."and"; +-- function "and" (D1, D2 : Dependencies.Vector) return Dependencies.Vector renames Alire.Dependencies.Vectors."and"; +-- function "and" (P1, P2 : Properties.Vector) return Properties.Vector renames Alire.Properties."and"; -- function Verifies (P : Properties.Property'Class) return Properties.Vector; -- function "+" (P : Properties.Property'Class) return Properties.Vector renames Verifies; @@ -216,31 +205,10 @@ package Alire.Index is function Set_Root_Project (Project : Alire.Project_Name; Version : Semantic_Versioning.Version; - Depends_On : Conditions.Dependencies.Vector := - Conditions.Dependencies.Empty_Vector) + Depends_On : Conditional.Dependencies := No_Dependencies) return Release renames Root_Project.Set; -- This function must be called in the working project alire file. -- Otherwise alr does not know what's the current project, and its version and dependencies -- The returned Release is the same; this is just a trick to be able to use it in an spec file. -private - --- function Verifies (P : Properties.Property'Class) return Properties.Vector is --- (Properties.To_Vector (P, 1)); --- --- function Requires (R : Requisites.Requisite'Class) return Requisites.Tree is --- (Requisites.Trees.Leaf (R)); - - function If_Platform (Condition : Requisites.Tree; - When_True : Dependencies.Vector; - When_False : Dependencies.Vector := Dependencies.Vectors.No_Dependencies) - return Release_Dependencies is - (Conditions.Dependencies.New_Conditional (Condition, When_True, When_False)); - - function If_Platform (Condition : Requisites.Tree; - When_True : Properties.Vector; - When_False : Properties.Vector := Properties.No_Properties) - return Release_Properties is - (Conditions.Properties.New_Conditional (Condition, When_True, When_False)); - end Alire.Index; diff --git a/src/alire-properties-labeled.ads b/src/alire-properties-labeled.ads index 2078316b..7576590b 100644 --- a/src/alire-properties-labeled.ads +++ b/src/alire-properties-labeled.ads @@ -1,4 +1,4 @@ -with Alire.Conditions; +with Alire.Conditional; private with Alire.Utils; @@ -24,14 +24,14 @@ package Alire.Properties.Labeled with Preelaborate is overriding function Image (L : Label) return String; - generic - Name : Labels; - function Generic_New_Label (Value : String) return Properties.Vector; - -- Returns a vector so its directly usable during indexing +-- generic +-- Name : Labels; +-- function Vec_New_Label (Value : String) return Properties.Vector; +-- -- Returns a vector so its directly usable during indexing generic Name : Labels; - function Unconditional_New_Label (Value : String) return Conditions.Properties.Vector; + function Cond_New_Label (Value : String) return Conditional.Properties; private @@ -47,12 +47,11 @@ private function Value (L : Label) return String is (L.Value); - function Generic_New_Label (Value : String) return Properties.Vector is - (To_Vector (New_Label (Name, Value), 1)); +-- function Vec_New_Label (Value : String) return Properties.Vector is +-- (To_Vector (New_Label (Name, Value), 1)); - function Unconditional_New_Label (Value : String) return Conditions.Properties.Vector is - (Conditions.Properties.New_Unconditional - (+New_Label (Name, Value))); + function Cond_New_Label (Value : String) return Conditional.Properties is + (Conditional.For_Properties.New_Value (+New_Label (Name, Value))); overriding function Image (L : Label) return String is (Utils.To_Mixed_Case (L.Name'Img) & ": " & L.Value); diff --git a/src/alire-releases.adb b/src/alire-releases.adb index 22358d6f..360620d1 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -30,9 +30,11 @@ package body Alire.Releases is -- Executables -- ---------------- - function Executables (R : Release) return Utils.String_Vector is + function Executables (R : Release; + P : Properties.Vector := Properties.No_Properties) + return Utils.String_Vector is begin - return Exes : Utils.String_Vector := Values (R.Properties.All_Values, Executable) do + return Exes : Utils.String_Vector := Values (R.Properties.Evaluate (P), Executable) do if OS_Lib.Exe_Suffix /= "" then for I in Exes.Iterate loop Exes (I) := Exes (I) & OS_Lib.Exe_Suffix; @@ -45,9 +47,11 @@ package body Alire.Releases is -- GPR_Files -- --------------- - function GPR_Files (R : Release) return Utils.String_Vector is + function GPR_Files (R : Release; + P : Properties.Vector := Properties.No_Properties) + return Utils.String_Vector is begin - return Files : Utils.String_Vector := Values (R.Properties.All_Values, GPR_File) do + return Files : Utils.String_Vector := Values (R.Properties.Evaluate (P), GPR_File) do if Files.Is_Empty then Files.Append (R.Project & ".gpr"); end if; @@ -58,24 +62,25 @@ package body Alire.Releases is -- Print_Conditional_Property -- -------------------------------- - procedure Print_Conditional_Property (Cond : Conditions.For_Properties.Conditional_Value) is + procedure Print_Conditional_Property (Cond : Conditional.Properties) is use GNAT.IO; begin - if Cond.Is_Unconditional then - Cond.True_Value.Print (Prefix => " "); - else - if Cond.True_Value.Is_Empty then - Put_Line (" when not (" & Cond.Condition.Image & "):"); - Cond.False_Value.Print (Prefix => " "); - else - Put_Line (" when " & Cond.Condition.Image & ":"); - Cond.True_Value.Print (Prefix => " "); - if not Cond.False_Value.Is_Empty then - Put_Line (" else:"); - Cond.False_Value.Print (Prefix => " "); - end if; - end if; - end if; + Put_Line (" (unimplemented)"); +-- if Cond.Is_Unconditional then +-- Cond.True_Value.Print (Prefix => " "); +-- else +-- if Cond.True_Value.Is_Empty then +-- Put_Line (" when not (" & Cond.Condition.Image & "):"); +-- Cond.False_Value.Print (Prefix => " "); +-- else +-- Put_Line (" when " & Cond.Condition.Image & ":"); +-- Cond.True_Value.Print (Prefix => " "); +-- if not Cond.False_Value.Is_Empty then +-- Put_Line (" else:"); +-- Cond.False_Value.Print (Prefix => " "); +-- end if; +-- end if; +-- end if; end Print_Conditional_Property; ----------- @@ -99,9 +104,9 @@ package body Alire.Releases is -- PROPERTIES if not R.Properties.Is_Empty then Put_Line ("Properties:"); - for Cond of R.Properties loop - Print_Conditional_Property (Cond); - end loop; +-- for Cond of R.Properties loop +-- Print_Conditional_Property (Cond); +-- end loop; end if; -- DEPENDENCIES @@ -122,19 +127,19 @@ package body Alire.Releases is Search : constant String := To_Lower_Case (Str); begin - for P of R.Properties.All_Values loop - declare - Text : constant String := - To_Lower_Case - ((if Utils.Contains (P.Image, ":") - then Utils.Tail (P.Image, ':') - else P.Image)); - begin - if Utils.Contains (Text, Search) then - return True; - end if; - end; - end loop; +-- for P of R.Properties.All_Values loop +-- declare +-- Text : constant String := +-- To_Lower_Case +-- ((if Utils.Contains (P.Image, ":") +-- then Utils.Tail (P.Image, ':') +-- else P.Image)); +-- begin +-- if Utils.Contains (Text, Search) then +-- return True; +-- end if; +-- end; +-- end loop; return False; end Property_Contains; diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 90c76cd1..da68fac0 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -1,4 +1,4 @@ -with Alire.Conditions; +with Alire.Conditional; with Alire.Dependencies; with Alire.Dependencies.Vectors; with Alire.Milestones; @@ -14,14 +14,14 @@ private with Alire.Properties.Labeled; package Alire.Releases with Preelaborate is - type Release (<>) is tagged private; + type Release (<>) is tagged private; function New_Release (Name : Project_Name; Description : Project_Description; Version : Semantic_Versioning.Version; Origin : Origins.Origin; - Depends_On : Conditions.Dependencies.Vector; - Properties : Conditions.Properties.Vector; + Depends_On : Conditional.Dependencies; + Properties : Conditional.Properties; Available : Alire.Requisites.Tree) return Release; function "<" (L, R : Release) return Boolean; @@ -42,11 +42,17 @@ package Alire.Releases with Preelaborate is function Default_Executable (R : Release) return String; -- We encapsulate here the fixing of platform extension - function Executables (R : Release) return Utils.String_Vector; + function Executables (R : Release; + P : Properties.Vector := Properties.No_Properties) + return Utils.String_Vector; -- Only explicity declared ones + -- Under some conditions (usually current platform) - function GPR_Files (R : Release) return Utils.String_Vector; + function GPR_Files (R : Release; + P : Properties.Vector := Properties.No_Properties) + return Utils.String_Vector; -- Explicitly declared ones, or if default one if none declared + -- Under some conditions (usually current platform) function Image (R : Release) return Path_String; -- Unique string built as name_version_id @@ -66,40 +72,40 @@ package Alire.Releases with Preelaborate is function On (Name : Project_Name; Versions : Semantic_Versioning.Version_Set) - return Conditions.Dependencies.Vector; + return Conditional.Dependencies; generic with function Condition (V : Semantic_Versioning.Version) return Semantic_Versioning.Version_Set; - function From_Release (R : Release) return Conditions.Dependencies.Vector; + function From_Release (R : Release) return Conditional.Dependencies; generic with function Condition (V : Semantic_Versioning.Version) return Semantic_Versioning.Version_Set; function From_Names (P : Project_Name; - V : Semantic_Versioning.Version_String) return Conditions.Dependencies.Vector; + V : Semantic_Versioning.Version_String) return Conditional.Dependencies; private use Properties; - function Describe is new Properties.Labeled.Generic_New_Label (Properties.Labeled.Description); + function Describe is new Properties.Labeled.Cond_New_Label (Properties.Labeled.Description); type Release (Name_Len, Descr_Len : Natural) is tagged record Name : Project_Name (1 .. Name_Len); Description : Project_Description (1 .. Descr_Len); Version : Semantic_Versioning.Version; Origin : Origins.Origin; - Dependencies : Conditions.Dependencies.Vector; - Properties : Conditions.Properties.Vector; + Dependencies : Conditional.Dependencies; + Properties : Conditional.Properties; Available : Requisites.Tree; end record; - use Conditions.Properties; - + use all type Conditional.Properties; + function New_Release (Name : Project_Name; Description : Project_Description; Version : Semantic_Versioning.Version; Origin : Origins.Origin; - Depends_On : Conditions.Dependencies.Vector; - Properties : Conditions.Properties.Vector; + Depends_On : Conditional.Dependencies; + Properties : Conditional.Properties; Available : Alire.Requisites.Tree) return Release is (Name'Length, Description'Length, Name, @@ -107,7 +113,7 @@ private Version, Origin, Depends_On, - +Conditions.For_Properties.New_Unconditional (Describe (Description)) and Properties, + Describe (Description) and Properties, Available); use Semantic_Versioning; @@ -146,15 +152,15 @@ private function On (Name : Project_Name; Versions : Semantic_Versioning.Version_Set) - return Conditions.Dependencies.Vector is - (Conditions.Dependencies.New_Unconditional -- A conditional (without condition) dependency vector + return Conditional.Dependencies is + (Conditional.For_Dependencies.New_Value -- A conditional (without condition) dependency vector (Dependencies.Vectors.New_Dependency (Name, Versions))); -- A dependency vector - function From_Release (R : Release) return Conditions.Dependencies.Vector is + function From_Release (R : Release) return Conditional.Dependencies is (On (R.Project, Condition (R.Version))); function From_Names (P : Project_Name; - V : Semantic_Versioning.Version_String) return Conditions.Dependencies.Vector is + V : Semantic_Versioning.Version_String) return Conditional.Dependencies is (On (P, Condition (Semantic_Versioning.New_Version (V)))); end Alire.Releases; diff --git a/src/alire-root_project.adb b/src/alire-root_project.adb index 11571b7d..f5de890a 100644 --- a/src/alire-root_project.adb +++ b/src/alire-root_project.adb @@ -32,8 +32,7 @@ package body Alire.Root_Project is function Set (Project : Alire.Project_Name; Version : Semantic_Versioning.Version; - Depends_On : Conditions.Dependencies.Vector := - Conditions.Dependencies.Empty_Vector) + Depends_On : Conditional.Dependencies := Conditional.For_Dependencies.Empty) return Releases.Release is use Origins; diff --git a/src/alire-root_project.ads b/src/alire-root_project.ads index ed9f462a..00336827 100644 --- a/src/alire-root_project.ads +++ b/src/alire-root_project.ads @@ -1,4 +1,4 @@ -with Alire.Conditions; +with Alire.Conditional; with Alire.Releases; with Semantic_Versioning; @@ -11,8 +11,7 @@ package Alire.Root_Project is function Set (Project : Project_Name; Version : Semantic_Versioning.Version; - Depends_On : Conditions.Dependencies.Vector := - Conditions.Dependencies.Empty_Vector) + Depends_On : Conditional.Dependencies := Conditional.For_Dependencies.Empty) return Releases.Release; -- This function must be called in the working project alire file. -- Otherwise alr does not know what's the current project, and its version and dependencies