Preparations for full use of "reflection" (source_info)

index/alire-index-adayaml.ads

@@ -7,7 +7,7 @@ package Alire.Index.AdaYaml is
                                                "Experimental YAML 1.3 implementation in Ada");
 
    function Server is new Extension (Base        => Project,
-                                     Name        => "server",
+                                     X_Name        => "server",
                                      Description => "Server component");
 
    Prj_Repo       : constant URL    := "https://github.com/yaml/AdaYaml.git";

src/alire-index.adb

@@ -2,6 +2,8 @@ with Ada.Containers.Indefinite_Ordered_Maps;
 
 with Alire.Projects;
 
+with GNAT.Source_Info;
+
 package body Alire.Index is
 
    use all type Version;
@@ -16,16 +18,21 @@ package body Alire.Index is
    ------------------------
 
    function Catalogued_Project return Catalog_Entry is
+      use Utils;
+      Enclosing : constant String := GNAT.Source_Info.Enclosing_Entity;
+      Self_Name : constant String := Split (Enclosing, '.', Side => Tail, From => Tail);
+      Full_Name : constant String := Split (Enclosing, '.', Side => Tail, From => Head, Count => 2);
+      Pack_Name : constant String := Split (Full_Name, '.', Side => Head, From => Tail);
    begin
-      return C : constant Catalog_Entry := (Name_Len  => Project'Length,
+      return C : constant Catalog_Entry := (Name_Len  => Pack_Name'Length,
                                             Descr_Len => Description'Length,
-                                            Pack_Len  => Package_Name'Length,
-                                            Self_Len  => String'("Project")'Length,
+                                            Pack_Len  => Pack_Name'Length,
+                                            Self_Len  => Self_Name'Length,
 
-                                            Project      => Project,
+                                            Project      => +To_Lower_Case (Pack_Name),
                                             Description  => Description,
-                                            Package_Name => Package_Name,
-                                            Self_Name    => "Project")
+                                            Package_Name => Pack_Name,
+                                            Self_Name    => Self_Name)
       do
          if First_Use.all then
             First_Use.all := False;
@@ -41,16 +48,26 @@ package body Alire.Index is
    ---------------
 
    function Extension return Catalog_Entry is
+      use Utils;
+      Enclosing : constant String := GNAT.Source_Info.Enclosing_Entity;
+      Self_Name : constant String := Split (Enclosing, '.', Side => Tail, From => Tail);
+      Full_Name : constant String := Split (Enclosing, '.', Side => Tail, From => Head, Count => 2);
+      Pack_Name : constant String := Split (Full_Name, '.', Side => Head, From => Tail);
    begin
-      return C : constant Catalog_Entry := (Name_Len => Name'Length + Base.Project'Length + 1,
+--        Trace.Always ("Encl: " & GNAT.Source_Info.Enclosing_Entity);
+--        Trace.Always ("self: " & Self_Name);
+--        Trace.Always ("full: " & Full_Name);
+--        Trace.Always ("pack: " & Pack_Name);
+      return C : constant Catalog_Entry := (Name_Len  => Self_Name'Length + Base.Project'Length + 1,
                                             Descr_Len => Description'Length,
-                                            Pack_Len => Base.Package_Name'Length,
-                                            Self_Len => Ada_Identifier'Length,
+                                            Pack_Len  => Pack_Name'Length,
+                                            Self_Len  => Self_Name'Length,
 
-                                            Project      => Base.Project & Extension_Separator & Name,
+                                            Project      =>
+                                              +To_Lower_Case ((+Base.Project) & Extension_Separator & Self_Name),
                                             Description  => Description,
-                                            Package_Name => Base.Package_Name,
-                                            Self_Name    => Ada_Identifier)
+                                            Package_Name => Pack_Name,
+                                            Self_Name    => Self_Name)
       do
          if First_Use.all then
             First_Use.all := False;

src/alire-index.ads

@@ -35,9 +35,9 @@ package Alire.Index is
    --  Used to force the declaration of a single variable to refer to a project in index specs
    
    generic
-      Project      : Alire.Project;
+      X_Project      : Alire.Project;
       Description  : Description_String;
-      Package_Name : String := +Project; -- Override if not matching
+      X_Package_Name : String := +X_Project; -- Override if not matching
 
       --  For internal use:
       First_Use    : access Boolean := new Boolean'(True);
@@ -46,9 +46,9 @@ package Alire.Index is
    
    generic
       with function Base return Catalog_Entry;
-      Name           : Alire.Project;
+      X_Name           : Alire.Project;
       Description    : Description_String;
-      Ada_Identifier : String := +Name;
+      X_Ada_Identifier : String := +X_Name;
       
       --  For internal use
       First_Use    : access Boolean := new Boolean'(True);

src/alire-utils.adb

@@ -60,6 +60,46 @@ package body Alire.Utils is
       end if;
    end Replace;
 
+   -----------
+   -- Split --
+   -----------
+
+   function Split (Text      : String;
+                   Separator : Character;
+                   Side      : Halves := Head;
+                   From      : Halves := Head;
+                   Count     : Positive := 1;
+                   Raises    : Boolean  := True) return String
+   is
+      Seen : Natural := 0;
+      Pos  : Integer := (if From = Head then Text'First else Text'Last);
+      Inc  : constant Integer := (if From = Head then 1 else -1);
+   begin
+      loop
+         if Text (Pos) = Separator then
+            Seen := Seen + 1;
+
+            if Seen = Count then
+               if Side = Head then
+                  return Text (Text'First .. Pos - 1);
+               else
+                  return Text (Pos + 1 .. Text'Last);
+               end if;
+            end if;
+         end if;
+
+         Pos := Pos + Inc;
+
+         exit when Pos not in Text'Range;
+      end loop;
+
+      if Raises then
+         raise Constraint_Error with "Not enought separators found";
+      else
+         return Text;
+      end if;
+   end Split;
+
    ----------
    -- Tail --
    ----------

src/alire-utils.ads

@@ -18,6 +18,18 @@ package Alire.Utils with Preelaborate is
 
    function Replace (Text : String; Match : String; Subst : String) return String;
 
+   type Halves is (Head, Tail);
+
+   function Split (Text      : String;
+                   Separator : Character;
+                   Side      : Halves := Head;
+                   From      : Halves := Head;
+                   Count     : Positive := 1;
+                   Raises    : Boolean  := True) return String;
+   --  Split in two at seeing Count times the separator
+   --  Start the search according to From, and return Side at that point
+   --  If not enough separators are seen then raises or whole string
+
    function To_Native (Path : Platform_Independent_Path) return String;
 
    generic

src/alire.ads

@@ -19,9 +19,9 @@ package Alire with Preelaborate is
    type Project is new String with Dynamic_Predicate =>
      Project'Length >= Min_Name_Length and then
      Project (Project'First) /= '_' and then
-     Project (Project'First) /= ':' and then
-     Project (Project'Last) /= ':' and then
-     (for all C of Project => C in 'a' .. 'z' | '0' .. '9' | '_' | '.' );
+     Project (Project'First) /= Extension_Separator and then
+     Project (Project'Last) /= Extension_Separator and then
+     (for all C of Project => C in 'a' .. 'z' | '0' .. '9' | '_' | Extension_Separator);
 
    function "+" (P : Project) return String  is (String (P));
    function "+" (P : String)  return Project is (Project (P));