GPR scenarios

index/alire-index-dak.ads

@@ -28,6 +28,9 @@ package Alire.Index.DAK is
                                   GPR_File ("strings_edit.gpr") and
                                   GPR_File ("test_strings_edit" / "strings_edit-test.gpr") and
 
+                                  GPR_Scenario ("Legacy", "Ada95" or "Ada2005" or "Ada2012") and
+                                  GPR_Scenario ("Development", "Debug" or "Release") and
+
                                   Executable ("test_base64") and
                                   Executable ("test_strings_edit") and
                                   Executable ("test_string_streams") and
@@ -47,6 +50,9 @@ package Alire.Index.DAK is
                                   GPR_File ("tables.gpr") and
                                   GPR_File ("test_tables" / "tables-test.gpr") and
 
+                                  GPR_Scenario ("Legacy", "Ada95" or "Ada2005" or "Ada2012") and
+                                  GPR_Scenario ("Development", "Debug" or "Release") and
+
                                   Executable ("test_tables") and
 
                                   License  (GMGPL_2_0) and
@@ -67,6 +73,10 @@ package Alire.Index.DAK is
                                       GPR_File ("components.gpr") and
                                       GPR_File ("test_components" / "components-tests.gpr") and
 
+                                      GPR_Scenario ("Atomic_Access", "Pragma-atomic" or "GCC-built-ins" or "GCC-long-offsets") and
+                                      GPR_Scenario ("Tasking", "Multiple" or "Single") and
+                                      GPR_Scenario ("Traced_objects", "Off" or "On") and
+
                                       License  (GMGPL_2_0) and
                                       Author   (DAK_Author) and
                                       Website  (DAK_Website) and

index/alire-index-simple_logging.ads

@@ -7,8 +7,8 @@ package Alire.Index.Simple_Logging is
 
    V_1 : constant Release :=
            Register (Name,
-                     V ("1.0.1"),
+                     V ("1.0.0"),
                      Desc,
-                     Git (Repo, "0d5ab8764f667107892a0c832a7a70a2c6b7efe2"));
+                     Git (Repo, "d98242b8bd1c7f964cebc454e9b1206ffdbb0ca9"));
 
 end Alire.Index.Simple_Logging;

src/alire-gpr.adb

@@ -0,0 +1,64 @@
+package body Alire.GPR is
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (V : Variable) return String is
+
+      function Listify (Vals : Value_Vector) return String is
+         Head : constant String := Vals.First_Element;
+         Tail : Value_Vector := Vals;
+      begin
+         Tail.Delete_First;
+
+         return Head &
+         (if Tail.Is_Empty
+          then ""
+          else " | " & Listify (Tail));
+      end Listify;
+
+   begin
+      if V.Kind = Free_String then
+         return V.Name & " = <string>";
+      else
+         return V.Name & " = " & Listify (V.Values);
+      end if;
+   end Image;
+
+   ------------------
+   -- Add_Argument --
+   ------------------
+
+   procedure Add_Argument (S : in out Scenario; Var : String; Val : String) is
+   begin
+      S.Append (Var);
+      S.Append (Val);
+   end Add_Argument;
+
+   ---------------------
+   -- As_Command_Line --
+   ---------------------
+
+   function As_Command_Line (S : Scenario) return String is
+
+   -------------
+   -- Listify --
+   -------------
+
+      function Listify (S : Scenario) return String is
+         Var : constant String := S (1);
+         Val : constant String := S (2);
+         Cdr : Scenario := S;
+      begin
+         Cdr.Delete_First;
+         Cdr.Delete_First;
+         return "-X" & Var & "=" & Val &
+           (if Cdr.Is_Empty then "" else " " & Listify (Cdr));
+      end Listify;
+
+   begin
+      return (if S.Is_Empty then "" else Listify (S));
+   end As_Command_Line;
+
+end Alire.GPR;

src/alire-gpr.ads

