[multiple changes]

2009-06-23  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch10.adb (Remove_Limited_With_Clause): Clean up code that handles
	incomplete type declarations. Previous code was potentially quadratic
	in the number of visible declarations in any package appearing in a
	limited_with_clause.

2009-06-23  Robert Dewar  <dewar@adacore.com>

	* prj-conf.ads, prj-part.adb, prj-proc.adb, prj-proc.ads, sem_ch8.adb,
	xref_lib.adb: Minor reformatting

From-SVN: r148843
This commit is contained in:
Arnaud Charlet 2009-06-23 12:09:38 +02:00
parent 85b7d482bb
commit 0d354370f2
8 changed files with 94 additions and 78 deletions

View File

@ -1,3 +1,15 @@
2009-06-23 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Remove_Limited_With_Clause): Clean up code that handles
incomplete type declarations. Previous code was potentially quadratic
in the number of visible declarations in any package appearing in a
limited_with_clause.
2009-06-23 Robert Dewar <dewar@adacore.com>
* prj-conf.ads, prj-part.adb, prj-proc.adb, prj-proc.ads, sem_ch8.adb,
xref_lib.adb: Minor reformatting
2009-06-23 Robert Dewar <dewar@adacore.com>
* a-stzhas.adb: Provide dummy body to avoid build problems with old

View File

@ -35,11 +35,11 @@ package Prj.Conf is
Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref);
-- Hook called after the config file has been parsed. This lets the
-- application do last minute changes to it (GPS uses this to add the
-- default naming schemes for instance).
-- At that point, the config file has not been applied to the project yet.
-- When no config file was found, and automatic generation is disabled, it
-- is possible that Config_File is set to Empty_Node when this procedure is
-- called. You can then decide to create a new config file if you need.
-- default naming schemes for instance). At that point, the config file
-- has not been applied to the project yet. When no config file was found,
-- and automatic generation is disabled, it is possible that Config_File
-- is set to Empty_Node when this procedure is called. You can then decide
-- to create a new config file if you need.
procedure Parse_Project_And_Apply_Config
(Main_Project : out Prj.Project_Id;

View File

@ -1227,6 +1227,7 @@ package body Prj.Part is
end if;
if Is_Config_File and then Proj_Qualifier = Unspecified then
-- Set the qualifier to Configuration, even if the token doesn't
-- exist in the source file itself, so that we can differentiate
-- project files and configuration files later on.

View File

@ -79,11 +79,11 @@ package body Prj.Proc is
-- the package or project with declarations Decl.
procedure Check
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Current_Dir : String;
When_No_Sources : Error_Warning;
Is_Config_File : Boolean;
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Current_Dir : String;
When_No_Sources : Error_Warning;
Is_Config_File : Boolean;
Compiler_Driver_Mandatory : Boolean);
-- Set all projects to not checked, then call Recursive_Check for the
-- main project Project. Project is set to No_Project if errors occurred.
@ -148,11 +148,11 @@ package body Prj.Proc is
-- project.
type Recursive_Check_Data is record
In_Tree : Project_Tree_Ref;
Current_Dir : String_Access;
When_No_Sources : Error_Warning;
Proc_Data : Processing_Data;
Is_Config_File : Boolean;
In_Tree : Project_Tree_Ref;
Current_Dir : String_Access;
When_No_Sources : Error_Warning;
Proc_Data : Processing_Data;
Is_Config_File : Boolean;
Compiler_Driver_Mandatory : Boolean;
end record;
-- Data passed to Recursive_Check
@ -180,7 +180,6 @@ package body Prj.Proc is
elsif Str /= No_Name and then Str /= Empty_String then
declare
S : constant String := Get_Name_String (Str);
begin
Get_Name_String (To_Exp);
Add_Str_To_Name_Buffer (S);
@ -296,11 +295,12 @@ package body Prj.Proc is
Data : Recursive_Check_Data;
begin
Data.In_Tree := In_Tree;
Data.Current_Dir := Dir'Unchecked_Access;
Data.When_No_Sources := When_No_Sources;
Data.Is_Config_File := Is_Config_File;
Data.In_Tree := In_Tree;
Data.Current_Dir := Dir'Unchecked_Access;
Data.When_No_Sources := When_No_Sources;
Data.Is_Config_File := Is_Config_File;
Data.Compiler_Driver_Mandatory := Compiler_Driver_Mandatory;
Initialize (Data.Proc_Data);
Check_All_Projects (Project, Data, Imported_First => True);
@ -2310,15 +2310,15 @@ package body Prj.Proc is
----------------------------------
procedure Process_Project_Tree_Phase_2
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Is_Config_File : Boolean;
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Is_Config_File : Boolean;
Compiler_Driver_Mandatory : Boolean)
is
Obj_Dir : Path_Name_Type;
@ -2334,7 +2334,7 @@ package body Prj.Proc is
if Project /= No_Project then
Check (In_Tree, Project, Current_Dir, When_No_Sources,
Is_Config_File => Is_Config_File,
Is_Config_File => Is_Config_File,
Compiler_Driver_Mandatory => Compiler_Driver_Mandatory);
end if;
@ -2460,7 +2460,7 @@ package body Prj.Proc is
(Project, Data.In_Tree, Error_Report, Data.When_No_Sources,
Data.Current_Dir.all, Data.Proc_Data,
Compiler_Driver_Mandatory => Data.Compiler_Driver_Mandatory,
Is_Config_File => Data.Is_Config_File);
Is_Config_File => Data.Is_Config_File);
end Recursive_Check;
-----------------------

