diff --git a/index/alire-index-adayaml.ads b/index/alire-index-adayaml.ads index ae6fbfd5..b6c1269d 100644 --- a/index/alire-index-adayaml.ads +++ b/index/alire-index-adayaml.ads @@ -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"), diff --git a/src/alire-index.adb b/src/alire-index.adb index 8fec308a..d8502fbc 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -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; ------------ diff --git a/src/alire-index.ads b/src/alire-index.ads index 0df2dc6f..46e145c7 100644 --- a/src/alire-index.ads +++ b/src/alire-index.ads @@ -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; diff --git a/src/alire-releases.adb b/src/alire-releases.adb index 6c61b763..51ee6016 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -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; diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 7c21dc42..3ce6ee2d 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -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; diff --git a/src/alire-utils.adb b/src/alire-utils.adb index 135bdad8..b3d419ed 100644 --- a/src/alire-utils.adb +++ b/src/alire-utils.adb @@ -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 -- ---------- diff --git a/src/alire-utils.ads b/src/alire-utils.ads index 69a4e9d1..68f480c6 100644 --- a/src/alire-utils.ads +++ b/src/alire-utils.ads @@ -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;