When a project A with naming exceptions in its package Naming is extended
by a project B with no package Naming, the naming exceptions are
inherited in project B. If there are source files in the source
directories of project B that correspond to the inherited naming
exceptions, these files are sources of project B.
Example:
project A is
package Naming is
for Body ("pkg2") use "pkg2.ada";
for Spec ("pkg2") use "pkg2_.ada";
end Naming;
end A;
project B extends "a/a.gpr" is
for Main use ("main.adb");
end B;
The files pkg2.ada and pkg_.ada need to be found in the source
directory of project A. If there are also files pkg2.ada and/or pkg2_.ada
in the source directory of project B, they are sources of B, so they
should be used when linking the executable.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-01 Vincent Celier <cel...@adacore.com>
* prj-proc.adb, prj.ads, prj-nmsc.adb, prj-util.adb, prj-util.ads,
prj-env.adb: Implement inheritance of naming exceptions in extending
projects.
Index: prj-proc.adb
===================================================================
--- prj-proc.adb (revision 178412)
+++ prj-proc.adb (working copy)
@@ -398,69 +398,62 @@
Arr := Shared.Arrays.Table (A1);
A1 := Arr.Next;
- if not Restricted
- or else
- (Arr.Name /= Snames.Name_Body and then
- Arr.Name /= Snames.Name_Spec and then
- Arr.Name /= Snames.Name_Implementation and then
- Arr.Name /= Snames.Name_Specification)
- then
- -- Remove the Next component
+ -- Remove the Next component
- Arr.Next := No_Array;
- Array_Table.Increment_Last (Shared.Arrays);
+ Arr.Next := No_Array;
+ Array_Table.Increment_Last (Shared.Arrays);
- -- Create new Array declaration
+ -- Create new Array declaration
- if To.Arrays = No_Array then
- To.Arrays := Array_Table.Last (Shared.Arrays);
- else
- Shared.Arrays.Table (A2).Next :=
- Array_Table.Last (Shared.Arrays);
- end if;
+ if To.Arrays = No_Array then
+ To.Arrays := Array_Table.Last (Shared.Arrays);
+ else
+ Shared.Arrays.Table (A2).Next :=
+ Array_Table.Last (Shared.Arrays);
+ end if;
- A2 := Array_Table.Last (Shared.Arrays);
+ A2 := Array_Table.Last (Shared.Arrays);
- -- Don't store the array as its first element has not been set yet
+ -- Don't store the array as its first element has not been set yet
- -- Copy the array elements of the array
+ -- Copy the array elements of the array
- E1 := Arr.Value;
- Arr.Value := No_Array_Element;
- while E1 /= No_Array_Element loop
+ E1 := Arr.Value;
+ Arr.Value := No_Array_Element;
+ while E1 /= No_Array_Element loop
- -- Copy the array element
+ -- Copy the array element
- Elm := Shared.Array_Elements.Table (E1);
- E1 := Elm.Next;
+ Elm := Shared.Array_Elements.Table (E1);
+ E1 := Elm.Next;
- -- Remove the Next component
+ -- Remove the Next component
- Elm.Next := No_Array_Element;
+ Elm.Next := No_Array_Element;
- -- Change the location
+ Elm.Restricted := Restricted;
+ -- Change the location
- Elm.Value.Location := New_Loc;
- Array_Element_Table.Increment_Last (Shared.Array_Elements);
+ Elm.Value.Location := New_Loc;
+ Array_Element_Table.Increment_Last (Shared.Array_Elements);
- -- Create new array element
+ -- Create new array element
- if Arr.Value = No_Array_Element then
- Arr.Value :=
- Array_Element_Table.Last (Shared.Array_Elements);
- else
- Shared.Array_Elements.Table (E2).Next :=
- Array_Element_Table.Last (Shared.Array_Elements);
- end if;
+ if Arr.Value = No_Array_Element then
+ Arr.Value :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ else
+ Shared.Array_Elements.Table (E2).Next :=
+ Array_Element_Table.Last (Shared.Array_Elements);
+ end if;
- E2 := Array_Element_Table.Last (Shared.Array_Elements);
- Shared.Array_Elements.Table (E2) := Elm;
- end loop;
+ E2 := Array_Element_Table.Last (Shared.Array_Elements);
+ Shared.Array_Elements.Table (E2) := Elm;
+ end loop;
- -- Finally, store the new array
+ -- Finally, store the new array
- Shared.Arrays.Table (A2) := Arr;
- end if;
+ Shared.Arrays.Table (A2) := Arr;
end loop;
end Copy_Package_Declarations;
@@ -1940,6 +1933,7 @@
Shared.Array_Elements.Table
(Elem) :=
(Index => Index_Name,
+ Restricted => False,
Src_Index => Source_Index,
Index_Case_Sensitive =>
not Case_Insensitive (Current, Node_Tree),
Index: prj.ads
===================================================================
--- prj.ads (revision 178407)
+++ prj.ads (working copy)
@@ -187,6 +187,7 @@
No_Array_Element : constant Array_Element_Id := 0;
type Array_Element is record
Index : Name_Id;
+ Restricted : Boolean := False;
Src_Index : Int := 0;
Index_Case_Sensitive : Boolean := True;
Value : Variable_Value;
@@ -679,6 +680,8 @@
-- corresponding to an Ada file). In general, these are dependencies that
-- cannot be computed automatically by the builder.
+ type Naming_Exception_Type is (No, Yes, Inherited);
+
-- Structure to define source data
type Source_Data is record
@@ -791,7 +794,7 @@
Switches_TS : Time_Stamp_Type := Empty_Time_Stamp;
-- Switches file time stamp
- Naming_Exception : Boolean := False;
+ Naming_Exception : Naming_Exception_Type := No;
-- True if the source has an exceptional name
Duplicate_Unit : Boolean := False;
@@ -840,7 +843,7 @@
Switches => No_File,
Switches_Path => No_Path,
Switches_TS => Empty_Time_Stamp,
- Naming_Exception => False,
+ Naming_Exception => No,
Duplicate_Unit => False,
Next_In_Lang => No_Source,
Next_With_File_Name => No_Source,
@@ -864,14 +867,6 @@
Equal => "=");
-- Mapping of source paths to source ids
- package Unit_Sources_Htable is new Simple_HTable
- (Header_Num => Header_Num,
- Element => Source_Id,
- No_Element => No_Source,
- Key => Name_Id,
- Hash => Hash,
- Equal => "=");
-
type Lib_Kind is (Static, Dynamic, Relocatable);
type Policy is (Autonomous, Compliant, Controlled, Restricted, Direct);
Index: prj-nmsc.adb
===================================================================
--- prj-nmsc.adb (revision 178381)
+++ prj-nmsc.adb (working copy)
@@ -252,13 +252,13 @@
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location);
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location);
-- Add a new source to the different lists: list of all sources in the
-- project tree, list of source of a project and list of sources of a
-- language. If Path is specified, the file is also added to
@@ -628,13 +628,13 @@
Kind : Source_Kind;
File_Name : File_Name_Type;
Display_File : File_Name_Type;
- Naming_Exception : Boolean := False;
- Path : Path_Information := No_Path_Information;
- Alternate_Languages : Language_List := null;
- Unit : Name_Id := No_Name;
- Index : Int := 0;
- Locally_Removed : Boolean := False;
- Location : Source_Ptr := No_Location)
+ Naming_Exception : Naming_Exception_Type := No;
+ Path : Path_Information := No_Path_Information;
+ Alternate_Languages : Language_List := null;
+ Unit : Name_Id := No_Name;
+ Index : Int := 0;
+ Locally_Removed : Boolean := False;
+ Location : Source_Ptr := No_Location)
is
Config : constant Language_Config := Lang_Id.Config;
UData : Unit_Index;
@@ -725,7 +725,7 @@
-- file name in unrelated projects.
elsif Is_Extending (Project, Source.Project) then
- if not Locally_Removed then
+ if not Locally_Removed and then Naming_Exception /= Inherited then
Source_To_Replace := Source;
end if;
@@ -854,14 +854,19 @@
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
- Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+
+ if Naming_Exception /= Inherited then
+ Units_Htable.Set (Data.Tree.Units_HT, Unit, UData);
+ end if;
end if;
Id.Unit := UData;
-- Note that this updates Unit information as well
- Override_Kind (Id, Kind);
+ if Naming_Exception /= Inherited then
+ Override_Kind (Id, Kind);
+ end if;
end if;
if Path /= No_Path_Information then
@@ -2329,7 +2334,7 @@
when Name_Runtime_Source_Dir =>
- -- Attribute Runtime_Library_Dir (<language>)
+ -- Attribute Runtime_Source_Dir (<language>)
Lang_Index.Config.Runtime_Source_Dir :=
Element.Value.Value;
@@ -3714,7 +3719,7 @@
Kind => Kind,
File_Name => File_Name,
Display_File => File_Name_Type (Element.Value),
- Naming_Exception => True,
+ Naming_Exception => Yes,
Location => Element.Location);
else
@@ -3760,6 +3765,8 @@
File_Name : File_Name_Type;
Source : Source_Id;
+ Naming_Exception : Naming_Exception_Type;
+
begin
case Kind is
when Impl | Sep =>
@@ -3787,7 +3794,7 @@
if Exceptions = No_Array_Element then
Exceptions :=
Value_Of
- (Name_Spec,
+ (Name_Specification,
In_Arrays => Naming.Decl.Arrays,
Shared => Shared);
end if;
@@ -3795,6 +3802,13 @@
while Exceptions /= No_Array_Element loop
Element := Shared.Array_Elements.Table (Exceptions);
+
+ if Element.Restricted then
+ Naming_Exception := Inherited;
+ else
+ Naming_Exception := Yes;
+ end if;
+
File_Name := Canonical_Case_File_Name (Element.Value.Value);
Get_Name_String (Element.Index);
@@ -3827,7 +3841,7 @@
Unit => Unit,
Index => Index,
Location => Element.Value.Location,
- Naming_Exception => True);
+ Naming_Exception => Naming_Exception);
end if;
Exceptions := Element.Next;
@@ -6326,7 +6340,7 @@
Source := Prj.Element (Iter);
exit Source_Loop when Source = No_Source;
- if Source.Naming_Exception then
+ if Source.Naming_Exception /= No then
NL := Source_Names_Htable.Get
(Project.Source_Names, Source.File);
@@ -6383,51 +6397,54 @@
-- the same file has received the full path, so we need to
-- propagate it.
- if Source.Naming_Exception
- and then Source.Path = No_Path_Information
- then
- if Source.Unit /= No_Unit_Index then
- Found := False;
+ if Source.Path = No_Path_Information then
+ if Source.Naming_Exception = Yes then
+ if Source.Unit /= No_Unit_Index then
+ Found := False;
- if Source.Index /= 0 then -- Only multi-unit files
- declare
- S : Source_Id :=
- Source_Files_Htable.Get
- (Data.Tree.Source_Files_HT, Source.File);
- begin
- while S /= null loop
- if S.Path /= No_Path_Information then
- Source.Path := S.Path;
- Found := True;
+ if Source.Index /= 0 then -- Only multi-unit files
+ declare
+ S : Source_Id :=
+ Source_Files_Htable.Get
+ (Data.Tree.Source_Files_HT, Source.File);
+ begin
+ while S /= null loop
+ if S.Path /= No_Path_Information then
+ Source.Path := S.Path;
+ Found := True;
- if Current_Verbosity = High then
- Debug_Output
- ("setting full path for "
- & Get_Name_String (Source.File)
- & " at" & Source.Index'Img
- & " to "
- & Get_Name_String (Source.Path.Name));
+ if Current_Verbosity = High then
+ Debug_Output
+ ("setting full path for "
+ & Get_Name_String (Source.File)
+ & " at" & Source.Index'Img
+ & " to "
+ & Get_Name_String (Source.Path.Name));
+ end if;
+
+ exit;
end if;
- exit;
- end if;
+ S := S.Next_With_File_Name;
+ end loop;
+ end;
+ end if;
- S := S.Next_With_File_Name;
- end loop;
- end;
+ if not Found then
+ Error_Msg_Name_1 := Name_Id (Source.Display_File);
+ Error_Msg_Name_2 := Source.Unit.Name;
+ Error_Or_Warning
+ (Data.Flags, Data.Flags.Missing_Source_Files,
+ "source file %% for unit %% not found",
+ No_Location, Project.Project);
+ end if;
end if;
- if not Found then
- Error_Msg_Name_1 := Name_Id (Source.Display_File);
- Error_Msg_Name_2 := Source.Unit.Name;
- Error_Or_Warning
- (Data.Flags, Data.Flags.Missing_Source_Files,
- "source file %% for unit %% not found",
- No_Location, Project.Project);
+ if Source.Path = No_Path_Information then
+ Remove_Source (Data.Tree, Source, No_Source);
end if;
- end if;
- if Source.Path = No_Path_Information then
+ elsif Source.Naming_Exception = Inherited then
Remove_Source (Data.Tree, Source, No_Source);
end if;
end if;
@@ -6660,6 +6677,8 @@
-- If we had another file referencing the same unit (for instance it
-- was in an extended project), that source file is in fact invisible
-- from now on, and in particular doesn't belong to the same unit.
+ -- If the source is an inherited naming exception, then it may not
+ -- really exist: the source potentially replaced is left untouched.
if Source.Unit.File_Names (Source.Kind) /= Source then
Source.Unit.File_Names (Source.Kind).Unit := No_Unit_Index;
@@ -6773,6 +6792,50 @@
Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
+
+ -- If this is an inherited naming exception, make sure that
+ -- the naming exception it replaces is no longer a source.
+
+ if Name_Loc.Source.Naming_Exception = Inherited then
+ declare
+ Proj : Project_Id := Name_Loc.Source.Project.Extends;
+ Iter : Source_Iterator;
+ Src : Source_Id;
+ begin
+ while Proj /= No_Project loop
+ Iter := For_Each_Source (Data.Tree, Proj);
+ Src := Prj.Element (Iter);
+ while Src /= No_Source loop
+ if Src.File = Name_Loc.Source.File then
+ Src.Replaced_By := Name_Loc.Source;
+ exit;
+ end if;
+
+ Next (Iter);
+ Src := Prj.Element (Iter);
+ end loop;
+
+ Proj := Proj.Extends;
+ end loop;
+ end;
+
+ if Name_Loc.Source.Unit /= No_Unit_Index then
+ if Name_Loc.Source.Kind = Spec then
+ Name_Loc.Source.Unit.File_Names (Spec) :=
+ Name_Loc.Source;
+
+ elsif Name_Loc.Source.Kind = Impl then
+ Name_Loc.Source.Unit.File_Names (Impl) :=
+ Name_Loc.Source;
+ end if;
+
+ Units_Htable.Set
+ (Data.Tree.Units_HT,
+ Name_Loc.Source.Unit.Name,
+ Name_Loc.Source.Unit);
+ end if;
+
+ end if;
end if;
end if;
end if;
@@ -6825,7 +6888,15 @@
Name_Loc.Source := Source;
Source_Names_Htable.Set
(Project.Source_Names, File_Name, Name_Loc);
+
end if;
+
+-- if Source /= No_Source and then Source.Unit /= No_Unit_Index then
+-- Units_Htable.Set
+-- (Data.Tree.Units_HT,
+-- Source.Unit.Name,
+-- Source.Unit);
+-- end if;
end if;
end if;
@@ -7518,6 +7589,7 @@
if Source /= No_Source
and then Source.Path /= Src.Path
+ and then Src.Project = Source.Project
then
Error_Msg_File_1 := Src.File;
Error_Msg_File_2 := Source.File;
Index: prj-util.adb
===================================================================
--- prj-util.adb (revision 178381)
+++ prj-util.adb (working copy)
@@ -757,9 +757,12 @@
elsif Name_Buffer (1 .. 2) = "I=" then
Info.Info.Index := Int'Value (Name_Buffer (3 .. Name_Len));
- elsif Name_Buffer (1 .. Name_Len) = "N=T" then
- Info.Info.Naming_Exception := True;
+ elsif Name_Buffer (1 .. Name_Len) = "N=Y" then
+ Info.Info.Naming_Exception := Yes;
+ elsif Name_Buffer (1 .. Name_Len) = "N=I" then
+ Info.Info.Naming_Exception := Inherited;
+
else
Report_Error;
exit Source_Loop;
@@ -1116,8 +1119,11 @@
-- Naming exception ("N=T");
- if Source.Naming_Exception then
- Put_Line (File, "N=T");
+ if Source.Naming_Exception = Yes then
+ Put_Line (File, "N=Y");
+
+ elsif Source.Naming_Exception = Inherited then
+ Put_Line (File, "N=I");
end if;
-- Empty line to indicate end of info on this source
Index: prj-util.ads
===================================================================
--- prj-util.ads (revision 178381)
+++ prj-util.ads (working copy)
@@ -210,7 +210,7 @@
Path_Name : Name_Id;
Unit_Name : Name_Id := No_Name;
Index : Int := 0;
- Naming_Exception : Boolean := False;
+ Naming_Exception : Naming_Exception_Type := No;
end record;
-- Data read from a source info file for a single source
Index: prj-env.adb
===================================================================
--- prj-env.adb (revision 178412)
+++ prj-env.adb (working copy)
@@ -529,7 +529,7 @@
if not Source.Locally_Removed
and then Source.Unit /= null
and then
- (Source.Index >= 1 or else Source.Naming_Exception)
+ (Source.Index >= 1 or else Source.Naming_Exception /= No)
then
Put (Source);
end if;
@@ -1344,6 +1344,7 @@
while Unit /= null loop
if Unit.File_Names (Spec) /= null
+ and then not Unit.File_Names (Spec).Locally_Removed
and then Unit.File_Names (Spec).File /= No_File
and then
(Namet.Get_Name_String
@@ -1368,6 +1369,7 @@
elsif Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).File /= No_File
+ and then not Unit.File_Names (Impl).Locally_Removed
and then
(Namet.Get_Name_String
(Unit.File_Names (Impl).File) = Original_Name
