Playing with variants

This commit is contained in:
Alejandro R Mosteo
2018-03-23 18:02:13 +01:00
parent 3e795d908d
commit 0cee770a16
7 changed files with 229 additions and 79 deletions
+15 -3
View File
@@ -15,14 +15,12 @@ package Alire.Index.AdaYaml is
Git (Prj_Repo, "2017a7c2523499c03b8d7fe06546a5a8bae6476d"),
Dependencies =>
AUnit.Project >= AUnit.V_2017 and
DAK_Components.Components_Connections_V_4_27.Within_Major,
AUnit.Project >= AUnit.V_2017,
Properties =>
Project_File ("yaml.gpr") and
Project_File ("yaml-utils.gpr") and
Project_File ("yaml-annotation_processor.gpr") and
Project_File ("yaml-server.gpr") and
GPR_Scenario ("Mode", "debug" or "release") and
@@ -37,6 +35,20 @@ package Alire.Index.AdaYaml is
Executable ("yaml-parser-harness")
);
Server_V_0_3 : constant Release :=
Project.Register
(Parent => V_0_3,
Variant => "server",
Notes => "Server component",
Dependencies =>
DAK_Components.Components_Connections_V_4_27.Within_Major,
Properties =>
Project_File ("yaml-server.gpr") and
Executable ("server")
);
V_0_2 : constant Release :=
Project.Register
(V ("0.2"),
+56 -19
View File
@@ -96,6 +96,24 @@ package body Alire.Index is
-- Register --
--------------
function Register (C : Catalog_Entry; R : Release) return Release is
begin
Master_Entries.Include (R.Name, C);
-- Only once would be optimal, but we cannot do that any other way I can think of
if Catalog.Contains (R) then
Trace.Error ("Attempt to register duplicate versions: " & R.Milestone.Image);
else
Catalog.Insert (R);
end if;
return R;
end Register;
--------------
-- Register --
--------------
function Register (-- Mandatory
Project : Catalog_Entry;
Version : Semantic_Versioning.Version;
@@ -111,27 +129,46 @@ package body Alire.Index is
return Release
is
pragma Unreferenced (XXXXXXXXXXXXXX);
use all type Alire.Properties.Labeled.Labels;
begin
Master_Entries.Include (Project.Name, Project);
-- Only once would be optimal, but we cannot do that any other way I can think of
return Register
(Project,
Alire.Releases.New_Release
(Project.Name,
Version,
Origin,
Notes,
Dependencies,
Properties => Properties,
Private_Properties => Private_Properties,
Available => Available_When));
end Register;
return Rel : constant Alire.Releases.Release :=
Alire.Releases.New_Release (Project.Name,
Version,
Origin,
Notes,
Dependencies,
Properties => Properties,
Private_Properties => Private_Properties,
Available => Available_When)
do
if Catalog.Contains (Rel) then
Trace.Error ("Attempt to register duplicate versions: " & Rel.Milestone.Image);
else
Catalog.Insert (Rel);
end if;
end return;
--------------
-- Register --
--------------
function Register (-- Mandatory
Project : Catalog_Entry;
-- we force naming beyond this point with this ugly guard:
XXXXXXXXXXXXXX : Utils.XXX_XXX := Utils.XXX_XXX_XXX;
Parent : Release;
Variant : Name_String;
Notes : Description_String; -- Mandatory for subrelease
Dependencies : Release_Dependencies := No_Dependencies;
Properties : Release_Properties := No_Properties;
Private_Properties : Release_Properties := No_Properties;
Available_When : Release_Requisites := No_Requisites)
return Release
is
pragma Unreferenced (XXXXXXXXXXXXXX);
begin
return Register (Project,
Parent.New_Child (Variant => Variant,
Notes => Notes,
Dependencies => Dependencies,
Properties => Properties,
Private_Properties => Private_Properties,
Available => Available_When));
end Register;
------------
+18
View File
@@ -83,6 +83,24 @@ package Alire.Index is
-- Properties are generally interesting to the user
-- Private_Properties are only interesting to alr
function Register (-- Mandatory
Project : Catalog_Entry;
-- we force naming beyond this point with this ugly guard:
XXXXXXXXXXXXXX : Utils.XXX_XXX := Utils.XXX_XXX_XXX;
Parent : Release;
Variant : Name_String;
Notes : Description_String; -- Mandatory for subrelease
Dependencies : Release_Dependencies := No_Dependencies;
Properties : Release_Properties := No_Properties;
Private_Properties : Release_Properties := No_Properties;
Available_When : Release_Requisites := No_Requisites)
return Release;
-- Register a subrelease
-- A subrelease is a secondary project in the same commit as its parent release
-- Essentially, another project file with additional properties/dependencies
-- A subrelease name is parent:name (e.g.: adayaml:server)
-- It inherits all properties (including project files)
function Bypass (-- Mandatory
Project : Catalog_Entry;
Version : Semantic_Versioning.Version;
+79 -12
View File
@@ -12,9 +12,74 @@ package body Alire.Releases is
use all type Properties.Labeled.Labels;
--------------------
-- All_Properties --
--------------------
function All_Properties (R : Release) return Conditional.Properties is
(R.Properties and R.Priv_Props);
---------------
-- New_Child --
---------------
function New_Child (Parent : Release;
Variant : Name_String;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release
is
use Conditional.For_Dependencies;
use Conditional.For_Properties;
use Requisites.Trees;
begin
return Solid : constant Release (Variant'Length, Notes'Length) :=
(Variant_Len => Variant'Length,
Notes_Len => Notes'Length,
Name => Parent.Name,
Variant => Variant,
Version => Parent.Version,
Origin => Parent.Origin,
Notes => Notes,
Dependencies => Parent.Dependencies and Dependencies,
Properties => Parent.Properties and Properties,
Priv_Props => Parent.Priv_Props and Private_Properties,
Available => Parent.Available and Available)
do
null;
end return;
end New_Child;
-----------------
-- New_Release --
-----------------
function New_Release (Name : Projects.Names;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
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
(if Notes /= ""
then Comment (notes)
else Conditional.For_Properties.Empty) and
Properties,
Private_Properties,
Available);
----------------------------
-- On_Platform_Properties --
----------------------------
@@ -292,18 +357,20 @@ package body Alire.Releases is
function Whenever (R : Release; P : Properties.Vector) return Release is
begin
return Solid : constant Release (R.Descr_Len) :=
(R.Descr_Len,
R.Name,
R.Version,
R.Origin,
R.Notes,
R.Dependencies.Evaluate (P),
R.Properties.Evaluate (P),
R.Priv_Props.Evaluate (P),
(if R.Available.Check (P)
then Requisites.Booleans.Always_True
else Requisites.Booleans.Always_False))
return Solid : constant Release (0, R.Notes_Len) :=
(Variant_Len => 0,
Notes_Len => R.Notes_Len,
Name => R.Name,
Variant => R.Variant,
Version => R.Version,
Origin => R.Origin,
Notes => R.Notes,
Dependencies => R.Dependencies.Evaluate (P),
Properties => R.Properties.Evaluate (P),
Priv_Props => R.Priv_Props.Evaluate (P),
Available => (if R.Available.Check (P)
then Requisites.Booleans.Always_True
else Requisites.Booleans.Always_False))
do
null;
end return;
+43 -45
View File
@@ -26,15 +26,31 @@ package Alire.Releases with Preelaborate is
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release;
function New_Child (Parent : Release;
Variant : Name_String;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release;
function "<" (L, R : Release) return Boolean;
function Whenever (R : Release; P : Properties.Vector) return Release;
-- Materialize conditions in a Release once the whatever properties are known
-- At present dependencies and properties
function Name (R : Release) return Projects.Names;
function Project (R : Release) return Name_String;
function Notes (R : Release) return Description_String; -- Specific to release
function Name (R : Release) return Projects.Names;
function Name_Colon_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
function Version (R : Release) return Semantic_Versioning.Version;
function Description (R : Release) return Description_String;
@@ -115,11 +131,12 @@ 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 (Descr_Len : Natural) is new Versions.Versioned with record
type Release (Variant_Len, Notes_Len : Natural) is new Versions.Versioned with record
Name : Projects.Names;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Notes : Description_String (1 .. Descr_Len);
Variant : Name_String (1 .. Variant_Len);
Notes : Description_String (1 .. Notes_Len);
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Priv_Props : Conditional.Properties;
@@ -127,39 +144,31 @@ private
end record;
use all type Conditional.Properties;
function New_Release (Name : Projects.Names;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Notes : Description_String;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release is
(Notes'Length,
Name,
Version,
Origin,
Notes,
Dependencies,
Describe (Projects.Description (Name)) and
(if Notes /= ""
then Comment (notes)
else Conditional.For_Properties.Empty) and
Properties,
Private_Properties,
Available);
function "<" (L, R : Release) return Boolean is
(L.Name < R.Name or else
(L.Name = R.Name and then
(L.Name_Colon_Variant < R.Name_Colon_Variant or else
(L.Name_Colon_Variant = R.Name_Colon_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 Project (R : Release) return Name_String is (Projects.Image (R.Name));
function Name (R : Release) return Projects.Names is (R.Name);
function Name_Colon_Variant (R : Release) return String is
(Projects.Image (R.Name) &
(if R.Is_Variant
then ":" & R.Variant
else ""));
function Name_Variant (R : Release) return String is
(Projects.Image (R.Name) &
(if R.Is_Variant
then "_" & R.Variant
else ""));
function Is_Variant (R : Release) return Boolean is (R.Variant_Len > 0);
function Description (R : Release) return Description_String is (Projects.Description (R.Name));
function Notes (R : Release) return Description_String is (R.Notes);
@@ -176,28 +185,17 @@ private
(Milestones.New_Milestone (R.Name, R.Version));
function Default_Executable (R : Release) return String is
(R.Project & OS_Lib.Exe_Suffix);
(R.Name_Variant & OS_Lib.Exe_Suffix);
use all type Origins.Kinds;
function Image (R : Release) return Folder_String is
(R.Project & "_" &
Image (R.Version) & "_" &
(Image (R.Name) & "_" &
Image (R.Version) & "_" &
(case R.Origin.Kind is
when Filesystem => "filesystem",
when Native => "native",
when Git | Hg => (if R.Origin.Commit'Length <= 8
then R.Origin.Commit
else R.Origin.Commit (R.Origin.Commit'First .. R.Origin.Commit'First + 7))));
-- Dependency helpers
-- function On (Name : Projects.Names;
-- Versions : Semantic_Versioning.Version_Set)
-- 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 Conditional.Dependencies is
-- (On (R.Name, Condition (R.Version)));
end Alire.Releases;
+16
View File
@@ -41,6 +41,22 @@ package body Alire.Utils is
return Flatten (1, V);
end Flatten;
-------------
-- Replace --
-------------
function Replace (Text : String; Match : String; Subst : String) return String is
use Ada.Strings.Fixed;
First : Natural;
begin
First := Index (Text, Match);
if First = 0 then
return Text;
else
return Replace (Replace_Slice (Text, First, First + Match'Length - 1, Subst), Match, Subst);
end if;
end Replace;
----------
-- Tail --
----------
+2
View File
@@ -16,6 +16,8 @@ package Alire.Utils with Preelaborate is
-- If Str contains Separator, the rhs is returned
-- Otherwise ""
function Replace (Text : String; Match : String; Subst : String) return String;
generic
with package Vectors is new Ada.Containers.Indefinite_Vectors (<>);
type Vector is new Vectors.Vector with private;