Analysis of Relaxed_Initialization is heavily inspired by the existing
code for Global/Depends contract. There was one difference in dealing
with scope tables; it turns out that this difference was a mistake. Now
fixed.
Also, fix a mistake in querying the aspect property for subprogram
parameter, which needs to be examined by looking at the aspect of the
subprogram.
Tested on x86_64-pc-linux-gnu, committed on trunk
2020-06-15 Piotr Trojanek <troja...@adacore.com>
gcc/ada/
* sem_ch13.adb (Analyze_Aspect_Relaxed_Initialization): Fix
dealing with scopes on subprogram bodies that act as specs.
* sem_util.adb (Has_Relaxed_Initialization): Fix trivial
mistake.--- gcc/ada/sem_ch13.adb
+++ gcc/ada/sem_ch13.adb
@@ -2203,6 +2203,10 @@ package body Sem_Ch13 is
-- Items that appear in the relaxed initialization aspect
-- expression of a subprogram; for detecting duplicates.
+ Restore_Scope : Boolean;
+ -- Will be set to True if we need to restore the scope table
+ -- after analyzing the aspect expression.
+
-- Start of processing for Analyze_Aspect_Relaxed_Initialization
begin
@@ -2231,17 +2235,23 @@ package body Sem_Ch13 is
elsif Is_Subprogram (E) then
if Present (Expr) then
- -- Subprogram and its formal parameters must be visible
- -- when analyzing the aspect expression.
-
- pragma Assert (not In_Open_Scopes (E));
+ -- If we analyze subprogram body that acts as its own
+ -- spec, then the subprogram itself and its formals are
+ -- already installed; otherwise, we need to install them,
+ -- as they must be visible when analyzing the aspect
+ -- expression.
- Push_Scope (E);
-
- if Is_Generic_Subprogram (E) then
- Install_Generic_Formals (E);
+ if In_Open_Scopes (E) then
+ Restore_Scope := False;
else
- Install_Formals (E);
+ Restore_Scope := True;
+ Push_Scope (E);
+
+ if Is_Generic_Subprogram (E) then
+ Install_Generic_Formals (E);
+ else
+ Install_Formals (E);
+ end if;
end if;
-- Aspect expression is either an aggregate with list of
@@ -2281,7 +2291,9 @@ package body Sem_Ch13 is
Analyze_Relaxed_Parameter (E, Expr, Seen);
end if;
- End_Scope;
+ if Restore_Scope then
+ End_Scope;
+ end if;
else
Error_Msg_N ("missing expression for aspect %", N);
end if;
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -12511,7 +12511,8 @@ package body Sem_Util is
if Has_Aspect (Subp_Id, Aspect_Relaxed_Initialization) then
Aspect_Expr :=
- Find_Value_Of_Aspect (E, Aspect_Relaxed_Initialization);
+ Find_Value_Of_Aspect
+ (Subp_Id, Aspect_Relaxed_Initialization);
-- Aspect expression is either an aggregate, e.g.:
--
