From 7cb2298589f01ed144220ccafbce654e62170439 Mon Sep 17 00:00:00 2001 From: "Alejandro R. Mosteo" Date: Sat, 24 Mar 2018 19:26:05 +0100 Subject: [PATCH] Testing of variants --- src/alire-boolean_trees.adb | 20 ++++++++++++-- src/alire-boolean_trees.ads | 6 ++--- src/alire-containers.adb | 11 ++++++++ src/alire-containers.ads | 4 ++- src/alire-index.adb | 6 ++--- {index => src}/alire-projects.ads | 31 +++++++++++++++++++++ src/alire-releases.adb | 45 ++++++++++++++++--------------- src/alire-releases.ads | 39 +++++++++++---------------- src/alire-roots.ads | 2 +- src/alire.ads | 8 ++++++ 10 files changed, 115 insertions(+), 57 deletions(-) rename {index => src}/alire-projects.ads (81%) diff --git a/src/alire-boolean_trees.adb b/src/alire-boolean_trees.adb index d918c88d..eb487ce6 100644 --- a/src/alire-boolean_trees.adb +++ b/src/alire-boolean_trees.adb @@ -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"; ----------- diff --git a/src/alire-boolean_trees.ads b/src/alire-boolean_trees.ads index 8526f009..6e21cb96 100644 --- a/src/alire-boolean_trees.ads +++ b/src/alire-boolean_trees.ads @@ -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)); diff --git a/src/alire-containers.adb b/src/alire-containers.adb index fb669774..f74b8a2f 100644 --- a/src/alire-containers.adb +++ b/src/alire-containers.adb @@ -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 -- ------------ diff --git a/src/alire-containers.ads b/src/alire-containers.ads index daec5857..444a8556 100644 --- a/src/alire-containers.ads +++ b/src/alire-containers.ads @@ -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; diff --git a/src/alire-index.adb b/src/alire-index.adb index d8502fbc..3a148249 100644 --- a/src/alire-index.adb +++ b/src/alire-index.adb @@ -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, diff --git a/index/alire-projects.ads b/src/alire-projects.ads similarity index 81% rename from index/alire-projects.ads rename to src/alire-projects.ads index 32760e9e..145b87bc 100644 --- a/index/alire-projects.ads +++ b/src/alire-projects.ads @@ -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; diff --git a/src/alire-releases.adb b/src/alire-releases.adb index 51ee6016..09e1cc90 100644 --- a/src/alire-releases.adb +++ b/src/alire-releases.adb @@ -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, diff --git a/src/alire-releases.ads b/src/alire-releases.ads index 3ce6ee2d..e5f78782 100644 --- a/src/alire-releases.ads +++ b/src/alire-releases.ads @@ -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 diff --git a/src/alire-roots.ads b/src/alire-roots.ads index 7a36df09..d18eaaa0 100644 --- a/src/alire-roots.ads +++ b/src/alire-roots.ads @@ -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); diff --git a/src/alire.ads b/src/alire.ads index 15b5e61f..51290449 100644 --- a/src/alire.ads +++ b/src/alire.ads @@ -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;