This patch ensures that abort-related expansion generates the same amount of
internal entities when aborts are allowed or are being suppressed by pragma
Restriction (No_Abort_Statements).
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-29 Hristian Kirtchev <kirtc...@adacore.com>
* exp_ch3.adb (Default_Initialize_Object): Add new variables
Abrt_Blk and Dummy. Generate a dummy temporary when aborts are
not allowed to ensure the symmetrical generation of symbols.
* exp_ch7.adb (Build_Object_Declarations): Remove variables A_Expr
and E_Decl. Add new variables Decl and Dummy. Generate a dummy
temporary when aborts are not allowed to ensure symmertrical
generation of symbols.
* exp_intr.adb (Expand_Unc_Deallocation): Add new variable
Dummy. Generate a dummy temporary when aborts are not allowed
to ensure symmertrical generation of symbols.
Index: exp_ch7.adb
===================================================================
--- exp_ch7.adb (revision 213156)
+++ exp_ch7.adb (working copy)
@@ -3134,9 +3134,13 @@
Loc : Source_Ptr;
For_Package : Boolean := False)
is
- A_Expr : Node_Id;
- E_Decl : Node_Id;
+ Decl : Node_Id;
+ Dummy : Entity_Id;
+ pragma Unreferenced (Dummy);
+ -- This variable captures an unused dummy internal entity, see the
+ -- comment associated with its use.
+
begin
pragma Assert (Decls /= No_List);
@@ -3164,56 +3168,61 @@
-- does not include routine Raise_From_Controlled_Operation which is the
-- the sole user of flag Abort.
- -- This is not needed for library-level finalizers as they are called
- -- by the environment task and cannot be aborted.
+ -- This is not needed for library-level finalizers as they are called by
+ -- the environment task and cannot be aborted.
- if Abort_Allowed
- and then VM_Target = No_VM
- and then not For_Package
- then
- Data.Abort_Id := Make_Temporary (Loc, 'A');
+ if VM_Target = No_VM and then not For_Package then
+ if Abort_Allowed then
+ Data.Abort_Id := Make_Temporary (Loc, 'A');
- A_Expr := New_Occurrence_Of (RTE (RE_Triggered_By_Abort), Loc);
+ -- Generate:
+ -- Abort_Id : constant Boolean := <A_Expr>;
- -- Generate:
+ Append_To (Decls,
+ Make_Object_Declaration (Loc,
+ Defining_Identifier => Data.Abort_Id,
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Boolean, Loc),
+ Expression =>
+ New_Occurrence_Of (RTE (RE_Triggered_By_Abort), Loc)));
- -- Abort_Id : constant Boolean := <A_Expr>;
+ -- Abort is not required
- Append_To (Decls,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Data.Abort_Id,
- Constant_Present => True,
- Object_Definition => New_Occurrence_Of (Standard_Boolean, Loc),
- Expression => A_Expr));
+ else
+ -- Generate a dummy entity to ensure that the internal symbols are
+ -- in sync when a unit is compiled with and without aborts.
+ Dummy := Make_Temporary (Loc, 'A');
+ Data.Abort_Id := Empty;
+ end if;
+
+ -- .NET/JVM or library-level finalizers
+
else
- -- No abort, .NET/JVM or library-level finalizers
-
- Data.Abort_Id := Empty;
+ Data.Abort_Id := Empty;
end if;
if Exception_Extra_Info then
- Data.E_Id := Make_Temporary (Loc, 'E');
+ Data.E_Id := Make_Temporary (Loc, 'E');
-- Generate:
-
-- E_Id : Exception_Occurrence;
- E_Decl :=
+ Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Data.E_Id,
Object_Definition =>
New_Occurrence_Of (RTE (RE_Exception_Occurrence), Loc));
- Set_No_Initialization (E_Decl);
+ Set_No_Initialization (Decl);
- Append_To (Decls, E_Decl);
+ Append_To (Decls, Decl);
else
- Data.E_Id := Empty;
+ Data.E_Id := Empty;
end if;
-- Generate:
-
-- Raised_Id : Boolean := False;
Append_To (Decls,
Index: exp_intr.adb
===================================================================
--- exp_intr.adb (revision 213156)
+++ exp_intr.adb (working copy)
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --
-- --
-- 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- --
@@ -914,6 +914,7 @@
Finalizer_Data : Finalization_Exception_Data;
Blk : Node_Id := Empty;
+ Blk_Id : Entity_Id;
Deref : Node_Id;
Final_Code : List_Id;
Free_Arg : Node_Id;
@@ -926,6 +927,11 @@
-- that we analyze some generated statements before properly attaching
-- them to the tree, and that can disturb current value settings.
+ Dummy : Entity_Id;
+ pragma Unreferenced (Dummy);
+ -- This variable captures an unused dummy internal entity, see the
+ -- comment associated with its use.
+
begin
-- Nothing to do if we know the argument is null
@@ -1007,8 +1013,7 @@
-- protected by an abort defer/undefer pair.
if Abort_Allowed then
- Prepend_To (Final_Code,
- Build_Runtime_Call (Loc, RE_Abort_Defer));
+ Prepend_To (Final_Code, Build_Runtime_Call (Loc, RE_Abort_Defer));
Blk :=
Make_Block_Statement (Loc, Handled_Statement_Sequence =>
@@ -1016,9 +1021,15 @@
Statements => Final_Code,
At_End_Proc =>
New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc)));
+ Add_Block_Identifier (Blk, Blk_Id);
Append (Blk, Stmts);
+
else
+ -- Generate a dummy entity to ensure that the internal symbols are
+ -- in sync when a unit is compiled with and without aborts.
+
+ Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
Append_List_To (Stmts, Final_Code);
end if;
end if;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 213156)
+++ exp_ch3.adb (working copy)
@@ -5031,6 +5031,7 @@
-- Local variables
+ Abrt_Blk : Node_Id;
Abrt_HSS : Node_Id;
Abrt_Id : Entity_Id;
Abrt_Stmts : List_Id;
@@ -5041,6 +5042,11 @@
Obj_Init : Node_Id := Empty;
Obj_Ref : Node_Id;
+ Dummy : Entity_Id;
+ pragma Unreferenced (Dummy);
+ -- This variable captures an unused dummy internal entity, see the
+ -- comment associated with its use.
+
-- Start of processing for Default_Initialize_Object
begin
@@ -5205,48 +5211,54 @@
-- Step 3b: Build the abort block (if applicable)
- -- The abort block is required when aborts are allowed and there is
- -- at least one initialization call that needs protection.
+ -- The abort block is required when aborts are allowed in order to
+ -- protect both initialization calls.
- if Abort_Allowed
- and then Present (Comp_Init)
- and then Present (Obj_Init)
- then
- -- Generate:
- -- Abort_Defer;
+ if Present (Comp_Init) and then Present (Obj_Init) then
+ if Abort_Allowed then
- Prepend_To (Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
+ -- Generate:
+ -- Abort_Defer;
- -- Generate:
- -- begin
- -- Abort_Defer;
- -- <finalization statements>
- -- at end
- -- Abort_Undefer_Direct;
- -- end;
+ Prepend_To
+ (Fin_Stmts, Build_Runtime_Call (Loc, RE_Abort_Defer));
- Abrt_Id := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
- Set_Etype (Abrt_Id, Standard_Void_Type);
- Set_Scope (Abrt_Id, Current_Scope);
+ -- Generate:
+ -- begin
+ -- Abort_Defer;
+ -- <finalization statements>
+ -- at end
+ -- Abort_Undefer_Direct;
+ -- end;
- Abrt_HSS :=
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Fin_Stmts,
- At_End_Proc =>
- New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
+ Abrt_HSS :=
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Fin_Stmts,
+ At_End_Proc =>
+ New_Occurrence_Of (RTE (RE_Abort_Undefer_Direct), Loc));
- Abrt_Stmts := New_List (
- Make_Block_Statement (Loc,
- Identifier => New_Occurrence_Of (Abrt_Id, Loc),
- Declarations => No_List,
- Handled_Statement_Sequence => Abrt_HSS));
+ Abrt_Blk :=
+ Make_Block_Statement (Loc,
+ Declarations => No_List,
+ Handled_Statement_Sequence => Abrt_HSS);
- Expand_At_End_Handler (Abrt_HSS, Abrt_Id);
+ Add_Block_Identifier (Abrt_Blk, Abrt_Id);
+ Expand_At_End_Handler (Abrt_HSS, Abrt_Id);
- -- Abort is not required, the construct from Step 3a is to be added
- -- in the tree (either finalization block or single initialization
- -- call).
+ Abrt_Stmts := New_List (Abrt_Blk);
+ -- Abort is not required
+
+ else
+ -- Generate a dummy entity to ensure that the internal symbols
+ -- are in sync when a unit is compiled with and without aborts.
+
+ Dummy := New_Internal_Entity (E_Block, Current_Scope, Loc, 'B');
+ Abrt_Stmts := Fin_Stmts;
+ end if;
+
+ -- No initialization calls present
+
else
Abrt_Stmts := Fin_Stmts;
end if;
