===================================================================
@@ -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;
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 <kirtchev@adacore.com> * 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.