View File

@ -58,15 +58,15 @@ package Prj.Proc is
-- project table before processing.
procedure Process_Project_Tree_Phase_2
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Is_Config_File : Boolean;
(In_Tree : Project_Tree_Ref;
Project : Project_Id;
Success : out Boolean;
From_Project_Node : Project_Node_Id;
From_Project_Node_Tree : Project_Node_Tree_Ref;
Report_Error : Put_Line_Access;
When_No_Sources : Error_Warning := Error;
Current_Dir : String;
Is_Config_File : Boolean;
Compiler_Driver_Mandatory : Boolean);
-- Perform the second phase of the processing, filling the rest of the
-- project with the information extracted from the project tree. This phase

View File

@ -5650,50 +5650,53 @@ package body Sem_Ch10 is
if Ekind (Lim_Typ) /= E_Package
and then not Is_Child_Unit (Non_Limited_View (Lim_Typ))
then
-- Handle incomplete types of the real view. For this purpose
-- we traverse the list of visible entities to look for an
-- incomplete type in the real-view associated with Lim_Typ.
E := First_Entity (P);
while Present (E) and then E /= First_Private_Entity (P) loop
exit when Ekind (E) = E_Incomplete_Type
and then Present (Full_View (E))
and then Full_View (E) = Lim_Typ;
-- If the package has incomplete types, the limited view
-- of the incomplete type is in fact never visible (AI05-129)
-- but we have created a shadow entity E1 for it, that points
-- to E2, a non-limited incomplete type. This in turn has a
-- full view E3 that is the full declaration. There is a
-- corresponding shadow entity E4. When reinstalling the
-- non-limited view, E2 must become the current entity and
-- E3 must be ignored.
Next_Entity (E);
end loop;
E := Non_Limited_View (Lim_Typ);
-- If the previous search was not successful then the entity
-- to be restored in the homonym list is the non-limited view
if Present (Current_Entity (E))
and then Ekind (Current_Entity (E)) = E_Incomplete_Type
and then Full_View (Current_Entity (E)) = E
then
if E = First_Private_Entity (P) then
E := Non_Limited_View (Lim_Typ);
end if;
-- Lim_Typ is the limited view of a full type declaration
-- that has a previous incomplete declaration, i.e. E3
-- from the previous description. Nothing to insert.
pragma Assert (not In_Chain (E));
Prev := Current_Entity (Lim_Typ);
if Prev = Lim_Typ then
Set_Current_Entity (E);
null;
else
while Present (Prev)
and then Homonym (Prev) /= Lim_Typ
loop
Prev := Homonym (Prev);
end loop;
pragma Assert (not In_Chain (E));
if Present (Prev) then
Set_Homonym (Prev, E);
Prev := Current_Entity (Lim_Typ);
if Prev = Lim_Typ then
Set_Current_Entity (E);
else
while Present (Prev)
and then Homonym (Prev) /= Lim_Typ
loop
Prev := Homonym (Prev);
end loop;
if Present (Prev) then
Set_Homonym (Prev, E);
end if;
end if;
-- Preserve structure of homonym chain.
Set_Homonym (E, Homonym (Lim_Typ));
end if;
-- We must also set the next homonym entity of the real entity
-- to handle the case in which the next homonym was a shadow
-- entity.
Set_Homonym (E, Homonym (Lim_Typ));
end if;
Next_Entity (Lim_Typ);

View File

@ -4773,10 +4773,10 @@ package body Sem_Ch8 is
then
declare
H : constant Entity_Id := Homonym (P_Name);
begin
Id := First_Entity (H);
while Present (Id) loop
if Chars (Id) = Chars (Selector) then
Error_Msg_Qual_Level := 99;
Error_Msg_Name_1 := Chars (Selector);

View File

@ -49,7 +49,7 @@ package body Xref_Lib is
No_Xref_Information : exception;
-- Exception raised when there is no cross-referencing information in
-- the .ali files
-- the .ali files.
procedure Parse_EOL
(Source : not null access String;
@ -708,9 +708,9 @@ package body Xref_Lib is
Ptr := Ptr + 1;
end loop;
if Source (Ptr) /= EOF then
-- Skip CR or LF
-- Skip CR or LF if not at end of file
if Source (Ptr) /= EOF then
Ptr := Ptr + 1;
end if;