@@ -0,0 +1,73 @@
+with Alire.Utils;
+
+package Alire.GPR with Preelaborate is
+
+   type Variable_Kinds is (Enumeration, Free_String);
+
+   type Variable (<>) is tagged private;
+
+   function Kind (V : Variable) return Variable_Kinds;
+
+   function Image (V : Variable) return String;
+
+   function Free_Variable (Name : String) return Variable;
+
+   subtype Value is String
+     with Dynamic_Predicate => (for all C of Value => C in 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_' | '-');
+
+   type Value_Vector is new Utils.String_Vector with null record;
+
+   function Enum_Variable (Name   : String;
+                           Values : Value_Vector'Class) return Variable;
+
+   function Values (V : Variable) return Value_Vector'Class
+     with Pre => V.Kind = Enumeration;
+
+   function "or" (L, R : Value) return Value_Vector;
+   function "or" (L : Value_Vector; R : Value) return Value_Vector;
+
+   --  A collection of Var=Arg conform a scenario:
+
+   type Scenario is tagged private;
+
+   Empty_Scenario : constant Scenario;
+
+   procedure Add_Argument (S : in out Scenario; Var : String; Val : String);
+
+   function As_Command_Line (S : Scenario) return String;
+   --  -Xvar1=val -Xvar2=val ...
+
+   function Is_Empty (S : Scenario) return Boolean;
+
+private
+
+   type Variable (Kind : Variable_Kinds; Name_Len : Positive) is tagged record
+      Name : String (1 .. Name_Len);
+      case Kind is
+         when Enumeration =>
+            Values : Value_Vector;
+         when Free_String =>
+            null;
+      end case;
+   end record;
+
+   function Kind (V : Variable) return Variable_Kinds is (V.Kind);
+
+   function Free_Variable (Name : String) return Variable is (Free_String, Name'Length, Name);
+
+   function Enum_Variable (Name   : String;
+                           Values : Value_Vector'Class) return Variable is
+      (Enumeration, Name'Length, Name, Value_Vector (Values));
+
+   function Values (V : Variable) return Value_Vector'Class is (V.Values);
+
+   function "or" (L, R : Value) return Value_Vector is (L & R);
+   function "or" (L : Value_Vector; R : Value) return Value_Vector is (L & R);
+
+   type Scenario is new Utils.String_Vector with null record;
+
+   function Is_Empty (S : Scenario) return Boolean is (Utils.String_Vector (S).Is_Empty);
+
+   Empty_Scenario : constant Scenario := (Utils.String_Vectors.Empty_Vector with null record);
+
+end Alire.GPR;

src/alire-index.ads

@@ -5,12 +5,14 @@ with Ada.Directories;
 with Alire.Containers;
 with Alire.Compilers;
 with Alire.Dependencies.Vectors;
+with Alire.GPR;
 with Alire.Licensing;
 with Alire.Operating_Systems;
 with Alire.Origins;
 with Alire.Properties;
 with Alire.Properties.Labeled;
 with Alire.Properties.Licenses;
+with Alire.Properties.Scenarios;
 with Alire.Releases;
 with Alire.Requisites;
 with Alire.Requisites.Platform;
@@ -89,6 +91,8 @@ package Alire.Index is
       
    use all type Alire.Dependencies.Vectors.Vector;
    use all type Compilers.Compilers;
+   use all type GPR.Value;
+   use all type GPR.Value_Vector;
    use all type Licensing.Licenses;
    use all type Operating_Systems.Operating_Systems;
    use all type Properties.Property'Class; 
@@ -100,6 +104,8 @@ package Alire.Index is
    function Author     is new Properties.Labeled.Generic_New_Label (Properties.Labeled.Author);   
    function Executable is new Properties.Labeled.Generic_New_Label (Properties.Labeled.Executable);
    function GPR_File   is new Properties.Labeled.Generic_New_Label (Properties.Labeled.GPR_File);
+   function GPR_Free_Scenario (Name : String) return Properties.Vector;
+   function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Properties.Vector;
    function Maintainer is new Properties.Labeled.Generic_New_Label (Properties.Labeled.Maintainer);
    function Website    is new Properties.Labeled.Generic_New_Label (Properties.Labeled.Website);
    
@@ -208,6 +214,13 @@ private
      (Properties.To_Vector (P, 1));
 
    function Requires (R : Requisites.Requisite'Class) return Requisites.Tree is
-      (Requisites.Trees.Leaf (R));
+     (Requisites.Trees.Leaf (R));
+   
+   -- Property builders
+   function GPR_Free_Scenario (Name : String) return Properties.Vector is
+      (+Properties.Scenarios.New_Variable (GPR.Free_Variable (Name)));
+   
+   function GPR_Scenario (Name : String; Values : GPR.Value_Vector) return Properties.Vector is
+      (+Properties.Scenarios.New_Variable (GPR.Enum_Variable (Name, Values)));
 
 end Alire.Index;

src/alire-properties-scenarios.ads

@@ -0,0 +1,27 @@
+with Alire.GPR;
+
+private with Ada.Containers.Indefinite_Holders;
+
+package Alire.Properties.Scenarios with Preelaborate is
+
+   type Variable is new Property with private;
+
+   function New_Variable (V : GPR.Variable) return Variable;
+
+   overriding function Image (V : Variable) return String;
+
+private
+
+   package Holders is new Ada.Containers.Indefinite_Holders (Gpr.Variable, GPR."=");
+
+   type Variable is new Property with record
+      Var : Holders.Holder;
+   end record;
+
+   function New_Variable (V : GPR.Variable) return Variable is
+      (Var => Holders.To_Holder (V));
+
+   overriding function Image (V : Variable) return String is
+      ("GPR Scenario: " & V.Var.Constant_Reference.Image);
+
+end Alire.Properties.Scenarios;

src/alire-utils.adb

@@ -11,6 +11,21 @@ package body Alire.Utils is
    function Contains (Text : String; Sub : String) return Boolean is
      (Ada.Strings.Fixed.Count (Text, Sub) > 0);
 
+   ----------
+   -- Head --
+   ----------
+
+   function Head (Str : String; Separator : Character) return String is
+   begin
+      for I in Str'Range loop
+         if Str (I) = Separator then
+            return Str (Str'First .. I - 1);
+         end if;
+      end loop;
+
+      return Str;
+   end Head;
+
    ----------
    -- Tail --
    ----------

src/alire-utils.ads

@@ -10,6 +10,10 @@ package Alire.Utils with Preelaborate is
    package String_Vectors is new Ada.Containers.Indefinite_Vectors (Positive, String);
    subtype String_Vector is String_Vectors.Vector;
 
+   function Head (Str : String; Separator : Character) return String;
+   --  if Str contains Separator, the lhs is returned
+   --  Otherwise Str is returned
+
    function Tail (Str : String; Separator : Character) return String;
    --  If Str contains Separator, the rhs is returned
    --  Otherwise ""