diff --git a/index/alire-index-adayaml.ads b/index/alire-index-adayaml.ads index 43d8204b..7e2b1b6c 100644 --- a/index/alire-index-adayaml.ads +++ b/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"; diff --git a/src/alire-index.adb b/src/alire-index.adb index f66f2b00..d1864574 100644 --- a/src/alire-index.adb +++ b/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; diff --git a/src/alire-index.ads b/src/alire-index.ads index 0df7d11c..ad3fc4a5 100644 --- a/src/alire-index.ads +++ b/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); diff --git a/src/alire-utils.adb b/src/alire-utils.adb index 48b60f6e..7b9a28c7 100644 --- a/src/alire-utils.adb +++ b/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 -- ---------- diff --git a/src/alire-utils.ads b/src/alire-utils.ads index a82ba4aa..87b63aef 100644 --- a/src/alire-utils.ads +++ b/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 diff --git a/src/alire.ads b/src/alire.ads index fa5e2f27..deae4074 100644 --- a/src/alire.ads +++ b/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));