+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
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;
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.
-- 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.
-- 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
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);
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);
----------------------------------
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;
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;
(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;
-----------------------
-- 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
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));
+ null;
- Prev := Current_Entity (Lim_Typ);
+ else
+ pragma Assert (not In_Chain (E));
- if Prev = Lim_Typ then
- Set_Current_Entity (E);
+ Prev := Current_Entity (Lim_Typ);
- else
- while Present (Prev)
- and then Homonym (Prev) /= Lim_Typ
- loop
- Prev := Homonym (Prev);
- end loop;
+ if Prev = Lim_Typ then
+ Set_Current_Entity (E);
- if Present (Prev) then
- Set_Homonym (Prev, 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;
- 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.
+ -- Preserve structure of homonym chain.
- Set_Homonym (E, Homonym (Lim_Typ));
+ Set_Homonym (E, Homonym (Lim_Typ));
+ end if;
end if;
Next_Entity (Lim_Typ);
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);
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;
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;