From: Javier Miranda <mira...@adacore.com>
According to RM 13.14(8/4), a static expression in an aspect specification
does not cause freezing; however, the frontend performs many calls to
Preanalyze_Spec_Expression made during the analysis of aspects. This
patch, suggested by Eric Botcazou, takes care of this additional code
cleanup which requires also replacing many occurrences of the global
variable In_Spec_Expression by calls to Preanalysis_Active.
gcc/ada/ChangeLog:
* exp_util.adb (Insert_Actions): Document behavior under strict
preanalysis.
* sem.ads (In_Strict_Preanalysis): New subprogram.
(Preanalysis_Active): Replace 'and' operator by 'and then'.
* sem.adb (In_Strict_Preanalysis): Ditto.
* sem_attr.adb (Check_Dereference): Replace In_Spec_Expression
occurrence by call to Preanalysis_Active, and document it.
(Resolve_Attribute [Atribute_Access]): Ditto.
(Eval_Attribute): No evaluation under strict preanalysis.
(Validate_Static_Object_Name): No action under strict preanalysis.
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations): Replace
calls to Preanalyze_Spec_Expression by calls to Preanalyze_And_Resolve.
(Check_Aspect_At_Freeze_Point): Ditto.
(Resolve_Aspect_Expressions [Dynamic/Static/Predicate aspects]): Code
cleanup adjusting the code to emulate Preanalyze_And_Resolve, instead
of Preanalyze_Spec_Expression.
(Resolve_Aspect_Expressions [CPU/Interrupt_Priority/Priority/
Storage_Size aspects]): Replace calls to Preanalyze_Spec_Expression
by call to Preanalyze_And _Resolve.
* sem_ch3.adb (Analyze_Object_Declaration): Replace In_Spec_Expression
occurrence by call to Preanalysis_Active.
(Find_Type_Of_Object): Add documentation.
* sem_ch4.adb (Analyze_Case_Expression): Replace In_Spec_Expression
occurrence by call to Preanalysis_Active.
* sem_ch6.adb (Analyze_Expression_Function): Minor code reorganization
moving the code preanalyzing the expression after the new body has
been inserted in the tree to ensure that its Parent attribute is
available for preanalysis.
* sem_cat.adb (Validate_Static_Object_Name): No action under strict
preanalysis.
* sem_elab.adb (Check_For_Eliminated_Subprogram): Replace
In_Spec_Expression
occurrence by call to Preanalysis_Active.
* sem_eval.adb (Eval_Intrinsic_Call [Name_Enclosing_Entity]): Ditto.
* sem_elim.adb (Check_For_Eliminated_Subprogram): Ditto.
* sem_res.adb (Resolve_Entity_Name): Ditto.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_util.adb | 16 +++++++--------
gcc/ada/sem.adb | 11 ++++++++++-
gcc/ada/sem.ads | 5 +++++
gcc/ada/sem_attr.adb | 25 ++++++++++++++++--------
gcc/ada/sem_cat.adb | 1 +
gcc/ada/sem_ch13.adb | 25 +++++++++++-------------
gcc/ada/sem_ch3.adb | 7 +++++--
gcc/ada/sem_ch4.adb | 2 +-
gcc/ada/sem_ch6.adb | 46 ++++++++++++++++++++++----------------------
gcc/ada/sem_elab.adb | 2 +-
gcc/ada/sem_elim.adb | 5 +++--
gcc/ada/sem_eval.adb | 2 +-
gcc/ada/sem_res.adb | 2 +-
13 files changed, 87 insertions(+), 62 deletions(-)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 66ba73226ed..69d6e25794e 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -7708,20 +7708,20 @@ package body Exp_Util is
return;
end if;
- -- Insert the action when the context is "Handling of Default and Per-
- -- Object Expressions" only when requested by the caller.
-
- if Spec_Expr_OK then
- null;
-
-- Ignore insert of actions from inside default expression (or other
-- similar "spec expression") in the special spec-expression analyze
-- mode. Any insertions at this point have no relevance, since we are
-- only doing the analyze to freeze the types of any static expressions.
-- See section "Handling of Default and Per-Object Expressions" in the
- -- spec of package Sem for further details.
+ -- spec of package Sem for further details. However, if the user does
+ -- nevertheless request the insert, then obey it.
+
+ -- Under strict preanalysis we cannot ignore insert of actions because
+ -- we may be adding to the tree a subtype declaration that is required
+ -- for proper preanalysis (see Sem_Ch3.Find_Type_Of_Object).
- elsif In_Spec_Expression then
+ if In_Spec_Expression and then not Spec_Expr_OK then
+ pragma Assert (not In_Strict_Preanalysis);
return;
end if;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index a7e3df9f06e..9b013995b8a 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1338,13 +1338,22 @@ package body Sem is
Scope_Stack.Locked := True;
end Lock;
+ ---------------------------
+ -- In_Strict_Preanalysis --
+ ---------------------------
+
+ function In_Strict_Preanalysis return Boolean is
+ begin
+ return Preanalysis_Active and then not In_Spec_Expression;
+ end In_Strict_Preanalysis;
+
------------------------
-- Preanalysis_Active --
------------------------
function Preanalysis_Active return Boolean is
begin
- return not Full_Analysis and not Expander_Active;
+ return not Full_Analysis and then not Expander_Active;
end Preanalysis_Active;
----------------
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 89b616f0bd4..f317479d461 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -703,6 +703,11 @@ package Sem is
-- This function returns True if an explicit pragma Suppress for check C
-- is present in the package defining E.
+ function In_Strict_Preanalysis return Boolean;
+ pragma Inline (In_Strict_Preanalysis);
+ -- Determine whether preanalysis is active at the point of invocation
+ -- and we are not processing a Spec Expression.
+
function Preanalysis_Active return Boolean;
pragma Inline (Preanalysis_Active);
-- Determine whether preanalysis is active at the point of invocation
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 39725d23442..e74d3051b34 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2106,11 +2106,12 @@ package body Sem_Attr is
-- designated type of the access type, since the type of the
-- referenced array is this type (see AI95-00106).
- -- As done elsewhere, freezing must not happen when preanalyzing
- -- a pre- or postcondition or a default value for an object or for
- -- a formal parameter.
+ -- However, we must not freeze the designated type during
+ -- preanalysis; neither under strict preanalysis nor when
+ -- preanalyzing a pre- or postcondition or a default value
+ -- for an object or for a formal parameter.
- if not In_Spec_Expression then
+ if not Preanalysis_Active then
Freeze_Before (N, Designated_Type (P_Type));
end if;
@@ -8139,6 +8140,13 @@ package body Sem_Attr is
if Nkind (N) /= N_Attribute_Reference then
return;
+
+ -- No evaluation required under strict preanalysis because locating
+ -- static expressions is not needed; this also minimizes making tree
+ -- modifications during strict preanalysis.
+
+ elsif In_Strict_Preanalysis then
+ return;
end if;
Aname := Attribute_Name (N);
@@ -11342,10 +11350,11 @@ package body Sem_Attr is
end loop;
-- If Prefix is a subprogram name, this reference freezes,
- -- but not if within spec expression mode. The profile of
- -- the subprogram is not frozen at this point.
+ -- but not during preanalysis (including preanalysis of
+ -- spec expressions). The profile of the subprogram is not
+ -- frozen at this point.
- if not In_Spec_Expression then
+ if not Preanalysis_Active then
Freeze_Before (N, Entity (P), Do_Freeze_Profile => False);
end if;
@@ -11354,7 +11363,7 @@ package body Sem_Attr is
-- If it is an object, complete its resolution.
elsif Is_Overloadable (Entity (P)) then
- if not In_Spec_Expression then
+ if not Preanalysis_Active then
Freeze_Before (N, Entity (P), Do_Freeze_Profile => False);
end if;
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index d8928119512..0bd976cbf65 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -2177,6 +2177,7 @@ package body Sem_Cat is
or else not Comes_From_Source (N)
or else In_Subprogram_Or_Concurrent_Unit
or else Ekind (Current_Scope) = E_Block
+ or else In_Strict_Preanalysis
then
return;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a9aba1de6e4..2beb6b95daf 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -10039,7 +10039,7 @@ package body Sem_Ch13 is
-- If the predicate pragma comes from an aspect, replace the
-- saved expression because we need the subtype references
- -- replaced for the calls to Preanalyze_Spec_Expression in
+ -- replaced for the calls to Preanalyze_And_Resolve in
-- Check_Aspect_At_xxx routines.
if Present (Asp) then
@@ -10853,12 +10853,12 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean);
+ Preanalyze_And_Resolve (Freeze_Expr, Standard_Boolean);
Pop_Type (Ent);
elsif A_Id = Aspect_Priority then
Push_Type (Ent);
- Preanalyze_Spec_Expression (Freeze_Expr, Any_Integer);
+ Preanalyze_And_Resolve (Freeze_Expr, Any_Integer);
Pop_Type (Ent);
else
@@ -10916,13 +10916,14 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve (End_Decl_Expr, T);
Pop_Type (Ent);
elsif A_Id = Aspect_Predicate_Failure then
- Preanalyze_Spec_Expression (End_Decl_Expr, Standard_String);
+ Preanalyze_And_Resolve (End_Decl_Expr, Standard_String);
+
elsif Present (End_Decl_Expr) then
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve (End_Decl_Expr, T);
end if;
Err :=
@@ -11346,7 +11347,7 @@ package body Sem_Ch13 is
-- Do the preanalyze call
if Present (Expression (ASN)) then
- Preanalyze_Spec_Expression (Expression (ASN), T);
+ Preanalyze_And_Resolve (Expression (ASN), T);
end if;
end Check_Aspect_At_Freeze_Point;
@@ -16341,19 +16342,16 @@ package body Sem_Ch13 is
-- name resolution errors if the predicate function has
-- not been built yet.
- -- Note that we cannot use Preanalyze_Spec_Expression
+ -- Note that we cannot use Preanalyze_And_Resolve
-- directly because of the special handling required for
-- quantifiers (see comments on Resolve_Aspect_Expression
-- above) but we need to emulate it properly.
if No (Predicate_Function (E)) then
declare
- Save_In_Spec_Expression : constant Boolean :=
- In_Spec_Expression;
Save_Full_Analysis : constant Boolean :=
Full_Analysis;
begin
- In_Spec_Expression := True;
Full_Analysis := False;
Expander_Mode_Save_And_Set (False);
Push_Type (E);
@@ -16361,7 +16359,6 @@ package body Sem_Ch13 is
Pop_Type (E);
Expander_Mode_Restore;
Full_Analysis := Save_Full_Analysis;
- In_Spec_Expression := Save_In_Spec_Expression;
end;
end if;
@@ -16404,7 +16401,7 @@ package body Sem_Ch13 is
| Aspect_Priority
=>
Push_Type (E);
- Preanalyze_Spec_Expression (Expr, Any_Integer);
+ Preanalyze_And_Resolve (Expr, Any_Integer);
Pop_Type (E);
-- Ditto for Storage_Size. Any other aspects that carry
@@ -16412,7 +16409,7 @@ package body Sem_Ch13 is
-- relevant to the misuse of deferred constants.
when Aspect_Storage_Size =>
- Preanalyze_Spec_Expression (Expr, Any_Integer);
+ Preanalyze_And_Resolve (Expr, Any_Integer);
when others =>
if Present (Expr) then
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7bedc043c8d..f0ce27b5e23 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4575,7 +4575,8 @@ package body Sem_Ch3 is
and then Is_Itype (T)
then
Set_Has_Delayed_Freeze (T);
- elsif not In_Spec_Expression then
+
+ elsif not Preanalysis_Active then
Freeze_Before (N, T);
end if;
end if;
@@ -18796,7 +18797,9 @@ package body Sem_Ch3 is
end if;
-- When generating code, insert subtype declaration ahead of
- -- declaration that generated it.
+ -- declaration that generated it. Similar behavior required under
+ -- preanalysis (including strict preanalysis) to perform the
+ -- minimum decoration, and avoid reporting spurious errors.
Insert_Action (Obj_Def,
Make_Subtype_Declaration (Sloc (P),
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 7bd30d6993e..6ec351e42a6 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1795,7 +1795,7 @@ package body Sem_Ch4 is
if Is_OK_Static_Subtype (Exp_Type)
and then Has_Static_Predicate_Aspect (Exp_Type)
- and then In_Spec_Expression
+ and then Preanalysis_Active
then
null;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d81bdc50ee0..9cd135d48ce 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -533,29 +533,6 @@ package body Sem_Ch6 is
Set_Corresponding_Body (N, Defining_Entity (New_Body));
Set_Corresponding_Spec (New_Body, Def_Id);
- -- Within a generic preanalyze the original expression for name
- -- capture. The body is also generated but plays no role in
- -- this because it is not part of the original source.
- -- If this is an ignored Ghost entity, analysis of the generated
- -- body is needed to hide external references (as is done in
- -- Analyze_Subprogram_Body) after which the subprogram profile
- -- can be frozen, which is needed to expand calls to such an ignored
- -- Ghost subprogram.
-
- if Inside_A_Generic then
- Set_Has_Completion (Def_Id, not Is_Ignored_Ghost_Entity (Def_Id));
- Push_Scope (Def_Id);
- Install_Formals (Def_Id);
- Preanalyze_Spec_Expression (Expr, Typ);
- End_Scope;
- else
- Push_Scope (Def_Id);
- Install_Formals (Def_Id);
- Preanalyze_Spec_Expression (Expr, Typ);
- Check_Limited_Return (Orig_N, Expr, Typ);
- End_Scope;
- end if;
-
-- If this is a wrapper created in an instance for a formal
-- subprogram, insert body after declaration, to be analyzed when the
-- enclosing instance is analyzed.
@@ -591,6 +568,29 @@ package body Sem_Ch6 is
end;
end if;
+ -- Within a generic preanalyze the original expression for name
+ -- capture. The body is also generated but plays no role in
+ -- this because it is not part of the original source.
+ -- If this is an ignored Ghost entity, analysis of the generated
+ -- body is needed to hide external references (as is done in
+ -- Analyze_Subprogram_Body) after which the subprogram profile
+ -- can be frozen, which is needed to expand calls to such an ignored
+ -- Ghost subprogram.
+
+ if Inside_A_Generic then
+ Set_Has_Completion (Def_Id, not Is_Ignored_Ghost_Entity (Def_Id));
+ Push_Scope (Def_Id);
+ Install_Formals (Def_Id);
+ Preanalyze_Spec_Expression (Expr, Typ);
+ End_Scope;
+ else
+ Push_Scope (Def_Id);
+ Install_Formals (Def_Id);
+ Preanalyze_Spec_Expression (Expr, Typ);
+ Check_Limited_Return (Orig_N, Expr, Typ);
+ End_Scope;
+ end if;
+
-- In the case of an expression function marked with the aspect
-- Static, we need to check the requirement that the function's
-- expression is a potentially static expression. This is done
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 414caf2edaa..1fa714d229e 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -17389,7 +17389,7 @@ package body Sem_Elab is
-- Nothing to do if call is being preanalyzed, as when within a
-- pre/postcondition, a predicate, or an invariant.
- elsif In_Spec_Expression then
+ elsif Preanalysis_Active then
return;
end if;
diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb
index d553950dbd7..2bff3dc4ae2 100644
--- a/gcc/ada/sem_elim.adb
+++ b/gcc/ada/sem_elim.adb
@@ -728,9 +728,10 @@ package body Sem_Elim is
begin
-- No check needed within a default expression for a formal, since this
-- is not really a use, and the expression (a call or attribute) may
- -- never be used if the enclosing subprogram is itself eliminated.
+ -- never be used if the enclosing subprogram is itself eliminated. Same
+ -- under strict preanalysis.
- if In_Spec_Expression then
+ if Preanalysis_Active then
return;
end if;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index c55e4d3bb24..399b22d0c52 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -2927,7 +2927,7 @@ package body Sem_Eval is
| Name_Source_Location
=>
if Inside_A_Generic
- or else In_Spec_Expression
+ or else Preanalysis_Active
then
null;
else
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 889cbd307b4..5f990f3dc4e 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8147,7 +8147,7 @@ package body Sem_Res is
and then Comes_From_Source (E)
and then No (Constant_Value (E))
and then Is_Frozen (Etype (E))
- and then not In_Spec_Expression
+ and then not Preanalysis_Active
and then not Is_Imported (E)
and then Nkind (Parent (E)) /= N_Object_Renaming_Declaration
then
--
2.43.0
