This patch update the mechanism which retrieves the enclosing scope of a node
to account for blocks produces by exception handler expansion. These blocks are
not scoping constructs and should not be considered. As a result, an access-
before-elaboration check will no longer cause a crash on ZFP.
------------
-- Source --
------------
-- pack.ads
package Pack is
procedure Force_Body;
end Pack;
-- pack.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Pack is
procedure Force_Body is begin null; end Force_Body;
package Nested is
function Func (Val : Integer) return Integer;
end Nested;
package body Nested is
procedure Proc is
Val : Integer;
begin
Val := Func (1);
Put_Line ("ERROR: Program_Error not raised");
exception
when Program_Error =>
Put_Line ("OK");
when others =>
Put_Line ("ERROR: unexpected exception");
end Proc;
package Elaborator is
end Elaborator;
package body Elaborator is
begin
Proc;
end Elaborator;
function Func (Val : Integer) return Integer is
begin
return Val + 1;
end Func;
end Nested;
end Pack;
-----------------
-- Compilation --
-----------------
$ gcc -c -gnatws --RTS=zfp pack.adb
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-10-09 Hristian Kirtchev <kirtc...@adacore.com>
* sem_unit.adb (Find_Enclosing_Scope): Do not treat a block statement
as a scoping construct when it is byproduct of exception handling.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 253567)
+++ sem_util.adb (working copy)
@@ -7929,13 +7929,21 @@
-- Special cases
- -- Blocks, loops, and return statements have artificial scopes
+ -- Blocks carry either a source or an internally-generated scope,
+ -- unless the block is a byproduct of exception handling.
- when N_Block_Statement
- | N_Loop_Statement
- =>
+ when N_Block_Statement =>
+ if not Exception_Junk (Par) then
+ return Entity (Identifier (Par));
+ end if;
+
+ -- Loops carry an internally-generated scope
+
+ when N_Loop_Statement =>
return Entity (Identifier (Par));
+ -- Extended return statements carry an internally-generated scope
+
when N_Extended_Return_Statement =>
return Return_Statement_Entity (Par);
@@ -19511,13 +19519,13 @@
N := Next (Actual_Id);
if Nkind (N) = N_Parameter_Association then
+
-- In case of a build-in-place call, the call will no longer be a
-- call; it will have been rewritten.
- if Nkind_In (Parent (Actual_Id),
- N_Entry_Call_Statement,
- N_Function_Call,
- N_Procedure_Call_Statement)
+ if Nkind_In (Parent (Actual_Id), N_Entry_Call_Statement,
+ N_Function_Call,
+ N_Procedure_Call_Statement)
then
return First_Named_Actual (Parent (Actual_Id));
else
@@ -23257,16 +23265,15 @@
return "unknown subprogram";
end if;
+ -- If the subprogram is a child unit, use its simple name to start the
+ -- construction of the fully qualified name.
+
if Nkind (Ent) = N_Defining_Program_Unit_Name then
-
- -- If the subprogram is a child unit, use its simple name to
- -- start the construction of the fully qualified name.
-
Append_Entity_Name (Buf, Defining_Identifier (Ent));
-
else
Append_Entity_Name (Buf, Ent);
end if;
+
return +Buf;
end Subprogram_Name;
