Private properties

This commit is contained in:
Alejandro R. Mosteo
2018-03-07 22:02:08 +01:00
parent 251ba54ba8
commit 19f9e78114
4 changed files with 57 additions and 53 deletions
+11 -28
View File
@@ -43,48 +43,31 @@ package body Alire.Index is
--------------
function Register (-- Mandatory
Project : Project_Name;
Version : Semantic_Versioning.Version;
Description : Project_Description;
Origin : Origins.Origin;
Project : Project_Name;
Version : Semantic_Versioning.Version;
Description : Project_Description;
Origin : Origins.Origin;
-- Barrier
XXXXXXXXXXXXXX : Utils.XXX_XXX := Utils.XXX_XXX_XXX;
XXXXXXXXXXXXXX : Utils.XXX_XXX := Utils.XXX_XXX_XXX;
-- Optional
Dependencies : Release_Dependencies := No_Dependencies;
Properties : Release_Properties := No_Properties;
Dependencies : Release_Dependencies := No_Dependencies;
Properties : Release_Properties := No_Properties;
Private_Properties : Build_Properties := No_Properties;
Available_When : Alire.Requisites.Tree := No_Requisites)
Available_When : Alire.Requisites.Tree := No_Requisites)
return Release
is
pragma Unreferenced (XXXXXXXXXXXXXX);
use all type Alire.Properties.Labeled.Labels;
begin
-- Until the user/internal properties settle, we'll keep these checks off
-- for P of Properties.All_Values loop
-- if P in Alire.Properties.Labeled.Label and then
-- Alire.Properties.Labeled.Label (P).Name = GPR_Config
-- then
-- raise Program_Error with "alr property given as user property";
-- end if;
-- end loop;
--
-- for P of Private_Properties.All_Values loop
-- if P not in Alire.Properties.Labeled.Label and then
-- Alire.Properties.Labeled.Label (P).Name /= GPR_Config
-- then
-- raise Program_Error with "user property given as alr property";
-- end if;
-- end loop;
return Rel : constant Alire.Releases.Release :=
Alire.Releases.New_Release (Project,
Description,
Version,
Origin,
Dependencies,
Properties => Private_Properties and Properties,
Available => Available_When)
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);
+19 -8
View File
@@ -9,12 +9,15 @@ package body Alire.Releases is
use all type Properties.Labeled.Labels;
function All_Properties (R : Release) return Conditional.Properties is
(R.Properties and R.Priv_Props);
----------------------------
-- On_Platform_Properties --
----------------------------
function On_Platform_Properties (R : Release; P : Properties.Vector) return Properties.Vector is
(R.Properties.Evaluate (P));
(R.Properties.Evaluate (P) and R.Priv_Props.Evaluate (P));
------------
-- Values --
@@ -44,9 +47,10 @@ package body Alire.Releases is
function Executables (R : Release;
P : Properties.Vector)
return Utils.String_Vector is
return Utils.String_Vector
is
begin
return Exes : Utils.String_Vector := Values (R.Properties.Evaluate (P), Executable) do
return Exes : Utils.String_Vector := Values (R.All_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;
@@ -63,7 +67,7 @@ package body Alire.Releases is
P : Properties.Vector)
return Utils.String_Vector is
begin
return Files : Utils.String_Vector := Values (R.Properties.Evaluate (P), GPR_File) do
return Files : Utils.String_Vector := Values (R.All_Properties.Evaluate (P), GPR_File) do
if Files.Is_Empty then
Files.Append (R.Project & ".gpr");
end if;
@@ -78,7 +82,7 @@ package body Alire.Releases is
P : Properties.Vector)
return Utils.String_Vector is
begin
return Files : Utils.String_Vector := Values (R.Properties.Evaluate (P), Project_File) do
return Files : Utils.String_Vector := Values (R.All_Properties.Evaluate (P), Project_File) do
if Files.Is_Empty then
Files.Append (R.Project & ".gpr");
end if;
@@ -95,7 +99,7 @@ package body Alire.Releases is
return Utils.String_Vector
is
begin
return Values (R.Properties.Evaluate (P), Label);
return Values (R.All_Properties.Evaluate (P), Label);
end Labeled_Properties;
-----------------------
@@ -140,7 +144,7 @@ package body Alire.Releases is
-- Print --
-----------
procedure Print (R : Release) is
procedure Print (R : Release; Private_Too : Boolean := False) is
use GNAT.IO;
procedure Print_Propvec (Prefix : String; V : Properties.Vector) is
@@ -192,6 +196,12 @@ package body Alire.Releases is
Print_Properties (" ", R.Properties);
end if;
-- PRIVATE PROPERTIES
if Private_Too and then not R.Properties.Is_Empty then
Put_Line ("Private properties:");
Print_Properties (" ", R.Priv_Props);
end if;
-- DEPENDENCIES
if not R.Dependencies.Is_Empty then
Put_Line ("Dependencies (direct):");
@@ -208,7 +218,7 @@ package body Alire.Releases is
Search : constant String := To_Lower_Case (Str);
begin
for P of R.Properties.All_Values loop
for P of R.All_Properties.All_Values loop
declare
Text : constant String :=
To_Lower_Case
@@ -239,6 +249,7 @@ package body Alire.Releases is
R.Origin,
R.Dependencies.Evaluate (P),
R.Properties.Evaluate (P),
R.Priv_Props.Evaluate (P),
R.Available)
do
null;
+24 -15
View File
@@ -16,13 +16,14 @@ package Alire.Releases with Preelaborate is
type Release (<>) is tagged private;
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release;
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release;
function "<" (L, R : Release) return Boolean;
@@ -67,6 +68,9 @@ package Alire.Releases with Preelaborate is
-- Unique string built as name_version_id
function Unique_Folder (R : Release) return Folder_String renames Image;
-- NOTE: property retrieval functions do not distinguish between public/private, since that's
-- merely informative for the users
function On_Platform_Properties (R : Release; P : Properties.Vector) return Properties.Vector;
-- Return properties that apply to R under platform properties P
@@ -76,7 +80,7 @@ package Alire.Releases with Preelaborate is
function Milestone (R : Release) return Milestones.Milestone;
procedure Print (R : Release);
procedure Print (R : Release; Private_Too : Boolean := False);
-- Dump info to console
-- Search helpers
@@ -105,6 +109,8 @@ package Alire.Releases with Preelaborate is
private
function All_Properties (R : Release) return Conditional.Properties;
function Unavailable return Conditional.Dependencies is
(On ("alire_unavailable", Semantic_Versioning.Any));
@@ -118,18 +124,20 @@ private
Origin : Origins.Origin;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Priv_Props : Conditional.Properties;
Available : Requisites.Tree;
end record;
use all type Conditional.Properties;
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release is
function New_Release (Name : Project_Name;
Description : Project_Description;
Version : Semantic_Versioning.Version;
Origin : Origins.Origin;
Dependencies : Conditional.Dependencies;
Properties : Conditional.Properties;
Private_Properties : Conditional.Properties;
Available : Alire.Requisites.Tree) return Release is
(Name'Length, Description'Length,
Name,
Description,
@@ -137,6 +145,7 @@ private
Origin,
Dependencies,
Describe (Description) and Properties,
Private_Properties,
Available);
use Semantic_Versioning;
+3 -2
View File
@@ -45,8 +45,9 @@ package body Alire.Root_Project is
Version,
New_Filesystem (Ada.Directories.Current_Directory),
Dependencies,
Properties => Index.No_Properties,
Available => Requisites.No_Requisites);
Properties => Index.No_Properties,
Private_Properties => Index.No_Properties,
Available => Requisites.No_Requisites);
begin
if Index.Exists (Project, Version) then
-- This is done to ensure that properties are all available