Testing of variants

This commit is contained in:
Alejandro R. Mosteo
2018-03-24 19:26:05 +01:00
parent 0cee770a16
commit 7cb2298589
10 changed files with 115 additions and 57 deletions
+18 -2
View File
@@ -51,7 +51,15 @@ package body Alire.Boolean_Trees is
function "and" (L, R : Tree) return Tree is
begin
return Merge_Under (Node'(Kind => And_Node), L, R);
if L.Is_Empty and then R.Is_Empty then
return Empty_Tree;
elsif L.Is_Empty then
return R;
elsif R.Is_Empty then
return L;
else
return Merge_Under (Node'(Kind => And_Node), L, R);
end if;
end "and";
----------
@@ -60,7 +68,15 @@ package body Alire.Boolean_Trees is
function "or" (L, R : Tree) return Tree is
begin
return Merge_Under (Node'(Kind => Or_Node), L, R);
if L.Is_Empty and then R.Is_Empty then
return Empty_Tree;
elsif L.Is_Empty then
return R;
elsif R.Is_Empty then
return L;
else
return Merge_Under (Node'(Kind => Or_Node), L, R);
end if;
end "or";
-----------
+2 -4
View File
@@ -19,14 +19,12 @@ package Alire.Boolean_Trees with Preelaborate is
function Leaf (C : Condition) return Tree;
function "+" (C : Condition) return Tree renames Leaf;
function "and" (L, R : Tree) return Tree
with Pre => L /= Empty_Tree and then R /= Empty_Tree;
function "and" (L, R : Tree) return Tree;
function "and" (L : Tree; R : Condition) return Tree is (L and Leaf (R));
function "and" (L : Condition; R : Tree) return Tree is (Leaf (L) and R);
function "and" (L : Condition; R : Condition) return Tree is (Leaf (L) and Leaf (R));
function "or" (L, R : Tree) return Tree
with Pre => L /= Empty_Tree and then R /= Empty_Tree;
function "or" (L, R : Tree) return Tree;
function "or" (L : Tree; R : Condition) return Tree is (L or Leaf (R));
function "or" (L : Condition; R : Tree) return Tree is (Leaf (L) or R);
function "or" (L : Condition; R : Condition) return Tree is (Leaf (L) or Leaf (R));
+11
View File
@@ -1,5 +1,16 @@
package body Alire.Containers is
---------------
-- Excluding --
---------------
function Excluding (Map : Release_Map; Name : Projects.Names) return Release_Map is
begin
return Filtered : Release_Map := Map do
Filtered.Exclude (Name);
end return;
end Excluding;
------------
-- To_Map --
------------
+3 -1
View File
@@ -32,7 +32,9 @@ package Alire.Containers with Preelaborate is
package Project_Release_Maps is new Ada.Containers.Indefinite_Ordered_Maps
(Projects.Names, Releases.Release, Projects."<", Releases."=");
subtype Release_Map is Project_Release_Maps.Map;
type Release_Map is new Project_Release_Maps.Map with null record;
function Excluding (Map : Release_Map; Name : Projects.Names) return Release_Map;
function To_Map (R : Releases.Release) return Release_Map;
+3 -3
View File
@@ -68,7 +68,7 @@ package body Alire.Index is
return Boolean is
begin
for R of Catalog loop
if R.Project = Project and then R.Version = Version then
if R.Variant = Project and then R.Version = Version then
return True;
end if;
end loop;
@@ -84,7 +84,7 @@ package body Alire.Index is
Version : Semantic_Versioning.Version) return Release is
begin
for R of Catalog loop
if R.Project = Project and then R.Version = Version then
if R.Variant = Project and then R.Version = Version then
return R;
end if;
end loop;
@@ -163,7 +163,7 @@ package body Alire.Index is
pragma Unreferenced (XXXXXXXXXXXXXX);
begin
return Register (Project,
Parent.New_Child (Variant => Variant,
Parent.New_Child (Variant => Parent.Variant & ":" & Variant,
Notes => Notes,
Dependencies => Dependencies,
Properties => Properties,
@@ -2,6 +2,19 @@ with Alire.Utils;
package Alire.Projects with Preelaborate is
subtype Variant_String is String;
type Project (Variant_Length, Description_Length : Natural) is tagged private;
function New_Project (Variant : Variant_String;
Description : Description_String) return Project;
function Name (P : Project) return Name_String;
function Variant (P : Project) return Variant_String;
function Description (P : Project) return Description_String;
-----------
-- Names --
-----------
@@ -219,4 +232,22 @@ private
function Image (Name : Names) return String is (Utils.To_Lower_Case (Name'Img));
type Project (Variant_Length, Description_Length : Natural) is tagged record
Variant : Variant_String (1 .. Variant_Length);
Description : Description_String (1 .. Description_Length);
end record;
function New_Project (Variant : Variant_String;
Description : Description_String) return Project is
(Variant_Length => Variant'Length,
Description_Length => Description'Length,
Variant => Variant,
Description => Description);
function Name (P : Project) return Name_String is (Utils.Head (P.Variant, ':'));
function Variant (P : Project) return Variant_String is (P.Variant);
function Description (P : Project) return Description_String is (P.Description);
end Alire.Projects;
+23 -22
View File
@@ -24,7 +24,7 @@ package body Alire.Releases is
---------------
function New_Child (Parent : Release;
Variant : Name_String;
Variant : Projects.Variant_String;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
@@ -35,11 +35,12 @@ package body Alire.Releases is
use Conditional.For_Properties;
use Requisites.Trees;
begin
return Solid : constant Release (Variant'Length, Notes'Length) :=
(Variant_Len => Variant'Length,
return Solid : constant Release (Variant'Length, Parent.Description'Length, Notes'Length) :=
(Var_Len => Variant'Length,
Descr_Len => Parent.Description'Length,
Notes_Len => Notes'Length,
Name => Parent.Name,
Variant => Variant,
Project => Projects.New_Project (Variant, Parent.Description),
Version => Parent.Version,
Origin => Parent.Origin,
Notes => Notes,
@@ -64,21 +65,21 @@ package body Alire.Releases is
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release is
(0,
Notes'Length,
Name,
Version,
Origin,
"",
Notes,
Dependencies,
Describe (Projects.Description (Name)) and
(Var_Len => Image (Name)'Length,
Descr_Len => Projects.Description (Name)'Length,
Notes_Len => Notes'Length,
Project => Projects.New_Project (Image (Name), Projects.Description (Name)),
Version => Version,
Origin => Origin,
Notes => Notes,
Dependencies => Dependencies,
Properties => Describe (Projects.Description (Name)) and
(if Notes /= ""
then Comment (notes)
then Comment (Notes)
else Conditional.For_Properties.Empty) and
Properties,
Private_Properties,
Available);
Priv_Props => Private_Properties,
Available => Available);
----------------------------
-- On_Platform_Properties --
@@ -142,7 +143,7 @@ package body Alire.Releases is
Without : Utils.String_Vector;
begin
if With_Paths.Is_Empty then
With_Paths.Append (String'(R.Project & ".gpr"));
With_Paths.Append (String'(R.Name_Img & ".gpr"));
end if;
if With_Path then
@@ -357,11 +358,11 @@ package body Alire.Releases is
function Whenever (R : Release; P : Properties.Vector) return Release is
begin
return Solid : constant Release (0, R.Notes_Len) :=
(Variant_Len => 0,
return Solid : constant Release (R.Var_Len, R.Descr_Len, R.Notes_Len) :=
(Var_Len => R.Var_Len,
Descr_Len => R.Descr_Len,
Notes_Len => R.Notes_Len,
Name => R.Name,
Variant => R.Variant,
Project => R.Project,
Version => R.Version,
Origin => R.Origin,
Notes => R.Notes,
+15 -24
View File
@@ -27,7 +27,7 @@ package Alire.Releases with Preelaborate is
Available : Alire.Requisites.Tree) return Release;
function New_Child (Parent : Release;
Variant : Name_String;
Variant : Projects.Variant_String;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
@@ -40,14 +40,13 @@ package Alire.Releases with Preelaborate is
-- Materialize conditions in a Release once the whatever properties are known
-- At present dependencies and properties
function Name (R : Release) return Projects.Names;
function Name (R : Release) return Projects.Names;
function Name_Colon_Variant (R : Release) return String;
function Name_Img (R : Release) return Name_String;
function Variant (R : Release) return String;
-- name:variant
function Name_Variant (R : Release) return String;
-- name_variant
function Is_Variant (R : Release) return Boolean;
function Notes (R : Release) return Description_String; -- Specific to release
@@ -131,11 +130,10 @@ private
function Comment is new Alire.Properties.Labeled.Cond_New_Label (Alire.Properties.Labeled.Comment);
function Describe is new Alire.Properties.Labeled.Cond_New_Label (Alire.Properties.Labeled.Description);
type Release (Variant_Len, Notes_Len : Natural) is new Versions.Versioned with record
Name : Projects.Names;
type Release (Var_Len, Descr_Len, Notes_Len : Natural) is new Versions.Versioned with record
Project : Projects.Project (Var_Len, Descr_Len);
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Variant : Name_String (1 .. Variant_Len);
Notes : Description_String (1 .. Notes_Len);
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
@@ -146,28 +144,21 @@ private
use all type Conditional.Properties;
function "<" (L, R : Release) return Boolean is
(L.Name_Colon_Variant < R.Name_Colon_Variant or else
(L.Name_Colon_Variant = R.Name_Colon_Variant and then
(L.Variant < R.Variant or else
(L.Variant = R.Variant and then
L.Version < R.Version) or else
(L.Name = R.Name and then
L.Version = R.Version and then
Build (L.Version) < Build (R.Version)));
function Name (R : Release) return Projects.Names is (R.Name);
function Name (R : Release) return Projects.Names is (Projects.Names'Value (R.Project.Name));
function Name_Colon_Variant (R : Release) return String is
(Projects.Image (R.Name) &
(if R.Is_Variant
then ":" & R.Variant
else ""));
function Name_Img (R : Release) return Name_String is (Image (R.Name));
function Name_Variant (R : Release) return String is
(Projects.Image (R.Name) &
(if R.Is_Variant
then "_" & R.Variant
else ""));
function Variant (R : Release) return String is
(R.Project.Variant);
function Is_Variant (R : Release) return Boolean is (R.Variant_Len > 0);
function Is_Variant (R : Release) return Boolean is (Utils.Contains (R.Variant, ":"));
function Description (R : Release) return Description_String is (Projects.Description (R.Name));
function Notes (R : Release) return Description_String is (R.Notes);
@@ -185,7 +176,7 @@ private
(Milestones.New_Milestone (R.Name, R.Version));
function Default_Executable (R : Release) return String is
(R.Name_Variant & OS_Lib.Exe_Suffix);
(Utils.Replace (R.Variant, ":", "_") & OS_Lib.Exe_Suffix);
use all type Origins.Kinds;
function Image (R : Release) return Folder_String is
+1 -1
View File
@@ -55,7 +55,7 @@ private
function Name (R : Root) return Name_String is
(if R.Released
then R.Release.Constant_Reference.Project
then R.Release.Constant_Reference.Name_Img
else R.Name);
function Release (R : Root) return Releases.Release is (R.Release.Element);
+8
View File
@@ -18,6 +18,14 @@ package Alire with Preelaborate is
Name_String (Name_String'First) /= '_' and then
(for all C of Name_String => C in 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_');
subtype Designation_String is String with Dynamic_Predicate =>
Designation_String'Length >= 7 and then
Designation_String'Length <= Max_Name_Length * 2 + 1 and then
Designation_String (Designation_String'First) /= '_' and then
Designation_String (Designation_String'First) /= ':' and then
Designation_String (Designation_String'Last) /= ':' and then
(for all C of Designation_String => C in 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | ':' );
subtype Description_String is String with Dynamic_Predicate =>
Description_String'Length <= Max_Description_Length;