2009-04-24 Emmanuel Briot <briot@adacore.com>
+ * prj-proc.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
+ prj-nmsc.adb, prj-env.adb (Project_List_Table, Project_Element):
+ removed. Lists of projects are now implemented via standard malloc
+ rather than through the table.
+
+2009-04-24 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch12.adb: Minor reformatting
+
+ * g-trasym.adb: Minor reformatting
+
+ * exp_ch6.adb: Minor reformatting
+
+2009-04-24 Robert Dewar <dewar@adacore.com>
+
+ * layout.adb (Layout_Type): For packed array type, copy unset
+ size/alignment fields from the referenced Packed_Array_Type.
+
+2009-04-24 Bob Duff <duff@adacore.com>
+
+ * lib-load.adb (Make_Instance_Unit): Revert previous change, no
+ longer needed after sem_ch12 changes.
+
+ * sem.adb (Walk_Library_Items): Include with's in some debugging
+ printouts.
+
+2009-04-24 Emmanuel Briot <briot@adacore.com>
+
* prj.ads, prj-nmsc.adb (Unit_Project): removed, since in fact we were
only ever using the Project field.
if All_Projects then
declare
Imported : Project_List := Data.Imported_Projects;
- Element : Project_Element;
Process : Boolean;
begin
-- For each imported project, call Clean_Project if the project
-- has not been processed already.
- while Imported /= Empty_Project_List loop
- Element := Project_Tree.Project_Lists.Table (Imported);
- Imported := Element.Next;
+ while Imported /= null loop
Process := True;
for
J in Processed_Projects.First .. Processed_Projects.Last
loop
- if Element.Project = Processed_Projects.Table (J) then
+ if Imported.Project = Processed_Projects.Table (J) then
Process := False;
exit;
end if;
end loop;
if Process then
- Clean_Project (Element.Project);
+ Clean_Project (Imported.Project);
end if;
+
+ Imported := Imported.Next;
end loop;
-- If this project extends another project, call Clean_Project for
Act_Prev := Expression (Act_Prev);
end loop;
- -- If the expression is a conversion of a dereference,
- -- this is internally generated code that manipulates
- -- addresses, e.g. when building interface tables. No
- -- check should occur in this case, and the discriminated
- -- object is not directly a hand.
+ -- If the expression is a conversion of a dereference, this
+ -- is internally generated code that manipulates addresses,
+ -- e.g. when building interface tables. No check should
+ -- occur in this case, and the discriminated object is not
+ -- directly a hand.
if not Comes_From_Source (Actual)
and then Nkind (Actual) = N_Unchecked_Type_Conversion
then
-- We perform two simple optimization on calls:
- -- a) replace calls to null procedures unconditionally,
+ -- a) replace calls to null procedures unconditionally;
- -- b) For To_Address, just do an unchecked conversion. Not only is
+ -- b) for To_Address, just do an unchecked conversion. Not only is
-- this efficient, but it also avoids order of elaboration problems
-- when address clauses are inlined (address expression elaborated
-- at the wrong point).
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
buf : System.Address;
len : System.Address);
pragma Import (C, convert_addresses, "convert_addresses");
- -- This is the procedure version of the Ada aware addr2line. It places
+ -- This is the procedure version of the Ada-aware addr2line. It places
-- in BUF a string representing the symbolic translation of the N_ADDRS
-- raw addresses provided in ADDRS, looked up in debug information from
-- FILENAME. LEN points to an integer which contains the size of the
use type System.Address;
begin
- -- The symbolic translation of an empty set of addresses is the
- -- the empty string.
+ -- The symbolic translation of an empty set of addresses is an empty
+ -- string.
if Traceback'Length = 0 then
return "";
-- libaddr2line service to symbolize it all.
-- Compute, cache and provide the absolute path to our executable file
- -- name as the binary file where the relevant debug information is to
- -- be found. If the executable file name resolution fails, we have no
+ -- name as the binary file where the relevant debug information is to be
+ -- found. If the executable file name resolution fails, we have no
-- sensible basis to invoke the symbolizer at all.
-- Protect all this against concurrent accesses explicitly, as the
-- Non-elementary (composite) types
else
+ -- For packed arrays, take size and alignment values from the packed
+ -- array type if a packed array type has been created and the fields
+ -- are not currently set.
+
+ if Is_Array_Type (E) and then Present (Packed_Array_Type (E)) then
+ declare
+ PAT : constant Entity_Id := Packed_Array_Type (E);
+
+ begin
+ if Unknown_Esize (E) then
+ Set_Esize (E, Esize (PAT));
+ end if;
+
+ if Unknown_RM_Size (E) then
+ Set_RM_Size (E, RM_Size (PAT));
+ end if;
+
+ if Unknown_Alignment (E) then
+ Set_Alignment (E, Alignment (PAT));
+ end if;
+ end;
+ end if;
+
-- If RM_Size is known, set Esize if not known
if Known_RM_Size (E) and then Unknown_Esize (E) then
procedure Rewrite_Integer (N : Node_Id; V : Uint) is
Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N);
-
begin
Rewrite (N, Make_Integer_Literal (Loc, Intval => V));
Set_Etype (N, Typ);
-- units table when first loaded as a declaration.
Units.Table (Units.Last) := Units.Table (Get_Cunit_Unit_Number (N));
-
- -- The correct Cunit is the spec -- Library_Unit (N). But that causes
- -- gnatmake to fail in certain cases, so this is under control of
- -- Inspector_Mode for now. ???
-
- if Inspector_Mode then
- Units.Table (Units.Last).Cunit := Library_Unit (N);
- else
- Units.Table (Units.Last).Cunit := N;
- end if;
+ Units.Table (Units.Last).Cunit := Library_Unit (N);
end if;
end Make_Instance_Unit;
then
declare
List : Project_List;
- Element : Project_Element;
Proj2 : Project_Id;
Rebuild : Boolean := False;
begin
List := Project_Tree.Projects.Table (Proj1).
All_Imported_Projects;
- while List /= Empty_Project_List loop
- Element :=
- Project_Tree.Project_Lists.Table (List);
- Proj2 := Element.Project;
+ while List /= null loop
+ Proj2 := List.Project;
if
Project_Tree.Projects.Table (Proj2).Library
end if;
end if;
- List := Element.Next;
+ List := List.Next;
end loop;
if Rebuild then
-- Visit each imported project
- while List /= Empty_Project_List loop
- Proj := Project_Tree.Project_Lists.Table (List).Project;
- List := Project_Tree.Project_Lists.Table (List).Next;
+ while List /= null loop
+ Proj := List.Project;
+ List := List.Next;
Recurse (Prj => Proj, Depth => Depth + 1);
end loop;
procedure Process_Project (Project : Project_Id) is
Data : Project_Data := In_Tree.Projects.Table (Project);
Imported : Project_List := Data.Imported_Projects;
- Element : Project_Element;
begin
-- Nothing to do if process has already been processed
-- We first process the imported projects to guarantee that
-- we have a proper reverse order for the libraries.
- while Imported /= Empty_Project_List loop
- Element :=
- In_Tree.Project_Lists.Table (Imported);
-
- if Element.Project /= No_Project then
- Process_Project (Element.Project);
+ while Imported /= null loop
+ if Imported.Project /= No_Project then
+ Process_Project (Imported.Project);
end if;
- Imported := Element.Next;
+ Imported := Imported.Next;
end loop;
-- If it is a library project, add it to Library_Projs
Current_Unit : Unit_Index := Unit_Table.First;
- First_Project : Project_List := Empty_Project_List;
+ First_Project : Project_List;
Current_Project : Project_List;
Current_Naming : Naming_Id;
-- Is this project in the list of the visited project?
Current_Project := First_Project;
- while Current_Project /= Empty_Project_List
- and then In_Tree.Project_Lists.Table
- (Current_Project).Project /= Project
+ while Current_Project /= null
+ and then Current_Project.Project /= Project
loop
- Current_Project :=
- In_Tree.Project_Lists.Table (Current_Project).Next;
+ Current_Project := Current_Project.Next;
end loop;
-- If it is not, put it in the list, and visit it
- if Current_Project = Empty_Project_List then
- Project_List_Table.Increment_Last
- (In_Tree.Project_Lists);
- In_Tree.Project_Lists.Table
- (Project_List_Table.Last (In_Tree.Project_Lists)) :=
- (Project => Project, Next => First_Project);
- First_Project :=
- Project_List_Table.Last (In_Tree.Project_Lists);
+ if Current_Project = null then
+ First_Project := new Project_List_Element'
+ (Project => Project,
+ Next => First_Project);
-- Is the naming scheme of this project one that we know?
Current : Project_List := Data.Imported_Projects;
begin
- while Current /= Empty_Project_List loop
- Check
- (In_Tree.Project_Lists.Table
- (Current).Project);
- Current := In_Tree.Project_Lists.Table
- (Current).Next;
+ while Current /= null loop
+ Check (Current.Project);
+ Current := Current.Next;
end loop;
end;
end if;
procedure Recursive_Flag (Prj : Project_Id) is
Imported : Project_List;
- Proj : Project_Id;
begin
-- Nothing to do for non existent project or project that has already
Present (Prj) := True;
Imported := In_Tree.Projects.Table (Prj).Imported_Projects;
- while Imported /= Empty_Project_List loop
- Proj := In_Tree.Project_Lists.Table (Imported).Project;
- Imported := In_Tree.Project_Lists.Table (Imported).Next;
- Recursive_Flag (Proj);
+ while Imported /= null loop
+ Recursive_Flag (Imported.Project);
+ Imported := Imported.Next;
end loop;
Recursive_Flag (In_Tree.Projects.Table (Prj).Extends);
procedure Find_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Explicit_Sources_Only : Boolean);
-- Find all Ada sources by traversing all source directories.
-- If Explicit_Sources_Only is True, then the sources found must belong to
Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
+ Units : in out Files_Htable.Instance;
Ada_Language : Language_Ptr;
Location : Source_Ptr;
Source_Recorded : in out Boolean);
Prj.Util.Value_Of
(Snames.Name_Library_Kind, Attributes, In_Tree);
- Imported_Project_List : Project_List := Empty_Project_List;
+ Imported_Project_List : Project_List;
Continuation : String_Access := No_Continuation_String'Access;
Check_Library (Data.Extends, Extends => True);
Imported_Project_List := Data.Imported_Projects;
- while Imported_Project_List /= Empty_Project_List loop
+ while Imported_Project_List /= null loop
Check_Library
- (In_Tree.Project_Lists.Table
- (Imported_Project_List).Project,
+ (Imported_Project_List.Project,
Extends => False);
- Imported_Project_List :=
- In_Tree.Project_Lists.Table
- (Imported_Project_List).Next;
+ Imported_Project_List := Imported_Project_List.Next;
end loop;
end if;
end if;
if Get_Mode = Ada_Only then
Find_Ada_Sources
- (Project, In_Tree, Data,
- Explicit_Sources_Only => Has_Explicit_Sources);
+ (Project, In_Tree, Explicit_Sources_Only => Has_Explicit_Sources);
else
Search_Directories
procedure Find_Ada_Sources
(Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
Explicit_Sources_Only : Boolean)
is
+ Data : Project_Data renames In_Tree.Projects.Table (Project);
Source_Dir : String_List_Id;
Element : String_Element;
Dir : Dir_Type;
Dir_Has_Source : Boolean := False;
NL : Name_Location;
Ada_Language : Language_Ptr;
+ Units : Files_Htable.Instance;
begin
+ Files_Htable.Reset (Units);
+
if Current_Verbosity = High then
Write_Line ("Looking for Ada sources:");
end if;
Path_Name => Path_Name,
Project => Project,
In_Tree => In_Tree,
- Data => Data,
+ Units => Units,
Ada_Language => Ada_Language,
Location => Location,
Source_Recorded => Dir_Has_Source);
if Current_Verbosity = High then
Write_Line ("End looking for sources");
end if;
+
+ Files_Htable.Reset (Units);
end Find_Ada_Sources;
-------------------------------
Path_Name : Path_Name_Type;
Project : Project_Id;
In_Tree : Project_Tree_Ref;
- Data : in out Project_Data;
+ Units : in out Files_Htable.Instance;
Ada_Language : Language_Ptr;
Location : Source_Ptr;
Source_Recorded : in out Boolean)
is
+ Data : Project_Data renames In_Tree.Projects.Table (Project);
Canonical_File : File_Name_Type;
Canonical_Path : Path_Name_Type;
-- Record the file name in the hash table Files_Htable
- Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project);
+ Files_Htable.Set (Units, Canonical_File, Project);
UData.File_Names (Unit_Kind) :=
(Name => Canonical_File,
-- another project. If it is, report error but note we do that
-- only for the first unit in the source file.
- Unit_Prj := Files_Htable.Get (In_Tree.Files_HT, Canonical_File);
+ Unit_Prj := Files_Htable.Get (Units, Canonical_File);
if not File_Recorded
and then Unit_Prj /= No_Project
The_Unit := Unit_Table.Last (In_Tree.Units);
Units_Htable.Set (In_Tree.Units_HT, Unit_Name, The_Unit);
- Files_Htable.Set (In_Tree.Files_HT, Canonical_File, Project);
+ Files_Htable.Set (Units, Canonical_File, Project);
UData.Name := Unit_Name;
UData.File_Names (Unit_Kind) :=
Temp_Result := No_Project;
List := Data.Imported_Projects;
- while List /= Empty_Project_List loop
- Result := In_Tree.Project_Lists.Table (List).Project;
+ while List /= null loop
+ Result := List.Project;
-- If the project is directly imported, then returns its ID
end loop;
end;
- List := In_Tree.Project_Lists.Table (List).Next;
+ List := List.Next;
end loop;
pragma Assert (Temp_Result /= No_Project, "project not found");
From_Project_Node_Tree => From_Project_Node_Tree,
Extended_By => No_Project);
- -- Add this project to our list of imported projects
-
- Project_List_Table.Increment_Last (In_Tree.Project_Lists);
-
- In_Tree.Project_Lists.Table
- (Project_List_Table.Last (In_Tree.Project_Lists)) :=
- (Project => New_Project, Next => Empty_Project_List);
-
-- Imported is the id of the last imported project. If
-- it is nil, then this imported project is our first.
- if Imported = Empty_Project_List then
+ if Imported = null then
In_Tree.Projects.Table (Project).Imported_Projects :=
- Project_List_Table.Last (In_Tree.Project_Lists);
+ new Project_List_Element'
+ (Project => New_Project,
+ Next => null);
+ Imported :=
+ In_Tree.Projects.Table (Project).Imported_Projects;
else
- In_Tree.Project_Lists.Table (Imported).Next :=
- Project_List_Table.Last (In_Tree.Project_Lists);
+ Imported.Next := new Project_List_Element'
+ (Project => New_Project,
+ Next => null);
+ Imported := Imported.Next;
end if;
-
- Imported := Project_List_Table.Last (In_Tree.Project_Lists);
end if;
With_Clause :=
else
declare
Processed_Data : Project_Data := Empty_Project (In_Tree);
- Imported : Project_List := Empty_Project_List;
+ Imported : Project_List;
Declaration_Node : Project_Node_Id := Empty_Node;
Tref : Source_Buffer_Ptr;
Name : constant Name_Id :=
Naming => Std_Naming_Data,
Languages => No_Language_Index,
Decl => No_Declarations,
- Imported_Projects => Empty_Project_List,
- All_Imported_Projects => Empty_Project_List,
+ Imported_Projects => null,
+ All_Imported_Projects => null,
Ada_Include_Path => null,
Ada_Objects_Path => null,
Objects_Path => null,
-- Table to store the path name of all the created temporary files, so that
-- they can be deleted at the end, or when the program is interrupted.
- procedure Free (Project : in out Project_Data);
+ procedure Free (Project : in out Project_Data; Reset_Only : Boolean);
-- Free memory allocated for Project
procedure Free_List (Languages : in out Language_Ptr);
procedure Free_List (Source : in out Source_Id);
+ procedure Free_List (List : in out Project_List);
-- Free memory allocated for the list of languages or sources
procedure Language_Changed (Iter : in out Source_Iterator);
-- Visited all imported projects
List := Data.Imported_Projects;
- while List /= Empty_Project_List loop
- Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
- List := In_Tree.Project_Lists.Table (List).Next;
+ while List /= null loop
+ Recursive_Check (List.Project);
+ List := List.Next;
end loop;
if Imported_First then
-- Free --
----------
- procedure Free (Project : in out Project_Data) is
+ procedure Free (Project : in out Project_Data; Reset_Only : Boolean) is
begin
Free (Project.Include_Path);
Free (Project.Ada_Include_Path);
Free (Project.Objects_Path);
Free (Project.Ada_Objects_Path);
+
+ Free_List (Project.Imported_Projects);
+ Free_List (Project.All_Imported_Projects);
+
+ if not Reset_Only then
+ Free_List (Project.Languages);
+ end if;
end Free;
---------------
-- Free_List --
---------------
+ procedure Free_List (List : in out Project_List) is
+ procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+ (Project_List_Element, Project_List);
+ Tmp : Project_List;
+ begin
+ while List /= null loop
+ Tmp := List.Next;
+ Unchecked_Free (List);
+ List := Tmp;
+ end loop;
+ end Free_List;
+
+ ---------------
+ -- Free_List --
+ ---------------
+
procedure Free_List (Languages : in out Language_Ptr) is
procedure Unchecked_Free is new Ada.Unchecked_Deallocation
(Language_Data, Language_Ptr);
Array_Element_Table.Free (Tree.Array_Elements);
Array_Table.Free (Tree.Arrays);
Package_Table.Free (Tree.Packages);
- Project_List_Table.Free (Tree.Project_Lists);
Alternate_Language_Table.Free (Tree.Alt_Langs);
Unit_Table.Free (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
- Files_Htable.Reset (Tree.Files_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
for P in Project_Table.First ..
Project_Table.Last (Tree.Projects)
loop
- Free_List (Tree.Projects.Table (P).Languages);
- Free (Tree.Projects.Table (P));
+ Free (Tree.Projects.Table (P), Reset_Only => False);
end loop;
Project_Table.Free (Tree.Projects);
Array_Element_Table.Init (Tree.Array_Elements);
Array_Table.Init (Tree.Arrays);
Package_Table.Init (Tree.Packages);
- Project_List_Table.Init (Tree.Project_Lists);
Alternate_Language_Table.Init (Tree.Alt_Langs);
Unit_Table.Init (Tree.Units);
Units_Htable.Reset (Tree.Units_HT);
- Files_Htable.Reset (Tree.Files_HT);
Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
Unit_Sources_Htable.Reset (Tree.Unit_Sources_HT);
for P in Project_Table.First ..
Project_Table.Last (Tree.Projects)
loop
- Free (Tree.Projects.Table (P));
+ Free (Tree.Projects.Table (P), Reset_Only => True);
end loop;
end if;
procedure Compute_All_Imported_Projects
(Project : Project_Id; In_Tree : Project_Tree_Ref)
is
- procedure Add_To_List (Prj : Project_Id);
- -- Add a project to the list All_Imported_Projects of project Project
+ Data : Project_Data renames In_Tree.Projects.Table (Project);
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean);
-- Recursively add the projects imported by project Project, but not
-- those that are extended.
- -----------------
- -- Add_To_List --
- -----------------
-
- procedure Add_To_List (Prj : Project_Id) is
- Element : constant Project_Element :=
- (Prj,
- In_Tree.Projects.Table (Project).All_Imported_Projects);
- List : Project_List;
-
- begin
- -- Check that the project is not already in the list. We know the one
- -- passed to Recursive_Add have never been visited before, but the
- -- one passed it are the extended projects.
-
- List := In_Tree.Projects.Table (Project).All_Imported_Projects;
- while List /= Empty_Project_List loop
- if In_Tree.Project_Lists.Table (List).Project = Prj then
- return;
- end if;
- List := In_Tree.Project_Lists.Table (List).Next;
- end loop;
-
- -- Add it to the list
-
- Project_List_Table.Increment_Last (In_Tree.Project_Lists);
- List := Project_List_Table.Last (In_Tree.Project_Lists);
- In_Tree.Project_Lists.Table (List) := Element;
- In_Tree.Projects.Table (Project).All_Imported_Projects := List;
- end Add_To_List;
-
-------------------
-- Recursive_Add --
-------------------
procedure Recursive_Add (Prj : Project_Id; Dummy : in out Boolean) is
pragma Unreferenced (Dummy);
-
+ List : Project_List;
Prj2 : Project_Id;
begin
if Project /= Prj then
Prj2 := Ultimate_Extending_Project_Of (Prj, In_Tree);
- Add_To_List (Prj2);
+
+ -- Check that the project is not already in the list. We know the
+ -- one passed to Recursive_Add have never been visited before, but
+ -- the one passed it are the extended projects.
+
+ List := Data.All_Imported_Projects;
+ while List /= null loop
+ if List.Project = Prj2 then
+ return;
+ end if;
+ List := List.Next;
+ end loop;
+
+ -- Add it to the list
+
+ Data.All_Imported_Projects :=
+ new Project_List_Element'
+ (Project => Prj2,
+ Next => Data.All_Imported_Projects);
end if;
end Recursive_Add;
Dummy : Boolean := False;
begin
- In_Tree.Projects.Table (Project).All_Imported_Projects :=
- Empty_Project_List;
+ Free_List (Data.All_Imported_Projects);
For_All_Projects (Project, In_Tree, Dummy);
end Compute_All_Imported_Projects;
-- Returns True if Left and Right are the same naming scheme
-- not considering Specs and Bodies.
- type Project_List is new Nat;
- Empty_Project_List : constant Project_List := 0;
- -- A list of project files
-
- type Project_Element is record
+ type Project_List_Element;
+ type Project_List is access Project_List_Element;
+ type Project_List_Element is record
Project : Project_Id := No_Project;
- Next : Project_List := Empty_Project_List;
+ Next : Project_List := null;
end record;
- -- Element in a list of project files. Next is the id of the next
- -- project file in the list.
-
- package Project_List_Table is new GNAT.Dynamic_Tables
- (Table_Component_Type => Project_Element,
- Table_Index_Type => Project_List,
- Table_Low_Bound => 1,
- Table_Initial => 100,
- Table_Increment => 100);
- -- The table that contains the lists of project files
+ -- A list of projects
type Response_File_Format is
(None,
-- The declarations (variables, attributes and packages) of this project
-- file.
- Imported_Projects : Project_List := Empty_Project_List;
+ Imported_Projects : Project_List;
-- The list of all directly imported projects, if any
- All_Imported_Projects : Project_List := Empty_Project_List;
+ All_Imported_Projects : Project_List;
-- The list of all projects imported directly or indirectly, if any
-----------------
Array_Elements : Array_Element_Table.Instance;
Arrays : Array_Table.Instance;
Packages : Package_Table.Instance;
- Project_Lists : Project_List_Table.Instance;
Projects : Project_Table.Instance;
Alt_Langs : Alternate_Language_Table.Instance;
Units : Unit_Table.Instance;
Units_HT : Units_Htable.Instance;
- Files_HT : Files_Htable.Instance;
Source_Paths_HT : Source_Paths_Htable.Instance;
Unit_Sources_HT : Unit_Sources_Htable.Instance;
begin
if Debug_Unit_Walk then
- Write_Unit_Info (Unit_Num, Item);
+ Write_Unit_Info (Unit_Num, Item, Withs => True);
end if;
-- Main unit should come last
for Unit_Num in Done'Range loop
if not Done (Unit_Num) then
- Write_Unit_Info (Unit_Num, Unit (Cunit (Unit_Num)));
+ Write_Unit_Info
+ (Unit_Num, Unit (Cunit (Unit_Num)), Withs => True);
end if;
end loop;
Actual_Types : constant Elist_Id := New_Elmt_List;
Assoc : constant List_Id := New_List;
Default_Actuals : constant Elist_Id := New_Elmt_List;
- Gen_Unit : constant Entity_Id
- := Defining_Entity (Parent (F_Copy));
+ Gen_Unit : constant Entity_Id :=
+ Defining_Entity (Parent (F_Copy));
Actuals : List_Id;
Actual : Node_Id;
First_Named : Node_Id := Empty;
Default_Formals : constant List_Id := New_List;
- -- If an Other_Choice is present, some of the formals may be defaulted.
+ -- If an Others_Choice is present, some of the formals may be defaulted.
-- To simplify the treatment of visibility in an instance, we introduce
-- individual defaults for each such formal. These defaults are
-- appended to the list of associations and replace the Others_Choice.
-- End of list of purely positional parameters
- if No (Actual)
- or else Nkind (Actual) = N_Others_Choice
- then
+ if No (Actual) or else Nkind (Actual) = N_Others_Choice then
Found_Assoc := Empty;
Act := Empty;
Id : Entity_Id;
begin
- -- Append copy of formal declaration to associations, and create
- -- new defining identifier for it.
+ -- Append copy of formal declaration to associations, and create new
+ -- defining identifier for it.
Decl := New_Copy_Tree (F);
Id := Make_Defining_Identifier (Sloc (F_Id), Chars => Chars (F_Id));
-- The new compilation unit is linked to its body, but both share the
-- same file, so we do not set Body_Required on the new unit so as not
-- to create a spurious dependency on a non-existent body in the ali.
- -- This simplifies codepeer unit traversal.
+ -- This simplifies Codepeer unit traversal.
-- We use the original instantiation compilation unit as the resulting
-- compilation unit of the instance, since this is the main unit.
Set_Private_Present (Decl_Cunit, Private_Present (Body_Cunit));
- -- If the instance is not the main unit, its context, categorization,
+ -- If the instance is not the main unit, its context, categorization
-- and elaboration entity are not relevant to the compilation.
if Body_Cunit /= Cunit (Main_Unit) then
-- the time the instantiations will be analyzed.
procedure Reset_Entity (N : Node_Id);
- -- Save semantic information on global entity, so that it is not
- -- resolved again at instantiation time.
+ -- Save semantic information on global entity so that it is not resolved
+ -- again at instantiation time.
procedure Save_Entity_Descendants (N : Node_Id);
-- Apply Save_Global_References to the two syntactic descendants of
function Is_Instance_Node (Decl : Node_Id) return Boolean is
begin
- return (Nkind (Decl) in N_Generic_Instantiation
- or else
- Nkind (Original_Node (Decl)) = N_Formal_Package_Declaration);
+ return Nkind (Decl) in N_Generic_Instantiation
+ or else
+ Nkind (Original_Node (Decl)) = N_Formal_Package_Declaration;
end Is_Instance_Node;
-- Start of processing for Is_Global
procedure Reset_Entity (N : Node_Id) is
procedure Set_Global_Type (N : Node_Id; N2 : Node_Id);
- -- If the type of N2 is global to the generic unit. Save
- -- the type in the generic node.
+ -- If the type of N2 is global to the generic unit. Save the type in
+ -- the generic node.
+ -- What does this comment mean???
function Top_Ancestor (E : Entity_Id) return Entity_Id;
- -- Find the ultimate ancestor of the current unit. If it is
- -- not a generic unit, then the name of the current unit
- -- in the prefix of an expanded name must be replaced with
- -- its generic homonym to ensure that it will be properly
- -- resolved in an instance.
+ -- Find the ultimate ancestor of the current unit. If it is not a
+ -- generic unit, then the name of the current unit in the prefix of
+ -- an expanded name must be replaced with its generic homonym to
+ -- ensure that it will be properly resolved in an instance.
---------------------
-- Set_Global_Type --
if Entity (N) /= N2
and then Has_Private_View (Entity (N))
then
- -- If the entity of N is not the associated node, this is
- -- a nested generic and it has an associated node as well,
- -- whose type is already the full view (see below). Indicate
- -- that the original node has a private view.
+ -- If the entity of N is not the associated node, this is a
+ -- nested generic and it has an associated node as well, whose
+ -- type is already the full view (see below). Indicate that the
+ -- original node has a private view.
Set_Has_Private_View (N);
end if;
Set_Has_Private_View (N);
end if;
- -- If it is a derivation of a private type in a context where
- -- no full view is needed, nothing to do either.
+ -- If it is a derivation of a private type in a context where no
+ -- full view is needed, nothing to do either.
elsif No (Full_View (Typ)) and then Typ /= Etype (Typ) then
null;
- -- Otherwise mark the type for flipping and use the full_view
- -- when available.
+ -- Otherwise mark the type for flipping and use the full view when
+ -- available.
else
Set_Has_Private_View (N);
-- is because in an instantiation Par.P.Q will not resolve to the
-- name of the instance, whose enclosing scope is not necessarily
-- Par. We use the generic homonym rather that the name of the
- -- generic itself, because it may be hidden by a local
- -- declaration.
+ -- generic itself because it may be hidden by a local declaration.
elsif In_Open_Scopes (Entity (Parent (N2)))
and then not
-- A selected component may denote a static constant that has been
-- folded. If the static constant is global to the generic, capture
- -- its value. Otherwise the folding will happen in any instantiation,
+ -- its value. Otherwise the folding will happen in any instantiation.
elsif Nkind (Parent (N)) = N_Selected_Component
and then Nkind_In (Parent (N2), N_Integer_Literal, N_Real_Literal)
-- Save_References --
---------------------
- -- This is the recursive procedure that does the work, once the
- -- enclosing generic scope has been established. We have to treat
- -- specially a number of node rewritings that are required by semantic
- -- processing and which change the kind of nodes in the generic copy:
- -- typically constant-folding, replacing an operator node by a string
- -- literal, or a selected component by an expanded name. In each of
- -- those cases, the transformation is propagated to the generic unit.
+ -- This is the recursive procedure that does the work once the enclosing
+ -- generic scope has been established. We have to treat specially a
+ -- number of node rewritings that are required by semantic processing
+ -- and which change the kind of nodes in the generic copy: typically
+ -- constant-folding, replacing an operator node by a string literal, or
+ -- a selected component by an expanded name. In each of those cases, the
+ -- transformation is propagated to the generic unit.
procedure Save_References (N : Node_Id) is
begin
and then Ekind (Entity (N2)) = E_Enumeration_Literal
then
-- Same if call was folded into a literal, but in this case
- -- retain the entity to avoid spurious ambiguities if id is
+ -- retain the entity to avoid spurious ambiguities if it is
-- overloaded at the point of instantiation or inlining.
Rewrite (N, New_Copy (N2));
projects / platform / upstream / linaro-gcc.git / commitdiff