diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 66ba73226ed07d73ace1e2f0cf563aba5133e3d1..69d6e25794e803ccf001afb66e4021857b768c81 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 a7e3df9f06e999a3d70463bab424be8eeb438fa2..9b013995b8a8843af3619252ce58db79b2027daa 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 89b616f0bd42e31cf73ef6880702aa2584162cd4..f317479d4618f96aa40983c844d3bb904806915a 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 39725d23442b23aa46409ad4490de82bf35ae8d2..e74d3051b34f76e9447b87cd463ad14745890d0b 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 d89281195125b1e6af212985190ab2af5f79ec0a..0bd976cbf655e9f4e7a93c01f542c5327192e560 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 a9aba1de6e481a1fc53c023cf39c64cd63eda9c5..2beb6b95daf3f485ae94b615ebcb465c53c29690 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 7bedc043c8d4fc9b44ddc02e69a98219e7402edd..f0ce27b5e23af5f5ed9d41374e5872ad764d0a84 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 7bd30d6993e208d2ba4edb5b3b5cb2320273aa7e..6ec351e42a6f6a7c7759a2b6e75a6e16fb56b3f4 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 d81bdc50ee0d9606bcee9227c79965d76a9f6fb8..9cd135d48ceb6293f913f26066e84c5a6c1f8074 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 414caf2edaaf0bf948b6fb2be216cb8be653371c..1fa714d229e8eb4f51cc41b8565dac7b89df5620 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 d553950dbd726c3f4267bed32a15eaef6e33496a..2bff3dc4ae240542578ad5cd3b4694bfa43e49d0 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 c55e4d3bb24bb4cb6f0f98690f7c1f2fa3924791..399b22d0c52b630d6a4c0c45e2257cfd75473e3b 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 889cbd307b4c3dbffad5e14b484c0286d2b56af7..5f990f3dc4ebb9e2e20947926c6cbe4182ab3d42 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