aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-29 15:01:34 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-29 15:01:34 +0200
commit60370fb12798f314c3fd4f8cbb557a4cc9a164c1 (patch)
tree7412f8c28844cfbce864ebf8faec6233f94235e8
parente9c9d12236905df71cc9d5132d9fb632fb8f269e (diff)
downloadgcc-60370fb12798f314c3fd4f8cbb557a4cc9a164c1.zip
gcc-60370fb12798f314c3fd4f8cbb557a4cc9a164c1.tar.gz
gcc-60370fb12798f314c3fd4f8cbb557a4cc9a164c1.tar.bz2
[multiple changes]
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com> * s-finmas.adb (Finalize): Check Finalize_Address of the master rather than the current node. * s-finmas.ads: Move field Finalize_Address from type FM_Node to Finalization_Master. The list headers have two fields instead of three. This should fix alignment issue but subpool allocations are now unusable. Alphabetize subprograms. * s-stposu.adb (Allocate_Any_Controlled): Use the offset rather than the size of the header when converting the beginning of the object to a FM_Node. Set the master's Finalize_Address attribute if not already set. (Deallocate_Any_Controlled): Use the offset rather than the size of the header when converting the beginning of the object to a FM_Node. 2011-08-29 Gary Dismukes <dismukes@adacore.com> * exp_ch11.adb (Expand_N_Raise_Statement): Don't suppress expansion of reraise when compiling for CodePeer. 2011-08-29 Arnaud Charlet <charlet@adacore.com> * a-iteint.ads, Makefile.rtl: Add missing compilation of a-iteint.ads, now needed by a-convec.adb. Fix warning. 2011-08-29 Hristian Kirtchev <kirtchev@adacore.com> * exp_util.adb (Build_Allocate_Deallocate_Proc): Add a guard for the processing of TSS routine Finalize_Address when compiling in CodePeer_Mode. 2011-08-29 Thomas Quinot <quinot@adacore.com> * a-strunb.ads, einfo.ads, g-comlin.ads, sem_ch6.adb, sem_warn.adb: Minor reformatting. 2011-08-29 Emmanuel Briot <briot@adacore.com> * prj-conf.adb (Get_Config_Switches): Also collect the list of languages from aggregated projects. 2011-08-29 Yannick Moy <moy@adacore.com> * lib-xref-alfa.adb, lib-xref.ads (Traverse_Declarations_Or_Statements, Traverse_Handled_Statement_Sequence, Traverse_Package_Body, Traverse_Package_Declaration, Traverse_Subprogram_Body, Traverse_Compilation_Unit): Add a parameter Inside_Stubs so that bodies for stubs are traversed too when parameter is set (Traverse_All_Compilation_Units): Traverse without going inside stubs (Traverse_Declarations_Or_Statements): Do the special traversing for stubs when required. * sem_util.adb, sem_util.ads (Get_Body_From_Stub): New function to return subprogram or package body from stub. (Is_Subprogram_Stub_Without_Prior_Declaration): New function to detect stubs without prior subprogram decl. 2011-08-29 Vasiliy Fofanov <fofanov@adacore.com> * gnat_ugn.texi: Fix typo. From-SVN: r178219
-rw-r--r--gcc/ada/ChangeLog60
-rw-r--r--gcc/ada/Makefile.rtl1
-rw-r--r--gcc/ada/a-iteint.ads1
-rw-r--r--gcc/ada/a-strunb.ads4
-rw-r--r--gcc/ada/einfo.ads22
-rw-r--r--gcc/ada/exp_ch11.adb4
-rw-r--r--gcc/ada/exp_util.adb8
-rw-r--r--gcc/ada/g-comlin.ads3
-rw-r--r--gcc/ada/gnat_ugn.texi2
-rw-r--r--gcc/ada/lib-xref-alfa.adb133
-rw-r--r--gcc/ada/lib-xref.ads5
-rw-r--r--gcc/ada/prj-conf.adb70
-rw-r--r--gcc/ada/s-finmas.adb36
-rw-r--r--gcc/ada/s-finmas.ads14
-rw-r--r--gcc/ada/s-stposu.adb10
-rw-r--r--gcc/ada/sem_ch6.adb2
-rw-r--r--gcc/ada/sem_util.adb25
-rw-r--r--gcc/ada/sem_util.ads8
-rw-r--r--gcc/ada/sem_warn.adb4
19 files changed, 287 insertions, 125 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5ff1db5..3d4853f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,65 @@
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
+ * s-finmas.adb (Finalize): Check Finalize_Address of the master rather
+ than the current node.
+ * s-finmas.ads: Move field Finalize_Address from type FM_Node to
+ Finalization_Master. The list headers have two fields instead of three.
+ This should fix alignment issue but subpool allocations are now
+ unusable. Alphabetize subprograms.
+ * s-stposu.adb (Allocate_Any_Controlled): Use the offset rather than
+ the size of the header when converting the beginning of the object to
+ a FM_Node. Set the master's Finalize_Address attribute if not already
+ set.
+ (Deallocate_Any_Controlled): Use the offset rather than the size of the
+ header when converting the beginning of the object to a FM_Node.
+
+2011-08-29 Gary Dismukes <dismukes@adacore.com>
+
+ * exp_ch11.adb (Expand_N_Raise_Statement): Don't suppress expansion of
+ reraise when compiling for CodePeer.
+
+2011-08-29 Arnaud Charlet <charlet@adacore.com>
+
+ * a-iteint.ads, Makefile.rtl: Add missing compilation of a-iteint.ads,
+ now needed by a-convec.adb. Fix warning.
+
+2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.adb (Build_Allocate_Deallocate_Proc): Add a guard for the
+ processing of TSS routine Finalize_Address when compiling in
+ CodePeer_Mode.
+
+2011-08-29 Thomas Quinot <quinot@adacore.com>
+
+ * a-strunb.ads, einfo.ads, g-comlin.ads, sem_ch6.adb,
+ sem_warn.adb: Minor reformatting.
+
+2011-08-29 Emmanuel Briot <briot@adacore.com>
+
+ * prj-conf.adb (Get_Config_Switches): Also collect the list of
+ languages from aggregated projects.
+
+2011-08-29 Yannick Moy <moy@adacore.com>
+
+ * lib-xref-alfa.adb, lib-xref.ads (Traverse_Declarations_Or_Statements,
+ Traverse_Handled_Statement_Sequence, Traverse_Package_Body,
+ Traverse_Package_Declaration, Traverse_Subprogram_Body,
+ Traverse_Compilation_Unit): Add a parameter Inside_Stubs so that bodies
+ for stubs are traversed too when parameter is set
+ (Traverse_All_Compilation_Units): Traverse without going inside stubs
+ (Traverse_Declarations_Or_Statements): Do the special traversing for
+ stubs when required.
+ * sem_util.adb, sem_util.ads (Get_Body_From_Stub): New function to
+ return subprogram or package body from stub.
+ (Is_Subprogram_Stub_Without_Prior_Declaration): New function to detect
+ stubs without prior subprogram decl.
+
+2011-08-29 Vasiliy Fofanov <fofanov@adacore.com>
+
+ * gnat_ugn.texi: Fix typo.
+
+2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
+
* s-stposu.adb (Allocate_Any_Controlled): Reimplement the mechanism
which accounts for size vs alignment issues and calculates the size of
the list header.
diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl
index 683c15aa..3115cb7 100644
--- a/gcc/ada/Makefile.rtl
+++ b/gcc/ada/Makefile.rtl
@@ -161,6 +161,7 @@ GNATRTL_NONTASKING_OBJS= \
a-fzteio$(objext) \
a-inteio$(objext) \
a-ioexce$(objext) \
+ a-iteint$(objext) \
a-iwteio$(objext) \
a-izteio$(objext) \
a-lcteio$(objext) \
diff --git a/gcc/ada/a-iteint.ads b/gcc/ada/a-iteint.ads
index c6aaa76..192bdcb 100644
--- a/gcc/ada/a-iteint.ads
+++ b/gcc/ada/a-iteint.ads
@@ -33,6 +33,7 @@
generic
type Cursor;
with function Has_Element (Position : Cursor) return Boolean;
+ pragma Unreferenced (Has_Element);
package Ada.Iterator_Interfaces is
pragma Pure;
diff --git a/gcc/ada/a-strunb.ads b/gcc/ada/a-strunb.ads
index af063f0..3341466 100644
--- a/gcc/ada/a-strunb.ads
+++ b/gcc/ada/a-strunb.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -433,5 +433,5 @@ private
Null_Unbounded_String : constant Unbounded_String :=
(AF.Controlled with
Reference => Null_String'Access,
- Last => 0);
+ Last => 0);
end Ada.Strings.Unbounded;
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6f061d1..c60fdd1 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -1237,10 +1237,10 @@ package Einfo is
-- representation pragmas nodes and representation clause nodes that
-- apply to the entity, linked using Next_Rep_Item, with Empty marking
-- the end of the list. In the case of derived types and subtypes, the
--- new entity inherits the chain at the point of declaration. This
--- means that it is possible to have multiple instances of the same
--- kind of rep item on the chain, in which case it is the first one
--- that applies to the entity.
+-- new entity inherits the chain at the point of declaration. This means
+-- that it is possible to have multiple instances of the same kind of rep
+-- item on the chain, in which case it is the first one that applies to
+-- the entity.
--
-- Note: pragmas that can apply to more than one overloadable entity,
-- (Convention, Interface, Inline, Inline_Always, Import, Export,
@@ -1260,8 +1260,8 @@ package Einfo is
-- Linker_Section pragma
-- Weak_External pragma
--
--- If any of these items are present, then the flag Has_Gigi_Rep_Item
--- is set, indicating that Gigi should search the chain.
+-- If any of these items are present, then the flag Has_Gigi_Rep_Item is
+-- set, indicating that Gigi should search the chain.
--
-- Other representation items are included in the chain so that error
-- messages can easily locate the relevant nodes for posting errors.
@@ -1274,10 +1274,10 @@ package Einfo is
-- the floating-point representation to be used.
-- Freeze_Node (Node7)
--- Present in all entities. If there is an associated freeze node for
--- the entity, this field references this freeze node. If no freeze
--- node is associated with the entity, then this field is Empty. See
--- package Freeze for further details.
+-- Present in all entities. If there is an associated freeze node for the
+-- entity, this field references this freeze node. If no freeze node is
+-- associated with the entity, then this field is Empty. See package
+-- Freeze for further details.
-- From_With_Type (Flag159)
-- Present in package and type entities. Indicates that the entity
@@ -3265,7 +3265,7 @@ package Einfo is
-- Package_Instantiation (Node26)
-- Present in packages and generic packages. When present, this field
--- references an N_Package_Instantiation node associated with an
+-- references an N_Generic_Instantiation node associated with an
-- instantiated package. In the case where the referenced node has
-- been rewritten to an N_Package_Specification, the instantiation
-- node is available from the Original_Node field of the package spec
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index 2f16743..ceca349 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -1666,9 +1666,11 @@ package body Exp_Ch11 is
else
- -- Don't expand if back end exception handling active
+ -- Bypass expansion to a run-time call when back-end exception
+ -- handling is active, unless the target is a VM or CodePeer.
if VM_Target = No_VM
+ and then not CodePeer_Mode
and then Exception_Mechanism = Back_End_Exceptions
then
return;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 0d1f73c..d712570 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -628,9 +628,13 @@ package body Exp_Util is
-- d) Finalize_Address
- Fin_Addr_Id := Find_Finalize_Address (Desig_Typ);
+ -- Primitive Finalize_Address is never generated in CodePeer mode
+ -- since it contains an Unchecked_Conversion.
- if Needs_Finalization (Desig_Typ) then
+ if Needs_Finalization (Desig_Typ)
+ and then not CodePeer_Mode
+ then
+ Fin_Addr_Id := Find_Finalize_Address (Desig_Typ);
pragma Assert (Present (Fin_Addr_Id));
Append_To (Actuals,
diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads
index 0c4c96e..ec84280 100644
--- a/gcc/ada/g-comlin.ads
+++ b/gcc/ada/g-comlin.ads
@@ -492,11 +492,12 @@ package GNAT.Command_Line is
Invalid_Parameter : exception;
-- Raised when a parameter is missing, or an attempt is made to obtain a
- -- parameter for a switch that does not allow a parameter
+ -- parameter for a switch that does not allow a parameter.
-----------------------------------------
-- Expansion of command line arguments --
-----------------------------------------
+
-- These subprograms take care of of expanding globbing patterns on the
-- command line. On Unix, such expansion is done by the shell before your
-- application is called. But on Windows you must do this expansion
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 64a4489..def9349 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -21373,7 +21373,7 @@ information about several specific platforms.
@item @code{@ @ @ @ }Tasking @tab native Win32 threads
@item @code{@ @ @ @ }Exceptions @tab ZCX
@*
-@item @code{@ @ }@i{rts-sjlj (default)}
+@item @code{@ @ }@i{rts-sjlj}
@item @code{@ @ @ @ }Tasking @tab native Win32 threads
@item @code{@ @ @ @ }Exceptions @tab SJLJ
@*
diff --git a/gcc/ada/lib-xref-alfa.adb b/gcc/ada/lib-xref-alfa.adb
index 58c4ecc..75dea7f 100644
--- a/gcc/ada/lib-xref-alfa.adb
+++ b/gcc/ada/lib-xref-alfa.adb
@@ -165,20 +165,25 @@ package body ALFA is
-- Hash function for hash table
procedure Traverse_Declarations_Or_Statements
- (L : List_Id;
- Process : Node_Processing);
+ (L : List_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_Handled_Statement_Sequence
- (N : Node_Id;
- Process : Node_Processing);
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_Package_Body
- (N : Node_Id;
- Process : Node_Processing);
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_Package_Declaration
- (N : Node_Id;
- Process : Node_Processing);
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_Subprogram_Body
- (N : Node_Id;
- Process : Node_Processing);
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
-- Traverse the corresponding constructs, calling Process on all
-- declarations.
@@ -201,7 +206,8 @@ package body ALFA is
From := ALFA_Scope_Table.Last + 1;
- Traverse_Compilation_Unit (Cunit (U), Detect_And_Add_ALFA_Scope'Access);
+ Traverse_Compilation_Unit (Cunit (U), Detect_And_Add_ALFA_Scope'Access,
+ Inside_Stubs => False);
-- Update scope numbers
@@ -904,7 +910,7 @@ package body ALFA is
procedure Traverse_All_Compilation_Units (Process : Node_Processing) is
begin
for U in Units.First .. Last_Unit loop
- Traverse_Compilation_Unit (Cunit (U), Process);
+ Traverse_Compilation_Unit (Cunit (U), Process, Inside_Stubs => False);
end loop;
end Traverse_All_Compilation_Units;
@@ -913,8 +919,9 @@ package body ALFA is
-------------------------------
procedure Traverse_Compilation_Unit
- (CU : Node_Id;
- Process : Node_Processing)
+ (CU : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean)
is
Lu : Node_Id;
@@ -938,16 +945,16 @@ package body ALFA is
-- Traverse the unit
if Nkind (Lu) = N_Subprogram_Body then
- Traverse_Subprogram_Body (Lu, Process);
+ Traverse_Subprogram_Body (Lu, Process, Inside_Stubs);
elsif Nkind (Lu) = N_Subprogram_Declaration then
null;
elsif Nkind (Lu) = N_Package_Declaration then
- Traverse_Package_Declaration (Lu, Process);
+ Traverse_Package_Declaration (Lu, Process, Inside_Stubs);
elsif Nkind (Lu) = N_Package_Body then
- Traverse_Package_Body (Lu, Process);
+ Traverse_Package_Body (Lu, Process, Inside_Stubs);
-- ??? TBD
@@ -972,8 +979,9 @@ package body ALFA is
-----------------------------------------
procedure Traverse_Declarations_Or_Statements
- (L : List_Id;
- Process : Node_Processing)
+ (L : List_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean)
is
N : Node_Id;
@@ -996,7 +1004,7 @@ package body ALFA is
-- Package declaration
when N_Package_Declaration =>
- Traverse_Package_Declaration (N, Process);
+ Traverse_Package_Declaration (N, Process, Inside_Stubs);
-- Generic package declaration ??? TBD
@@ -1007,9 +1015,21 @@ package body ALFA is
when N_Package_Body =>
if Ekind (Defining_Entity (N)) /= E_Generic_Package then
- Traverse_Package_Body (N, Process);
+ Traverse_Package_Body (N, Process, Inside_Stubs);
end if;
+ when N_Package_Body_Stub =>
+ declare
+ Body_N : constant Node_Id := Get_Body_From_Stub (N);
+ begin
+ if Inside_Stubs
+ and then
+ Ekind (Defining_Entity (Body_N)) /= E_Generic_Package
+ then
+ Traverse_Package_Body (Body_N, Process, Inside_Stubs);
+ end if;
+ end;
+
-- Subprogram declaration
when N_Subprogram_Declaration =>
@@ -1024,22 +1044,35 @@ package body ALFA is
when N_Subprogram_Body =>
if not Is_Generic_Subprogram (Defining_Entity (N)) then
- Traverse_Subprogram_Body (N, Process);
+ Traverse_Subprogram_Body (N, Process, Inside_Stubs);
end if;
+ when N_Subprogram_Body_Stub =>
+ declare
+ Body_N : constant Node_Id := Get_Body_From_Stub (N);
+ begin
+ if Inside_Stubs
+ and then
+ not Is_Generic_Subprogram (Defining_Entity (Body_N))
+ then
+ Traverse_Subprogram_Body (Body_N, Process, Inside_Stubs);
+ end if;
+ end;
+
-- Block statement
when N_Block_Statement =>
- Traverse_Declarations_Or_Statements (Declarations (N), Process);
+ Traverse_Declarations_Or_Statements
+ (Declarations (N), Process, Inside_Stubs);
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N), Process);
+ (Handled_Statement_Sequence (N), Process, Inside_Stubs);
when N_If_Statement =>
-- Traverse the statements in the THEN part
Traverse_Declarations_Or_Statements
- (Then_Statements (N), Process);
+ (Then_Statements (N), Process, Inside_Stubs);
-- Loop through ELSIF parts if present
@@ -1050,7 +1083,7 @@ package body ALFA is
begin
while Present (Elif) loop
Traverse_Declarations_Or_Statements
- (Then_Statements (Elif), Process);
+ (Then_Statements (Elif), Process, Inside_Stubs);
Next (Elif);
end loop;
end;
@@ -1059,7 +1092,7 @@ package body ALFA is
-- Finally traverse the ELSE statements if present
Traverse_Declarations_Or_Statements
- (Else_Statements (N), Process);
+ (Else_Statements (N), Process, Inside_Stubs);
-- Case statement
@@ -1073,7 +1106,7 @@ package body ALFA is
Alt := First (Alternatives (N));
while Present (Alt) loop
Traverse_Declarations_Or_Statements
- (Statements (Alt), Process);
+ (Statements (Alt), Process, Inside_Stubs);
Next (Alt);
end loop;
end;
@@ -1082,12 +1115,13 @@ package body ALFA is
when N_Extended_Return_Statement =>
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N), Process);
+ (Handled_Statement_Sequence (N), Process, Inside_Stubs);
-- Loop
when N_Loop_Statement =>
- Traverse_Declarations_Or_Statements (Statements (N), Process);
+ Traverse_Declarations_Or_Statements
+ (Statements (N), Process, Inside_Stubs);
when others =>
null;
@@ -1102,20 +1136,22 @@ package body ALFA is
-----------------------------------------
procedure Traverse_Handled_Statement_Sequence
- (N : Node_Id;
- Process : Node_Processing)
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean)
is
Handler : Node_Id;
begin
if Present (N) then
- Traverse_Declarations_Or_Statements (Statements (N), Process);
+ Traverse_Declarations_Or_Statements
+ (Statements (N), Process, Inside_Stubs);
if Present (Exception_Handlers (N)) then
Handler := First (Exception_Handlers (N));
while Present (Handler) loop
Traverse_Declarations_Or_Statements
- (Statements (Handler), Process);
+ (Statements (Handler), Process, Inside_Stubs);
Next (Handler);
end loop;
end if;
@@ -1127,12 +1163,14 @@ package body ALFA is
---------------------------
procedure Traverse_Package_Body
- (N : Node_Id;
- Process : Node_Processing) is
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean) is
begin
- Traverse_Declarations_Or_Statements (Declarations (N), Process);
+ Traverse_Declarations_Or_Statements
+ (Declarations (N), Process, Inside_Stubs);
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N), Process);
+ (Handled_Statement_Sequence (N), Process, Inside_Stubs);
end Traverse_Package_Body;
----------------------------------
@@ -1140,15 +1178,16 @@ package body ALFA is
----------------------------------
procedure Traverse_Package_Declaration
- (N : Node_Id;
- Process : Node_Processing)
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean)
is
Spec : constant Node_Id := Specification (N);
begin
Traverse_Declarations_Or_Statements
- (Visible_Declarations (Spec), Process);
+ (Visible_Declarations (Spec), Process, Inside_Stubs);
Traverse_Declarations_Or_Statements
- (Private_Declarations (Spec), Process);
+ (Private_Declarations (Spec), Process, Inside_Stubs);
end Traverse_Package_Declaration;
------------------------------
@@ -1156,12 +1195,14 @@ package body ALFA is
------------------------------
procedure Traverse_Subprogram_Body
- (N : Node_Id;
- Process : Node_Processing) is
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean) is
begin
- Traverse_Declarations_Or_Statements (Declarations (N), Process);
+ Traverse_Declarations_Or_Statements
+ (Declarations (N), Process, Inside_Stubs);
Traverse_Handled_Statement_Sequence
- (Handled_Statement_Sequence (N), Process);
+ (Handled_Statement_Sequence (N), Process, Inside_Stubs);
end Traverse_Subprogram_Body;
end ALFA;
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index ecee22a..60c4b35 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -593,8 +593,9 @@ package Lib.Xref is
type Node_Processing is access procedure (N : Node_Id);
procedure Traverse_Compilation_Unit
- (CU : Node_Id;
- Process : Node_Processing);
+ (CU : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_All_Compilation_Units (Process : Node_Processing);
-- Call Process on all declarations through all compilation units
diff --git a/gcc/ada/prj-conf.adb b/gcc/ada/prj-conf.adb
index a1d9fe9..c6e37ee 100644
--- a/gcc/ada/prj-conf.adb
+++ b/gcc/ada/prj-conf.adb
@@ -722,28 +722,32 @@ package body Prj.Conf is
-- Hash table to keep the languages used in the project tree
IDE : constant Package_Id :=
- Value_Of (Name_Ide, Project.Decl.Packages, Shared);
-
- Prj_Iter : Project_List;
- List : String_List_Id;
- Elem : String_Element;
- Lang : Name_Id;
- Variable : Variable_Value;
- Name : Name_Id;
- Count : Natural;
- Result : Argument_List_Access;
-
- Check_Default : Boolean;
-
- begin
- Prj_Iter := Project_Tree.Projects;
- while Prj_Iter /= null loop
- if Might_Have_Sources (Prj_Iter.Project) then
+ Value_Of (Name_Ide, Project.Decl.Packages, Shared);
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ With_State : in out Integer);
+ -- Add all --config switches for this project. This is also called
+ -- for aggregate projects.
+
+ procedure Add_Config_Switches_For_Project
+ (Project : Project_Id;
+ Tree : Project_Tree_Ref;
+ With_State : in out Integer)
+ is
+ pragma Unreferenced (With_State);
+ Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
+
+ Variable : Variable_Value;
+ Check_Default : Boolean;
+ Lang : Name_Id;
+ List : String_List_Id;
+ Elem : String_Element;
+ begin
+ if Might_Have_Sources (Project) then
Variable :=
- Value_Of
- (Name_Languages,
- Prj_Iter.Project.Decl.Attributes,
- Shared);
+ Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
if Variable = Nil_Variable_Value
or else Variable.Default
@@ -752,13 +756,13 @@ package body Prj.Conf is
-- project, or if it extends a project with no Languages,
-- check for Default_Language.
- Check_Default := Prj_Iter.Project.Extends = No_Project;
+ Check_Default := Project.Extends = No_Project;
if not Check_Default then
Variable :=
Value_Of
(Name_Languages,
- Prj_Iter.Project.Extends.Decl.Attributes,
+ Project.Extends.Decl.Attributes,
Shared);
Check_Default :=
Variable /= Nil_Variable_Value
@@ -769,7 +773,7 @@ package body Prj.Conf is
Variable :=
Value_Of
(Name_Default_Language,
- Prj_Iter.Project.Decl.Attributes,
+ Project.Decl.Attributes,
Shared);
if Variable /= Nil_Variable_Value
@@ -805,9 +809,23 @@ package body Prj.Conf is
end loop;
end if;
end if;
+ end Add_Config_Switches_For_Project;
- Prj_Iter := Prj_Iter.Next;
- end loop;
+ procedure For_Every_Imported_Project is new For_Every_Project_Imported
+ (State => Integer, Action => Add_Config_Switches_For_Project);
+
+ Name : Name_Id;
+ Count : Natural;
+ Result : Argument_List_Access;
+ Variable : Variable_Value;
+ Dummy : Integer := 0;
+
+ begin
+ For_Every_Imported_Project
+ (By => Project,
+ Tree => Project_Tree,
+ With_State => Dummy,
+ Include_Aggregated => True);
Name := Language_Htable.Get_First;
Count := 0;
diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
index 7a5be2c..71dbeb8 100644
--- a/gcc/ada/s-finmas.adb
+++ b/gcc/ada/s-finmas.adb
@@ -128,27 +128,23 @@ package body System.Finalization_Masters is
Curr_Ptr := Master.Objects.Next;
while Curr_Ptr /= Master.Objects'Unchecked_Access loop
+
+ -- If primitive Finalize_Address is not set, then the expansion of
+ -- the designated type or that of the allocator failed. This is a
+ -- serious error.
+
+ if Master.Finalize_Address = null then
+ raise Program_Error
+ with "primitive Finalize_Address not available";
+ end if;
+
+ -- Skip the list header in order to offer proper object layout for
+ -- finalization and call Finalize_Address.
+
+ Obj_Addr := Curr_Ptr.all'Address + Header_Offset;
+
begin
- -- If primitive Finalize_Address is not set, then the expansion of
- -- the designated type or that of the allocator failed. This is a
- -- serious error.
-
- -- Note: The Program_Error must be raised from the same block as
- -- the finalization call. If Finalize_Address is not present for
- -- a particular object, this should not stop the finalization of
- -- the remaining objects.
-
- if Curr_Ptr.Finalize_Address = null then
- raise Program_Error
- with "primitive Finalize_Address not available";
-
- -- Skip the list header in order to offer proper object layout for
- -- finalization and call Finalize_Address.
-
- else
- Obj_Addr := Curr_Ptr.all'Address + Header_Offset;
- Curr_Ptr.Finalize_Address (Obj_Addr);
- end if;
+ Master.Finalize_Address (Obj_Addr);
exception
when Fin_Occur : others =>
diff --git a/gcc/ada/s-finmas.ads b/gcc/ada/s-finmas.ads
index cd2b74c..3932021 100644
--- a/gcc/ada/s-finmas.ads
+++ b/gcc/ada/s-finmas.ads
@@ -56,9 +56,8 @@ package System.Finalization_Masters is
type FM_Node_Ptr is access all FM_Node;
type FM_Node is record
- Prev : FM_Node_Ptr := null;
- Next : FM_Node_Ptr := null;
- Finalize_Address : Finalize_Address_Ptr := null;
+ Prev : FM_Node_Ptr := null;
+ Next : FM_Node_Ptr := null;
end record;
-- A reference to any derivation from Root_Storage_Pool. Since this type
@@ -83,6 +82,9 @@ package System.Finalization_Masters is
-- A doubly linked list which contains the headers of all controlled
-- objects allocated in a [sub]pool.
+ Finalize_Address : Finalize_Address_Ptr := null;
+ -- A reference to the routine reponsible for object finalization
+
Finalization_Started : Boolean := False;
pragma Atomic (Finalization_Started);
-- A flag used to detect allocations which occur during the finalization
@@ -120,12 +122,12 @@ package System.Finalization_Masters is
-- the list of allocated controlled objects, finalizing each one by calling
-- its specific Finalize_Address. In the end, deallocate the dummy head.
- function Header_Size return System.Storage_Elements.Storage_Count;
- -- Return the size of type FM_Node as Storage_Count
-
function Header_Offset return System.Storage_Elements.Storage_Offset;
-- Return the size of type FM_Node as Storage_Offset
+ function Header_Size return System.Storage_Elements.Storage_Count;
+ -- Return the size of type FM_Node as Storage_Count
+
overriding procedure Initialize (Master : in out Finalization_Master);
-- Initialize the dummy head of a finalization master
diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
index d52625f..4fb0b96 100644
--- a/gcc/ada/s-stposu.adb
+++ b/gcc/ada/s-stposu.adb
@@ -247,10 +247,12 @@ package body System.Storage_Pools.Subpools is
-- | |
-- +- Header_And_Padding --+
- N_Ptr :=
- Address_To_FM_Node_Ptr (N_Addr + Header_And_Padding - Header_Size);
+ N_Ptr := Address_To_FM_Node_Ptr
+ (N_Addr + Header_And_Padding - Header_Offset);
- N_Ptr.Finalize_Address := Fin_Address;
+ if Master.Finalize_Address = null then
+ Master.Finalize_Address := Fin_Address;
+ end if;
-- Prepend the allocated object to the finalization master
@@ -334,7 +336,7 @@ package body System.Storage_Pools.Subpools is
-- Convert the bits preceding the object into a list header
- N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size);
+ N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Offset);
-- Detach the object from the related finalization master. This
-- action does not need to know the prior context used during
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d6eb55d..a4b0c3c 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -4716,7 +4716,7 @@ package body Sem_Ch6 is
-- Grouping (use of comma in param lists) must be the same
-- This is where we catch a misconformance like:
- -- A,B : Integer
+ -- A, B : Integer
-- A : Integer; B : Integer
-- which are represented identically in the tree except
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9c8d9c5..e6730f2 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -4168,6 +4168,15 @@ package body Sem_Util is
end if;
end Get_Actual_Subtype_If_Available;
+ ------------------------
+ -- Get_Body_From_Stub --
+ ------------------------
+
+ function Get_Body_From_Stub (N : Node_Id) return Node_Id is
+ begin
+ return Proper_Body (Unit (Library_Unit (N)));
+ end Get_Body_From_Stub;
+
-------------------------------
-- Get_Default_External_Name --
-------------------------------
@@ -7939,6 +7948,22 @@ package body Sem_Util is
or else Nkind (N) = N_Procedure_Call_Statement;
end Is_Statement;
+ --------------------------------------------------
+ -- Is_Subprogram_Stub_Without_Prior_Declaration --
+ --------------------------------------------------
+
+ function Is_Subprogram_Stub_Without_Prior_Declaration
+ (N : Node_Id) return Boolean is
+
+ begin
+ -- A subprogram stub without prior declaration serves as declaration for
+ -- the actual subprogram body. As such, it has an attached defining
+ -- entity of E_[Generic_]Function or E_[Generic_]Procedure.
+
+ return Nkind (N) = N_Subprogram_Body_Stub
+ and then Ekind (Defining_Entity (N)) /= E_Subprogram_Body;
+ end Is_Subprogram_Stub_Without_Prior_Declaration;
+
---------------------------------
-- Is_Synchronized_Tagged_Type --
---------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 1d0d23e..bc36fb2 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -479,6 +479,9 @@ package Sem_Util is
-- Actual_Subtype field of the corresponding entity is set, then it is
-- returned. Otherwise the Etype of the node is returned.
+ function Get_Body_From_Stub (N : Node_Id) return Node_Id;
+ -- Return the body node for a stub (subprogram or package)
+
function Get_Default_External_Name (E : Node_Or_Entity_Id) return Node_Id;
-- This is used to construct the string literal node representing a
-- default external name, i.e. one that is constructed from the name of an
@@ -884,6 +887,11 @@ package Sem_Util is
-- the N_Statement_Other_Than_Procedure_Call subtype from Sinfo).
-- Note that a label is *not* a statement, and will return False.
+ function Is_Subprogram_Stub_Without_Prior_Declaration
+ (N : Node_Id) return Boolean;
+ -- Return True if N is a subprogram stub with no prior subprogram
+ -- declaration.
+
function Is_Synchronized_Tagged_Type (E : Entity_Id) return Boolean;
-- Returns True if E is a synchronized tagged type (AARM 3.9.4 (6/2))
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 0fee04c..044efd8 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3340,12 +3340,12 @@ package body Sem_Warn is
if Is_Elementary_Type (Etype (Act1))
and then Ekind (Form2) = E_In_Parameter
then
- null; -- no real aliasing.
+ null; -- No real aliasing
elsif Is_Elementary_Type (Etype (Act2))
and then Ekind (Form2) = E_In_Parameter
then
- null; -- ditto
+ null; -- Ditto
-- If the call was written in prefix notation, and
-- thus its prefix before rewriting was a selected