https://gcc.gnu.org/g:71d515570824a3d4f76da8c1b1bdc13762ab694f
commit r15-6205-g71d515570824a3d4f76da8c1b1bdc13762ab694f
Author: Javier Miranda <mira...@adacore.com>
Date: Sun Dec 1 19:02:52 2024 +0000
ada: Cleanup preanalysis of static expressions
During preanalysis, the frontend does not generate freeze nodes.
The exception to this rule occurs during the preanalysis of default
and per-object expressions, where static expressions are frozen.
A patch merged six years ago to address an issue in this area introduced
additional complexity and confusion regarding the frontend's behavior in
such cases. The purpose of this patch is to revert that change, simplifying
the support for the preanalysis of static expressions to make it cleaner
and easier to understand.
gcc/ada/ChangeLog:
* sem.ads (Inside_Preanalysis_Without_Freezing): Removed.
* sem.adb (Semantics): Remove Inside_Preanalysis_Without_Freezing.
* sem_ch6.adb (Preanalyze_Formal_Expression): Removed.
* sem_ch3.ads (Preanalyze_Assert_Expression): Add documentation.
(Preanalyze_Spec_Expression): Add documentation.
* sem_ch3.adb (Preanalyze_Assert_Expression) Code cleanup.
(Preanalyze_Default_Expression): Code cleanup.
* sem_res.ads (Preanalyze_With_Freezing_And_Resolve): Removed.
* sem_res.adb (Preanalyze_With_Freezing_And_Resolve): Removed.
(Preanalyze_And_Resolve): Code cleanup.
* freeze.adb (Freeze_Entity): No freeze under strict preanalysis.
(Freeze_Expression): Code cleanup.
(Freeze_Expr_Types): Replace call to Preanalyze_Spec_Expression by
strict preanalysis during preanalysis of a duplicate of the
expression performed to have available the minimum decoration
to locate referenced unfrozen types.
* sem_aggr.adb (Resolve_Array_Aggregate): Minor code cleanup.
* sem_attr.adb (Resolve_Attribute): Add documentation.
* sem_ch13.adb (Resolve_Aspect_Expressions[Aspect_Default_Value]):
Replace call to Preanalyze_Spec_Expression by
Preanalyze_And_Resolve.
(Resolve_Aspect_Expressions[Aspect_Default_Component_Value]): Ditto.
* sem_ch8.adb (Set_Entity_Or_Discriminal): Code cleaup.
* sem_prag.adb (Analyze_Initial_Condition_In_Decl_Part): Replace
call to Preanalyze_Assert_Expression by call to
Preanalyze_And_Resolve.
(Analyze_Pre_Post_Condition): Replace call to
Preanayze_Spec_Expression
by call to Preanalyze_Assert_Expression.
* sem_util.ads (In_Pragma_Expression): Adding a formal to extend the
functionality of this subprogram.
(Within_Static_Expression): New subprogram.
* sem_util.adb (In_Pragma_Expression): Ditto.
(Within_Static_Expression): Ditto.
* checks.adb (Install_Null_Excluding_Check): No check during
preanalysis.
(Install_Primitive_Elaboration_Check): Ditto.
Diff:
---
gcc/ada/checks.adb | 13 ++++++++++--
gcc/ada/freeze.adb | 46 ++++++++++++++++++------------------------
gcc/ada/sem.adb | 11 ----------
gcc/ada/sem.ads | 19 +++++++++---------
gcc/ada/sem_aggr.adb | 17 +++++-----------
gcc/ada/sem_attr.adb | 3 ++-
gcc/ada/sem_ch13.adb | 6 +++---
gcc/ada/sem_ch3.adb | 21 ++++---------------
gcc/ada/sem_ch3.ads | 10 +++++++++
gcc/ada/sem_ch6.adb | 22 +++-----------------
gcc/ada/sem_ch8.adb | 14 ++++++++-----
gcc/ada/sem_prag.adb | 4 ++--
gcc/ada/sem_res.adb | 50 +++------------------------------------------
gcc/ada/sem_res.ads | 3 ---
gcc/ada/sem_util.adb | 57 ++++++++++++++++++++++++++++++++++++++++++++++++----
gcc/ada/sem_util.ads | 12 +++++++++--
16 files changed, 144 insertions(+), 164 deletions(-)
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index 1ec49924c9be..c30c99b31aa2 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -8405,11 +8405,15 @@ package body Checks is
if Inside_A_Generic then
return;
- end if;
+
+ -- No check during preanalysis
+
+ elsif Preanalysis_Active then
+ return;
-- No check needed if known to be non-null
- if Known_Non_Null (N) then
+ elsif Known_Non_Null (N) then
return;
end if;
@@ -8569,6 +8573,11 @@ package body Checks is
if GNATprove_Mode then
return;
+ -- No check during preanalysis
+
+ elsif Preanalysis_Active then
+ return;
+
-- Do not generate an elaboration check if all checks have been
-- suppressed.
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index dae1d9afcde9..c36f626cc8ca 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6445,9 +6445,11 @@ package body Freeze is
goto Leave;
- -- Do not freeze if we are preanalyzing without freezing
+ -- Do not freeze under strict preanalysis
- elsif Inside_Preanalysis_Without_Freezing > 0 then
+ elsif Preanalysis_Active
+ and then not Within_Spec_Static_Expression (N)
+ then
Result := No_List;
goto Leave;
@@ -8532,29 +8534,21 @@ package body Freeze is
if Must_Not_Freeze (N) then
return;
- end if;
- -- If expression is non-static, then it does not freeze in a default
- -- expression, see section "Handling of Default Expressions" in the
- -- spec of package Sem for further details. Note that we have to make
- -- sure that we actually have a real expression (if we have a subtype
- -- indication, we can't test Is_OK_Static_Expression). However, we
- -- exclude the case of the prefix of an attribute of a static scalar
- -- subtype from this early return, because static subtype attributes
- -- should always cause freezing, even in default expressions, but
- -- the attribute may not have been marked as static yet (because in
- -- Resolve_Attribute, the call to Eval_Attribute follows the call of
- -- Freeze_Expression on the prefix).
-
- if In_Spec_Exp
- and then Nkind (N) in N_Subexpr
- and then not Is_OK_Static_Expression (N)
- and then (Nkind (Parent (N)) /= N_Attribute_Reference
- or else not (Is_Entity_Name (N)
- and then Is_Type (Entity (N))
- and then Is_OK_Static_Subtype (Entity (N))))
- then
- return;
+ elsif Preanalysis_Active then
+
+ -- Do not freeze under strict preanalysis
+
+ if not In_Spec_Exp then
+ return;
+
+ -- If expression is non-static, then it does not freeze in a default
+ -- expression, see section "Handling of Default Expressions" in the
+ -- spec of package Sem for further details.
+
+ elsif not Within_Spec_Static_Expression (N) then
+ return;
+ end if;
end if;
-- Freeze type of expression if not frozen already
@@ -9363,10 +9357,10 @@ package body Freeze is
Push_Scope (Def_Id);
Install_Formals (Def_Id);
- Preanalyze_Spec_Expression (Dup_Expr, Typ);
+ Preanalyze_And_Resolve (Dup_Expr, Typ);
End_Scope;
else
- Preanalyze_Spec_Expression (Dup_Expr, Typ);
+ Preanalyze_And_Resolve (Dup_Expr, Typ);
end if;
-- Restore certain attributes of Def_Id since the preanalysis may
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index d93e177c765e..a7e3df9f06e9 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -1536,18 +1536,9 @@ package body Sem is
-- unit. All with'ed units are analyzed with config restrictions reset
-- and we need to restore these saved values at the end.
- Save_Preanalysis_Counter : constant Nat :=
- Inside_Preanalysis_Without_Freezing;
- -- Saves the preanalysis nesting-level counter; required since we may
- -- need to analyze a unit as a consequence of the preanalysis of an
- -- expression without freezing (and the loaded unit must be fully
- -- analyzed).
-
-- Start of processing for Semantics
begin
- Inside_Preanalysis_Without_Freezing := 0;
-
if Debug_Unit_Walk then
if Already_Analyzed then
Write_Str ("(done)");
@@ -1722,8 +1713,6 @@ package body Sem is
Unit (Comp_Unit),
Prefix => "<-- ");
end if;
-
- Inside_Preanalysis_Without_Freezing := Save_Preanalysis_Counter;
end Semantics;
--------
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index 3a19088d10e9..89b616f0bd42 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -194,11 +194,15 @@
-- that the expansion of inner expressions happens inside the newly generated
-- node for the parent expression.
--- Note that the difference between processing of default expressions and
--- preanalysis of other expressions is that we do carry out freezing in
--- the latter but not in the former (except for static scalar expressions).
--- The routine that performs preanalysis and corresponding resolution is
--- called Preanalyze_And_Resolve and is in Sem_Res.
+-- Note that the difference between preanalysis of default expressions and
+-- strict preanalysis of other expressions is that we do carry out freezing
+-- in the former (for static scalar expressions) but not in the latter. The
+-- routine that performs preanalysis of default expressions is called
+-- Preanalyze_Spec_Expression and is in Sem_Ch3. The routine that performs
+-- strict preanalysis and corresponding resolution is in Sem_Res and it is
+-- called Preanalyze_And_Resolve. Preanalyze_Spec_Expression relaxes the
+-- strictness of Preanalyze_And_Resolve setting to True the global boolean
+-- variable In_Spec_Expression before calling Preanalyze_And_Resolve.
with Alloc;
with Einfo.Entities; use Einfo.Entities;
@@ -295,11 +299,6 @@ package Sem is
-- Flag indicating whether we are preanalyzing a class-wide precondition
-- or postcondition.
- Inside_Preanalysis_Without_Freezing : Nat := 0;
- -- Flag indicating whether we are preanalyzing an expression performing no
- -- freezing. Non-zero means we are inside (it is actually a level counter
- -- to deal with nested calls).
-
Unloaded_Subunits : Boolean := False;
-- This flag is set True if we have subunits that are not loaded. This
-- occurs when the main unit is a subunit, and contains lower level
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 38bb34fa077c..5bef9e224846 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3103,19 +3103,15 @@ package body Sem_Aggr is
elsif No (Etype (Expression (Assoc))) then
declare
- Save_Analysis : constant Boolean := Full_Analysis;
- Expr : constant Node_Id :=
- New_Copy_Tree (Expression (Assoc));
+ Expr : constant Node_Id :=
+ New_Copy_Tree (Expression (Assoc));
begin
- Expander_Mode_Save_And_Set (False);
- Full_Analysis := False;
-
- -- Analyze the expression, making sure it is properly
+ -- Preanalyze the expression, making sure it is properly
-- attached to the tree before we do the analysis.
Set_Parent (Expr, Parent (Expression (Assoc)));
- Analyze (Expr);
+ Preanalyze (Expr);
-- If the expression is a literal, propagate this info
-- to the expression in the association, to enable some
@@ -3125,12 +3121,9 @@ package body Sem_Aggr is
and then Present (Entity (Expr))
and then Ekind (Entity (Expr)) = E_Enumeration_Literal
then
- Analyze_And_Resolve (Expression (Assoc), Ctyp);
+ Preanalyze_And_Resolve (Expression (Assoc), Ctyp);
end if;
- Full_Analysis := Save_Analysis;
- Expander_Mode_Restore;
-
-- Skip tagged checking for mutably tagged CW equivalent
-- types.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 2c17aef1528f..6cee808d89ab 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -13018,7 +13018,8 @@ package body Sem_Attr is
if Attr_Id = Attribute_Elaborated then
null;
- -- Should this be restricted to Expander_Active???
+ -- Unconditionally freeze the prefix; required to freeze static
+ -- expressions when preanalyzing default expressions.
else
Freeze_Expression (P);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 9f614f7f6cc4..a5db33676ae7 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -11186,7 +11186,7 @@ package body Sem_Ch13 is
elsif A_Id in Aspect_Default_Component_Value | Aspect_Default_Value
and then Is_Private_Type (T)
then
- Preanalyze_Spec_Expression (End_Decl_Expr, Full_View (T));
+ Preanalyze_And_Resolve (End_Decl_Expr, Full_View (T));
-- The following aspect expressions may contain references to
-- components and discriminants of the type.
@@ -16181,11 +16181,11 @@ package body Sem_Ch13 is
when Aspect_Default_Value =>
Check_Aspect_Too_Late (ASN);
- Preanalyze_Spec_Expression (Expr, E);
+ Preanalyze_And_Resolve (Expr, E);
when Aspect_Default_Component_Value =>
Check_Aspect_Too_Late (ASN);
- Preanalyze_Spec_Expression (Expr, Component_Type (E));
+ Preanalyze_And_Resolve (Expr, Component_Type (E));
when Aspect_CPU
| Aspect_Interrupt_Priority
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index c389979152fd..76ae53badd1d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -20868,15 +20868,11 @@ package body Sem_Ch3 is
procedure Preanalyze_Assert_Expression (N : Node_Id) is
Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
- Save_Must_Not_Freeze : constant Boolean := Must_Not_Freeze (N);
Save_Full_Analysis : constant Boolean := Full_Analysis;
begin
In_Assertion_Expr := In_Assertion_Expr + 1;
In_Spec_Expression := True;
- Set_Must_Not_Freeze (N);
- Inside_Preanalysis_Without_Freezing :=
- Inside_Preanalysis_Without_Freezing + 1;
Full_Analysis := False;
Expander_Mode_Save_And_Set (False);
@@ -20888,9 +20884,6 @@ package body Sem_Ch3 is
Expander_Mode_Restore;
Full_Analysis := Save_Full_Analysis;
- Inside_Preanalysis_Without_Freezing :=
- Inside_Preanalysis_Without_Freezing - 1;
- Set_Must_Not_Freeze (N, Save_Must_Not_Freeze);
In_Spec_Expression := Save_In_Spec_Expression;
In_Assertion_Expr := In_Assertion_Expr - 1;
end Preanalyze_Assert_Expression;
@@ -20900,17 +20893,11 @@ package body Sem_Ch3 is
-----------------------------------
procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is
- Save_In_Default_Expr : constant Boolean := In_Default_Expr;
- Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
-
+ Save_In_Default_Expr : constant Boolean := In_Default_Expr;
begin
- In_Default_Expr := True;
- In_Spec_Expression := True;
-
- Preanalyze_With_Freezing_And_Resolve (N, T);
-
- In_Default_Expr := Save_In_Default_Expr;
- In_Spec_Expression := Save_In_Spec_Expression;
+ In_Default_Expr := True;
+ Preanalyze_Spec_Expression (N, T);
+ In_Default_Expr := Save_In_Default_Expr;
end Preanalyze_Default_Expression;
--------------------------------
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index b0c9c13d8c7c..d71147143425 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -239,6 +239,11 @@ package Sem_Ch3 is
procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id);
-- Wrapper on Preanalyze_Spec_Expression for assertion expressions, so that
-- In_Assertion_Expr can be properly adjusted.
+ --
+ -- This routine must not be called when N is the root of a subtree that is
+ -- not in its final place since it freezes static expression entities,
+ -- which would be misplaced in the tree. Preanalyze_And_Resolve must be
+ -- used in such a case to avoid reporting spurious errors.
procedure Preanalyze_Assert_Expression (N : Node_Id);
-- Similar to the above, but without forcing N to be of a particular type
@@ -252,6 +257,11 @@ package Sem_Ch3 is
-- details. N is the expression to be analyzed, T is the expected type.
-- This mechanism is also used for aspect specifications that have an
-- expression parameter that needs similar preanalysis.
+ --
+ -- This routine must not be called when N is the root of a subtree that is
+ -- not in its final place since it freezes static expression entities,
+ -- which would be misplaced in the tree. Preanalyze_And_Resolve must be
+ -- used in such a case to avoid reporting spurious errors.
procedure Process_Full_View (N : Node_Id; Full_T, Priv_T : Entity_Id);
-- Process some semantic actions when the full view of a private type is
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 1ac76bbd0db9..a3b521ddad4b 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -225,10 +225,6 @@ package body Sem_Ch6 is
-- Create the declaration for an inequality operator that is implicitly
-- created by a user-defined equality operator that yields a boolean.
- procedure Preanalyze_Formal_Expression (N : Node_Id; T : Entity_Id);
- -- Preanalysis of default expressions of subprogram formals. N is the
- -- expression to be analyzed and T is the expected type.
-
procedure Set_Formal_Mode (Formal_Id : Entity_Id);
-- Set proper Ekind to reflect formal mode (in, out, in out), and set
-- miscellaneous other attributes.
@@ -544,7 +540,7 @@ package body Sem_Ch6 is
else
Push_Scope (Def_Id);
Install_Formals (Def_Id);
- Preanalyze_Formal_Expression (Expr, Typ);
+ Preanalyze_Spec_Expression (Expr, Typ);
Check_Limited_Return (Orig_N, Expr, Typ);
End_Scope;
end if;
@@ -610,7 +606,7 @@ package body Sem_Ch6 is
begin
Set_Checking_Potentially_Static_Expression (True);
- Preanalyze_Formal_Expression (Exp_Copy, Typ);
+ Preanalyze_Spec_Expression (Exp_Copy, Typ);
if not Is_Static_Expression (Exp_Copy) then
Error_Msg_N
@@ -12872,18 +12868,6 @@ package body Sem_Ch6 is
end if;
end New_Overloaded_Entity;
- ----------------------------------
- -- Preanalyze_Formal_Expression --
- ----------------------------------
-
- procedure Preanalyze_Formal_Expression (N : Node_Id; T : Entity_Id) is
- Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
- begin
- In_Spec_Expression := True;
- Preanalyze_With_Freezing_And_Resolve (N, T);
- In_Spec_Expression := Save_In_Spec_Expression;
- end Preanalyze_Formal_Expression;
-
---------------------
-- Process_Formals --
---------------------
@@ -13194,7 +13178,7 @@ package body Sem_Ch6 is
-- Do the special preanalysis of the expression (see section on
-- "Handling of Default Expressions" in the spec of package Sem).
- Preanalyze_Formal_Expression (Default, Formal_Type);
+ Preanalyze_Spec_Expression (Default, Formal_Type);
-- An access to constant cannot be the default for
-- an access parameter that is an access to variable.
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 449bfa897351..d038a2d62ce4 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -4921,17 +4921,21 @@ package body Sem_Ch8 is
then
null;
- -- Don't replace a non-qualified discriminant in strict preanalysis
- -- mode since it can lead to errors during full analysis when the
- -- discriminant gets referenced later.
+ -- Don't replace a non-qualified discriminant in preanalysis mode
+ -- since we may be preanalyzing a subtree that it is still not
+ -- placed in its final position in the tree, and therefore it can
+ -- lead to errors during full analysis when the discriminant gets
+ -- referenced later. We exclude preanalysis of pragma expressions
+ -- because they will not be moved.
-- This can occur in situations where a protected type contains
-- an expression function which references a non-prefixed
- -- discriminant.
+ -- discriminant, or a task type sets the size of its secondary
+ -- stack with a value provided in a discriminant.
elsif No (P)
and then Preanalysis_Active
- and then Inside_Preanalysis_Without_Freezing = 0
+ and then not In_Pragma_Expression (N)
then
null;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index d8eb314ac5f5..89bd34d3c6f4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3326,7 +3326,7 @@ package body Sem_Prag is
-- final place yet. A direct analysis may generate side effects and this
-- is not desired at this point.
- Preanalyze_Assert_Expression (Expr, Standard_Boolean);
+ Preanalyze_And_Resolve (Expr, Standard_Boolean);
Set_Is_Analyzed_Pragma (N);
Restore_Ghost_Region (Saved_GM, Saved_IGR);
@@ -5209,7 +5209,7 @@ package body Sem_Prag is
if Present (Arg2) then
Check_Optional_Identifier (Arg2, Name_Message);
- Preanalyze_Spec_Expression
+ Preanalyze_Assert_Expression
(Get_Pragma_Arg (Arg2), Standard_String);
end if;
end if;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 948ed940481b..dffaebfbca63 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -168,12 +168,6 @@ package body Sem_Res is
(Id : Entity_Id) return Entity_Id;
-- Like Implementation_Base_Type, but looks at Original_Node.
- procedure Preanalyze_And_Resolve
- (N : Node_Id;
- T : Entity_Id;
- With_Freezing : Boolean);
- -- Subsidiary of public versions of Preanalyze_And_Resolve.
-
procedure Replace_Actual_Discriminants (N : Node_Id; Default : Node_Id);
-- If a default expression in entry call N depends on the discriminants
-- of the task, it must be replaced with a reference to the discriminant
@@ -2098,24 +2092,12 @@ package body Sem_Res is
-- Preanalyze_And_Resolve --
----------------------------
- procedure Preanalyze_And_Resolve
- (N : Node_Id;
- T : Entity_Id;
- With_Freezing : Boolean)
- is
- Save_Full_Analysis : constant Boolean := Full_Analysis;
- Save_Must_Not_Freeze : constant Boolean := Must_Not_Freeze (N);
- Save_Preanalysis_Count : constant Nat :=
- Inside_Preanalysis_Without_Freezing;
+ procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
+ Save_Full_Analysis : constant Boolean := Full_Analysis;
+
begin
pragma Assert (Nkind (N) in N_Subexpr);
- if not With_Freezing then
- Set_Must_Not_Freeze (N);
- Inside_Preanalysis_Without_Freezing :=
- Inside_Preanalysis_Without_Freezing + 1;
- end if;
-
Full_Analysis := False;
Expander_Mode_Save_And_Set (False);
@@ -2148,26 +2130,12 @@ package body Sem_Res is
Expander_Mode_Restore;
Full_Analysis := Save_Full_Analysis;
-
- if not With_Freezing then
- Set_Must_Not_Freeze (N, Save_Must_Not_Freeze);
- Inside_Preanalysis_Without_Freezing :=
- Inside_Preanalysis_Without_Freezing - 1;
- end if;
-
- pragma Assert
- (Inside_Preanalysis_Without_Freezing = Save_Preanalysis_Count);
end Preanalyze_And_Resolve;
----------------------------
-- Preanalyze_And_Resolve --
----------------------------
- procedure Preanalyze_And_Resolve (N : Node_Id; T : Entity_Id) is
- begin
- Preanalyze_And_Resolve (N, T, With_Freezing => False);
- end Preanalyze_And_Resolve;
-
-- Version without context type
procedure Preanalyze_And_Resolve (N : Node_Id) is
@@ -2184,18 +2152,6 @@ package body Sem_Res is
Full_Analysis := Save_Full_Analysis;
end Preanalyze_And_Resolve;
- ------------------------------------------
- -- Preanalyze_With_Freezing_And_Resolve --
- ------------------------------------------
-
- procedure Preanalyze_With_Freezing_And_Resolve
- (N : Node_Id;
- T : Entity_Id)
- is
- begin
- Preanalyze_And_Resolve (N, T, With_Freezing => True);
- end Preanalyze_With_Freezing_And_Resolve;
-
----------------------------------
-- Replace_Actual_Discriminants --
----------------------------------
diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads
index c9dabddd807f..200abf7e891c 100644
--- a/gcc/ada/sem_res.ads
+++ b/gcc/ada/sem_res.ads
@@ -104,9 +104,6 @@ package Sem_Res is
procedure Preanalyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single type
- procedure Preanalyze_With_Freezing_And_Resolve (N : Node_Id; T : Entity_Id);
- -- Same, but perform freezing of static expressions of N or its children.
-
procedure Resolve (N : Node_Id; Typ : Entity_Id);
procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id);
-- Top-level type-checking procedure, called in a complete context. The
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c204fbb7aaeb..31bfc9e504e7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -13872,10 +13872,12 @@ package body Sem_Util is
-- In_Pragma_Expression --
--------------------------
- function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean is
- P : Node_Id;
+ function In_Pragma_Expression
+ (N : Node_Id; Nam : Name_Id := No_Name) return Boolean
+ is
+ P : Node_Id := Parent (N);
+
begin
- P := Parent (N);
loop
if No (P) then
return False;
@@ -13885,7 +13887,9 @@ package body Sem_Util is
elsif Is_Body_Or_Package_Declaration (P) then
return False;
- elsif Nkind (P) = N_Pragma and then Pragma_Name (P) = Nam then
+ elsif Nkind (P) = N_Pragma
+ and then (Nam = No_Name or else Pragma_Name (P) = Nam)
+ then
return True;
else
@@ -29385,6 +29389,51 @@ package body Sem_Util is
return Scope_Within_Or_Same (Scope (E), S);
end Within_Scope;
+ -----------------------------------
+ -- Within_Spec_Static_Expression --
+ -----------------------------------
+
+ function Within_Spec_Static_Expression (N : Node_Id) return Boolean is
+ P : Node_Id;
+
+ begin
+ if not In_Spec_Expression then
+ return False;
+
+ else
+ P := N;
+ loop
+ if No (P) then
+ return False;
+
+ -- Prevent the search from going too far
+
+ elsif Nkind (P) not in N_Subexpr then
+ return False;
+
+ elsif Is_OK_Static_Expression (P) then
+ return True;
+
+ -- Return True for static scalar subtypes that are prefixes of an
+ -- attribute (even if not yet marked static) since they will be
+ -- marked as static in Eval_Attribute (as called from Resolve_
+ -- Attribute).
+
+ elsif Present (Parent (P))
+ and then Nkind (Parent (P)) = N_Attribute_Reference
+ and then Is_Entity_Name (P)
+ and then Is_Type (Entity (P))
+ and then Is_OK_Static_Subtype (Entity (P))
+ then
+ return True;
+
+ else
+ P := Parent (P);
+ end if;
+ end loop;
+ end if;
+ end Within_Spec_Static_Expression;
+
----------------
-- Wrong_Type --
----------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index a809cdbaa07b..218faf7be201 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1621,8 +1621,11 @@ package Sem_Util is
function In_Package_Body return Boolean;
-- Returns True if current scope is within a package body
- function In_Pragma_Expression (N : Node_Id; Nam : Name_Id) return Boolean;
- -- Returns true if the expression N occurs within a pragma with name Nam
+ function In_Pragma_Expression
+ (N : Node_Id; Nam : Name_Id := No_Name) return Boolean;
+ -- Returns true if the expression N occurs within a pragma. If Name /=
+ -- No_Name returns true if the expression occurs within a pragma with
+ -- the given name.
function In_Pre_Post_Condition
(N : Node_Id; Class_Wide_Only : Boolean := False) return Boolean;
@@ -3369,6 +3372,11 @@ package Sem_Util is
function Within_Scope (E : Entity_Id; S : Entity_Id) return Boolean;
-- Returns True if entity E is declared within scope S
+ function Within_Spec_Static_Expression (N : Node_Id) return Boolean;
+ -- Returns True if we are preanalyzing a default expression, and N is
+ -- within a static expression. See "Handling of Default Expressions"
+ -- in the spec of package Sem for further details.
+
procedure Warn_On_Hiding_Entity
(N : Node_Id;
Hidden, Visible : Entity_Id;
