[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:
parent
85b7d482bb
commit
0d354370f2
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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.
|
||||
|
@ -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;
|
||||
|
||||
-----------------------
|
||||
|
@ -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
|
||||
|
@ -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);
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user