This patch corrects the check of a Global item of mode In_Out or Out that
appear as an input in the Global aspect of an enclosing subprogram. Prior to
this patch, the check caused an infinite loop in certain scenarios.
------------
-- Source --
------------
-- stack_overflow.adb
procedure Stack_Overflow is
X : Integer;
procedure Error
with Global => (Input => X)
is
procedure OK_1
with Global => (In_Out => X)
is
procedure OK_2 (Par1 : out Integer)
with Global => (In_Out => X)
is
begin
X := X + 1;
Par1 := X;
end OK_2;
begin
null;
end OK_1;
begin
null;
end Error;
begin
null;
end Stack_Overflow;
-----------------
-- Compilation --
-----------------
$ gcc -c -gnat12 -gnatd.V stack_overflow.adb
stack_overflow.adb:8:36: global item "X" cannot have mode In_Out or Output
stack_overflow.adb:8:36: item already appears as input of subprogram "Error"
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-09-10 Hristian Kirtchev <[email protected]>
* sem_prag.adb (Check_Mode_Restriction_In_Enclosing_Context): Add local
variable Context. Remove local variable Subp_Id. Start the
context traversal from the current subprogram rather than the
current scope. Update the scope traversal and error reporting.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 202453)
+++ sem_prag.adb (working copy)
@@ -1514,22 +1514,24 @@
(Item : Node_Id;
Item_Id : Entity_Id)
is
+ Context : Entity_Id;
Dummy : Boolean;
Inputs : Elist_Id := No_Elist;
Outputs : Elist_Id := No_Elist;
- Subp_Id : Entity_Id;
begin
-- Traverse the scope stack looking for enclosing subprograms
-- subject to aspect/pragma Global.
- Subp_Id := Scope (Current_Scope);
- while Present (Subp_Id) and then Subp_Id /= Standard_Standard loop
- if Is_Subprogram (Subp_Id)
- and then Has_Aspect (Subp_Id, Aspect_Global)
+ Context := Scope (Subp_Id);
+ while Present (Context)
+ and then Context /= Standard_Standard
+ loop
+ if Is_Subprogram (Context)
+ and then Has_Aspect (Context, Aspect_Global)
then
Collect_Subprogram_Inputs_Outputs
- (Subp_Id => Subp_Id,
+ (Subp_Id => Context,
Subp_Inputs => Inputs,
Subp_Outputs => Outputs,
Global_Seen => Dummy);
@@ -1545,11 +1547,15 @@
Item, Item_Id);
Error_Msg_NE
("\item already appears as input of subprogram &",
- Item, Subp_Id);
+ Item, Context);
+
+ -- Stop the traversal once an error has been detected
+
+ exit;
end if;
end if;
- Subp_Id := Scope (Subp_Id);
+ Context := Scope (Context);
end loop;
end Check_Mode_Restriction_In_Enclosing_Context;
