https://gcc.gnu.org/g:3c95e0e8938e26298534eceb70a3ffb7b56c413e
commit r16-1133-g3c95e0e8938e26298534eceb70a3ffb7b56c413e
Author: Javier Miranda <mira...@adacore.com>
Date: Tue Jan 14 11:08:57 2025 +0000
ada: Cleanup preanalysis of static expressions (part 6)
Rename Preanalyze_Spec_Expression as Preanalyze_And_Resolve_Spec_Expression,
Preanalyze_Assert_Expression as Preanalyze_And_Resolve_Assert_Expression,
and Preanalyze_Default_Expression as
Preanalyze_And_Resolve_Default_Expression;
cleanup the version of Preanalyze_Assert_Expression without context type.
gcc/ada/ChangeLog:
* sem.ads: Update reference to renamed subprogram in documentation.
* sem_ch3.ads (Preanalyze_Assert_Expression): Renamed.
(Preanalyze_Spec_Expression): Renamed.
* sem_ch3.adb (Preanalyze_Assert_Expression): Renamed and code
cleanup.
(Preanalyze_Spec_Expression): Renamed.
(Preanalyze_Default_Expression): Renamed.
* contracts.adb: Update calls to renamed subprograms.
* exp_pakd.adb: Ditto.
* exp_util.adb: Ditto.
* freeze.adb: Ditto.
* sem_ch12.adb: Ditto.
* sem_ch13.adb: Ditto.
* sem_ch6.adb: Ditto.
* sem_prag.adb: Ditto.
* sem_res.adb (Preanalyze_And_Resolve): Add to the version without
context type the special handling for GNATprove mode provided by
the version with context type; required to cleanup the body of
Preanalyze_Assert_Expression.
Diff:
---
gcc/ada/contracts.adb | 2 +-
gcc/ada/exp_pakd.adb | 3 +-
gcc/ada/exp_util.adb | 12 +++----
gcc/ada/freeze.adb | 9 ++---
gcc/ada/sem.ads | 12 +++----
gcc/ada/sem_ch12.adb | 4 +--
gcc/ada/sem_ch13.adb | 38 ++++++++++----------
gcc/ada/sem_ch3.adb | 99 +++++++++++++++++++++++++++------------------------
gcc/ada/sem_ch3.ads | 17 ++++++---
gcc/ada/sem_ch6.adb | 12 +++----
gcc/ada/sem_prag.adb | 60 ++++++++++++++++++-------------
gcc/ada/sem_res.adb | 11 +++---
12 files changed, 155 insertions(+), 124 deletions(-)
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index 8b94a67639f2..c0a57e6d0bae 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -4909,7 +4909,7 @@ package body Contracts is
Install_Formals (Subp);
Inside_Class_Condition_Preanalysis := True;
- Preanalyze_Spec_Expression (Expr, Standard_Boolean);
+ Preanalyze_And_Resolve_Spec_Expression (Expr, Standard_Boolean);
Inside_Class_Condition_Preanalysis := False;
End_Scope;
diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb
index 4eb93c3192a6..26ef065b529b 100644
--- a/gcc/ada/exp_pakd.adb
+++ b/gcc/ada/exp_pakd.adb
@@ -904,7 +904,8 @@ package body Exp_Pakd is
-- discriminants, so we treat it as a default/per-object expression.
Set_Parent (Len_Expr, Typ);
- Preanalyze_Spec_Expression (Len_Expr, Standard_Long_Long_Integer);
+ Preanalyze_And_Resolve_Spec_Expression
+ (Len_Expr, Standard_Long_Long_Integer);
-- Use a modular type if possible. We can do this if we have
-- static bounds, and the length is small enough, and the length
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index b8c6a9f8848b..513662af383a 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -1956,7 +1956,7 @@ package body Exp_Util is
-- time capture the visibility of the proper package part.
Set_Parent (Expr, Typ_Decl);
- Preanalyze_Assert_Expression (Expr, Any_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression (Expr, Any_Boolean);
-- Save a copy of the expression with all replacements and analysis
-- already taken place in case a derived type inherits the pragma.
@@ -1969,8 +1969,8 @@ package body Exp_Util is
-- If the pragma comes from an aspect specification, replace the
-- saved expression because all type references must be substituted
- -- for the call to Preanalyze_Spec_Expression in Check_Aspect_At_xxx
- -- routines.
+ -- for the call to Preanalyze_And_Resolve_Spec_Expression in
+ -- Check_Aspect_At_xxx routines.
if Present (DIC_Asp) then
Set_Expression_Copy (DIC_Asp, New_Copy_Tree (Expr));
@@ -3217,7 +3217,7 @@ package body Exp_Util is
-- part.
Set_Parent (Expr, Parent (Prag_Expr));
- Preanalyze_Assert_Expression (Expr, Any_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression (Expr, Any_Boolean);
-- Save a copy of the expression when T is tagged to detect
-- errors and capture the visibility of the proper package part
@@ -3229,8 +3229,8 @@ package body Exp_Util is
-- If the pragma comes from an aspect specification, replace
-- the saved expression because all type references must be
- -- substituted for the call to Preanalyze_Spec_Expression in
- -- Check_Aspect_At_xxx routines.
+ -- substituted for the call to Preanalyze_And_Resolve_Spec_
+ -- Expression in Check_Aspect_At_xxx routines.
if Present (Prag_Asp) then
Set_Expression_Copy (Prag_Asp, New_Copy_Tree (Expr));
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 54b620214e80..ec0fb16e741e 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -9389,16 +9389,17 @@ package body Freeze is
-- pre/postconditions during expansion of the subprogram body, the
-- subprogram is already installed.
- -- Call Preanalyze_Spec_Expression instead of Preanalyze_And_Resolve
- -- for the sake of consistency with Analyze_Expression_Function.
+ -- Call Preanalyze_And_Resolve_Spec_Expression instead of Preanalyze_
+ -- And_Resolve for the sake of consistency with Analyze_Expression_
+ -- Function.
if Def_Id /= Current_Scope then
Push_Scope (Def_Id);
Install_Formals (Def_Id);
- Preanalyze_Spec_Expression (Dup_Expr, Typ);
+ Preanalyze_And_Resolve_Spec_Expression (Dup_Expr, Typ);
End_Scope;
else
- Preanalyze_Spec_Expression (Dup_Expr, Typ);
+ Preanalyze_And_Resolve_Spec_Expression (Dup_Expr, Typ);
end if;
-- Restore certain attributes of Def_Id since the preanalysis may
diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads
index f8a67a9a746f..611309775279 100644
--- a/gcc/ada/sem.ads
+++ b/gcc/ada/sem.ads
@@ -109,7 +109,7 @@
-- pragmas that appear with subprogram specifications rather than in the body.
-- Collectively we call these Spec_Expressions. The routine that performs the
--- special analysis is called Preanalyze_Spec_Expression.
+-- special analysis is called Preanalyze_And_Resolve_Spec_Expression.
-- Expansion has to be deferred since you can't generate code for expressions
-- that reference types that have not been frozen yet. As an example, consider
@@ -198,11 +198,11 @@
-- 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.
+-- Preanalyze_And_Resolve_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_And_Resolve_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;
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 5768e28e90fc..d961f0306c26 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -3371,7 +3371,7 @@ package body Sem_Ch12 is
end if;
if Present (E) then
- Preanalyze_Spec_Expression (E, T);
+ Preanalyze_And_Resolve_Spec_Expression (E, T);
-- The default for a ghost generic formal IN parameter of
-- access-to-variable type should be a ghost object (SPARK
@@ -4195,7 +4195,7 @@ package body Sem_Ch12 is
elsif Present (Expr) then
Push_Scope (Nam);
Install_Formals (Nam);
- Preanalyze_Spec_Expression (Expr, Etype (Nam));
+ Preanalyze_And_Resolve_Spec_Expression (Expr, Etype (Nam));
End_Scope;
end if;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 072ec66a8f3d..69e18b049b99 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -6502,7 +6502,8 @@ package body Sem_Ch13 is
-- and restored before and after analysis.
Push_Type (U_Ent);
- Preanalyze_Spec_Expression (Expr, RTE (RE_CPU_Range));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Expr, RTE (RE_CPU_Range));
Pop_Type (U_Ent);
-- AI12-0117-1, "Restriction No_Tasks_Unassigned_To_CPU":
@@ -6592,10 +6593,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
-
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expr, RTE (RE_Dispatching_Domain));
-
Pop_Type (U_Ent);
end if;
@@ -6674,10 +6673,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
-
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expr, RTE (RE_Interrupt_Priority));
-
Pop_Type (U_Ent);
-- Check the No_Task_At_Interrupt_Priority restriction
@@ -6843,7 +6840,8 @@ package body Sem_Ch13 is
-- The visibility to the components must be restored
Push_Type (U_Ent);
- Preanalyze_Spec_Expression (Expr, Standard_Integer);
+ Preanalyze_And_Resolve_Spec_Expression
+ (Expr, Standard_Integer);
Pop_Type (U_Ent);
if not Is_OK_Static_Expression (Expr) then
@@ -10039,8 +10037,8 @@ 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
- -- Check_Aspect_At_xxx routines.
+ -- replaced for the calls to Preanalyze_And_Resolve_Spec_
+ -- Expression in Check_Aspect_At_xxx routines.
if Present (Asp) then
Set_Expression_Copy (Asp, New_Copy_Tree (Arg2_Copy));
@@ -10853,12 +10851,14 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (Freeze_Expr, Standard_Boolean);
+ Preanalyze_And_Resolve_Spec_Expression
+ (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_Spec_Expression
+ (Freeze_Expr, Any_Integer);
Pop_Type (Ent);
else
@@ -10908,7 +10908,8 @@ 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_Spec_Expression
+ (End_Decl_Expr, Full_View (T));
-- The following aspect expressions may contain references to
-- components and discriminants of the type.
@@ -10922,14 +10923,15 @@ package body Sem_Ch13 is
| Aspect_Static_Predicate
then
Push_Type (Ent);
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve_Spec_Expression (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_Spec_Expression
+ (End_Decl_Expr, Standard_String);
elsif Present (End_Decl_Expr) then
- Preanalyze_Spec_Expression (End_Decl_Expr, T);
+ Preanalyze_And_Resolve_Spec_Expression (End_Decl_Expr, T);
end if;
Err :=
@@ -11359,7 +11361,7 @@ package body Sem_Ch13 is
-- the aspect_specification cause freezing (RM 13.14(7.2/5)).
if Present (Expression (ASN)) then
- Preanalyze_Spec_Expression (Expression (ASN), T);
+ Preanalyze_And_Resolve_Spec_Expression (Expression (ASN), T);
end if;
end Check_Aspect_At_Freeze_Point;
@@ -13928,7 +13930,7 @@ package body Sem_Ch13 is
Next (First (Pragma_Argument_Associations (Ritem)));
begin
Push_Type (E);
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expression (Arg), Standard_Boolean);
Pop_Type (E);
end;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 74eac9c9789c..7f100255694b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -41,7 +41,6 @@ with Exp_Disp; use Exp_Disp;
with Exp_Dist; use Exp_Dist;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
-with Expander; use Expander;
with Fmap;
with Freeze; use Freeze;
with Ghost; use Ghost;
@@ -623,9 +622,11 @@ package body Sem_Ch3 is
-- Create a new ordinary fixed point type, and apply the constraint to
-- obtain subtype of it.
- procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id);
- -- Wrapper on Preanalyze_Spec_Expression for default expressions, so that
- -- In_Default_Expr can be properly adjusted.
+ procedure Preanalyze_And_Resolve_Default_Expression
+ (N : Node_Id;
+ T : Entity_Id);
+ -- Wrapper on Preanalyze_And_Resolve_Spec_Expression for default
+ -- expressions, so that In_Default_Expr can be properly adjusted.
procedure Prepare_Private_Subtype_Completion
(Id : Entity_Id;
@@ -2110,7 +2111,7 @@ package body Sem_Ch3 is
-- package Sem).
if Present (E) then
- Preanalyze_Default_Expression (E, T);
+ Preanalyze_And_Resolve_Default_Expression (E, T);
Check_Initialization (T, E);
if Ada_Version >= Ada_2005
@@ -2507,7 +2508,8 @@ package body Sem_Ch3 is
(First (Pragma_Argument_Associations (ASN))));
Set_Parent (Exp, ASN);
- Preanalyze_Assert_Expression (Exp, Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Exp, Standard_Boolean);
end if;
ASN := Next_Pragma (ASN);
@@ -20857,67 +20859,71 @@ package body Sem_Ch3 is
Set_Is_Constrained (T);
end Ordinary_Fixed_Point_Type_Declaration;
- ----------------------------------
- -- Preanalyze_Assert_Expression --
- ----------------------------------
+ ----------------------------------------------
+ -- Preanalyze_And_Resolve_Assert_Expression --
+ ----------------------------------------------
- procedure Preanalyze_Assert_Expression (N : Node_Id; T : Entity_Id) is
+ procedure Preanalyze_And_Resolve_Assert_Expression
+ (N : Node_Id;
+ T : Entity_Id) is
begin
In_Assertion_Expr := In_Assertion_Expr + 1;
- Preanalyze_Spec_Expression (N, T);
+ Preanalyze_And_Resolve_Spec_Expression (N, T);
In_Assertion_Expr := In_Assertion_Expr - 1;
- end Preanalyze_Assert_Expression;
-
- -- ??? The variant below explicitly saves and restores all the flags,
- -- because it is impossible to compose the existing variety of
- -- Analyze/Resolve (and their wrappers, e.g. Preanalyze_Spec_Expression)
- -- to achieve the desired semantics.
+ end Preanalyze_And_Resolve_Assert_Expression;
- procedure Preanalyze_Assert_Expression (N : Node_Id) is
- Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
- Save_Full_Analysis : constant Boolean := Full_Analysis;
+ ----------------------------------------------
+ -- Preanalyze_And_Resolve_Assert_Expression --
+ ----------------------------------------------
+ procedure Preanalyze_And_Resolve_Assert_Expression (N : Node_Id) is
begin
In_Assertion_Expr := In_Assertion_Expr + 1;
- In_Spec_Expression := True;
- Full_Analysis := False;
- Expander_Mode_Save_And_Set (False);
-
- if GNATprove_Mode then
- Analyze_And_Resolve (N);
- else
- Analyze_And_Resolve (N, Suppress => All_Checks);
- end if;
-
- Expander_Mode_Restore;
- Full_Analysis := Save_Full_Analysis;
- In_Spec_Expression := Save_In_Spec_Expression;
+ Preanalyze_And_Resolve_Spec_Expression (N);
In_Assertion_Expr := In_Assertion_Expr - 1;
- end Preanalyze_Assert_Expression;
+ end Preanalyze_And_Resolve_Assert_Expression;
- -----------------------------------
- -- Preanalyze_Default_Expression --
- -----------------------------------
+ -----------------------------------------------
+ -- Preanalyze_And_Resolve_Default_Expression --
+ -----------------------------------------------
- procedure Preanalyze_Default_Expression (N : Node_Id; T : Entity_Id) is
+ procedure Preanalyze_And_Resolve_Default_Expression
+ (N : Node_Id;
+ T : Entity_Id)
+ is
Save_In_Default_Expr : constant Boolean := In_Default_Expr;
begin
In_Default_Expr := True;
- Preanalyze_Spec_Expression (N, T);
+ Preanalyze_And_Resolve_Spec_Expression (N, T);
In_Default_Expr := Save_In_Default_Expr;
- end Preanalyze_Default_Expression;
+ end Preanalyze_And_Resolve_Default_Expression;
- --------------------------------
- -- Preanalyze_Spec_Expression --
- --------------------------------
+ --------------------------------------------
+ -- Preanalyze_And_Resolve_Spec_Expression --
+ --------------------------------------------
- procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id) is
+ procedure Preanalyze_And_Resolve_Spec_Expression
+ (N : Node_Id;
+ T : Entity_Id)
+ is
Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
begin
In_Spec_Expression := True;
Preanalyze_And_Resolve (N, T);
In_Spec_Expression := Save_In_Spec_Expression;
- end Preanalyze_Spec_Expression;
+ end Preanalyze_And_Resolve_Spec_Expression;
+
+ --------------------------------------------
+ -- Preanalyze_And_Resolve_Spec_Expression --
+ --------------------------------------------
+
+ procedure Preanalyze_And_Resolve_Spec_Expression (N : Node_Id) is
+ Save_In_Spec_Expression : constant Boolean := In_Spec_Expression;
+ begin
+ In_Spec_Expression := True;
+ Preanalyze_And_Resolve (N);
+ In_Spec_Expression := Save_In_Spec_Expression;
+ end Preanalyze_And_Resolve_Spec_Expression;
----------------------------------------
-- Prepare_Private_Subtype_Completion --
@@ -21076,7 +21082,8 @@ package body Sem_Ch3 is
-- Per-Object Expressions" in spec of package Sem).
if Present (Expression (Discr)) then
- Preanalyze_Default_Expression (Expression (Discr), Discr_Type);
+ Preanalyze_And_Resolve_Default_Expression
+ (Expression (Discr), Discr_Type);
-- Legaity checks
diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads
index 3d9aa0a963a0..00a6fa770a41 100644
--- a/gcc/ada/sem_ch3.ads
+++ b/gcc/ada/sem_ch3.ads
@@ -236,19 +236,23 @@ package Sem_Ch3 is
-- Always False in Ada 95 mode. Equivalent to OK_For_Limited_Init_In_05 in
-- Ada 2005 mode.
- 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.
+ procedure Preanalyze_And_Resolve_Assert_Expression
+ (N : Node_Id;
+ T : Entity_Id);
+ -- Wrapper on Preanalyze_And_Resolve_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);
+ procedure Preanalyze_And_Resolve_Assert_Expression (N : Node_Id);
-- Similar to the above, but without forcing N to be of a particular type
- procedure Preanalyze_Spec_Expression (N : Node_Id; T : Entity_Id);
+ procedure Preanalyze_And_Resolve_Spec_Expression
+ (N : Node_Id;
+ T : Entity_Id);
-- Default and per object expressions do not freeze their components, and
-- must be analyzed and resolved accordingly. The analysis is done by
-- calling the Preanalyze_And_Resolve routine and setting the global
@@ -263,6 +267,9 @@ package Sem_Ch3 is
-- which would be misplaced in the tree. Preanalyze_And_Resolve must be
-- used in such a case to avoid reporting spurious errors.
+ procedure Preanalyze_And_Resolve_Spec_Expression (N : Node_Id);
+ -- Similar to the above, but without forcing N to be of a particular type
+
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
-- encountered and analyzed. The first action is to create the full views
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 05bbeeddae41..0cfcc1cb263b 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -581,12 +581,12 @@ package body Sem_Ch6 is
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);
+ Preanalyze_And_Resolve_Spec_Expression (Expr, Typ);
End_Scope;
else
Push_Scope (Def_Id);
Install_Formals (Def_Id);
- Preanalyze_Spec_Expression (Expr, Typ);
+ Preanalyze_And_Resolve_Spec_Expression (Expr, Typ);
Check_Limited_Return (Orig_N, Expr, Typ);
End_Scope;
end if;
@@ -617,7 +617,7 @@ package body Sem_Ch6 is
begin
Set_Checking_Potentially_Static_Expression (True);
- Preanalyze_Spec_Expression (Exp_Copy, Typ);
+ Preanalyze_And_Resolve_Spec_Expression (Exp_Copy, Typ);
if not Is_Static_Expression (Exp_Copy) then
Error_Msg_N
@@ -6094,7 +6094,7 @@ package body Sem_Ch6 is
if NewD then
Push_Scope (New_Id);
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Default_Value (New_Formal), Etype (New_Formal));
End_Scope;
end if;
@@ -6517,7 +6517,7 @@ package body Sem_Ch6 is
-- expanded, so expand now to check conformance.
if NewD then
- Preanalyze_Spec_Expression
+ Preanalyze_And_Resolve_Spec_Expression
(Expression (New_Discr), New_Discr_Type);
end if;
@@ -13207,7 +13207,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_Spec_Expression (Default, Formal_Type);
+ Preanalyze_And_Resolve_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_prag.adb b/gcc/ada/sem_prag.adb
index 621edc7725d8..6fe29665148d 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -474,7 +474,8 @@ package body Sem_Prag is
end if;
Errors := Serious_Errors_Detected;
- Preanalyze_Assert_Expression (Expression (Arg1), Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Expression (Arg1), Standard_Boolean);
-- Emit a clarification message when the expression contains at least
-- one undefined reference, possibly due to contract freezing.
@@ -564,7 +565,8 @@ package body Sem_Prag is
if Nkind (Case_Guard) /= N_Others_Choice then
Errors := Serious_Errors_Detected;
- Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Case_Guard, Standard_Boolean);
-- Emit a clarification message when the case guard contains
-- at least one undefined reference, possibly due to contract
@@ -579,7 +581,8 @@ package body Sem_Prag is
end if;
Errors := Serious_Errors_Detected;
- Preanalyze_Assert_Expression (Conseq, Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Conseq, Standard_Boolean);
-- Emit a clarification message when the consequence contains
-- at least one undefined reference, possibly due to contract
@@ -2391,9 +2394,10 @@ package body Sem_Prag is
Errors := Serious_Errors_Detected;
- -- Preanalyze_Assert_Expression enforcing the expression type
+ -- Preanalyze_And_Resolve_Assert_Expression enforcing the expression
+ -- type.
- Preanalyze_Assert_Expression (Consequence, Any_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression (Consequence, Any_Boolean);
Check_Params (Consequence);
@@ -2621,7 +2625,8 @@ package body Sem_Prag is
if Nkind (Case_Guard) /= N_Others_Choice then
Errors := Serious_Errors_Detected;
- Preanalyze_Assert_Expression (Case_Guard, Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Case_Guard, Standard_Boolean);
-- Emit a clarification message when the case guard contains
-- at least one undefined reference, possibly due to contract
@@ -5585,7 +5590,7 @@ package body Sem_Prag is
if Present (Arg2) then
Check_Optional_Identifier (Arg2, Name_Message);
- Preanalyze_Assert_Expression
+ Preanalyze_And_Resolve_Assert_Expression
(Get_Pragma_Arg (Arg2), Standard_String);
end if;
end if;
@@ -14065,7 +14070,7 @@ package body Sem_Prag is
-- Perform preanalysis to deal with embedded Loop_Entry
-- attributes.
- Preanalyze_Assert_Expression (Expr, Any_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression (Expr, Any_Boolean);
end if;
-- Implement Assert[_And_Cut]/Assume/Loop_Invariant by generating
@@ -16166,7 +16171,8 @@ package body Sem_Prag is
-- described in "Handling of Default and Per-Object
-- Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Arg, RTE (RE_CPU_Range));
-- See comment in Sem_Ch13 about the following restrictions
@@ -16212,7 +16218,7 @@ package body Sem_Prag is
-- The expression must be analyzed in the special manner described
-- in "Handling of Default and Per-Object Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_Time_Span));
+ Preanalyze_And_Resolve_Spec_Expression (Arg, RTE (RE_Time_Span));
-- Only protected types allowed
@@ -16841,7 +16847,8 @@ package body Sem_Prag is
-- described in "Handling of Default and Per-Object
-- Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_Dispatching_Domain));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Arg, RTE (RE_Dispatching_Domain));
-- Check duplicate pragma before we chain the pragma in the Rep
-- Item chain of Ent.
@@ -20074,7 +20081,8 @@ package body Sem_Prag is
-- described in "Handling of Default and Per-Object
-- Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_Interrupt_Priority));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Arg, RTE (RE_Interrupt_Priority));
end if;
if Nkind (P) not in N_Task_Definition | N_Protected_Definition then
@@ -20979,10 +20987,10 @@ package body Sem_Prag is
("Structural variant shall be the only variant", Variant);
end if;
- -- Preanalyze_Assert_Expression, but without enforcing any of
- -- the two acceptable types.
+ -- Preanalyze_And_Resolve_Assert_Expression, but without
+ -- enforcing any of the two acceptable types.
- Preanalyze_Assert_Expression (Expression (Variant));
+ Preanalyze_And_Resolve_Assert_Expression (Expression (Variant));
-- Expression of a discrete type is allowed. Nothing to
-- check for structural variants.
@@ -23410,7 +23418,8 @@ package body Sem_Prag is
-- described in "Handling of Default and Per-Object
-- Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_Any_Priority));
+ Preanalyze_And_Resolve_Spec_Expression
+ (Arg, RTE (RE_Any_Priority));
if not Is_OK_Static_Expression (Arg) then
Check_Restriction (Static_Priorities, Arg);
@@ -24397,7 +24406,7 @@ package body Sem_Prag is
-- The expression must be analyzed in the special manner described
-- in "Handling of Default and Per-Object Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, RTE (RE_Time_Span));
+ Preanalyze_And_Resolve_Spec_Expression (Arg, RTE (RE_Time_Span));
-- Subprogram case
@@ -24657,7 +24666,7 @@ package body Sem_Prag is
-- The expression must be analyzed in the special manner
-- described in "Handling of Default Expressions" in sem.ads.
- Preanalyze_Spec_Expression (Arg, Any_Integer);
+ Preanalyze_And_Resolve_Spec_Expression (Arg, Any_Integer);
-- The pragma cannot appear if the No_Secondary_Stack
-- restriction is in effect.
@@ -25815,7 +25824,7 @@ package body Sem_Prag is
-- in "Handling of Default Expressions" in sem.ads.
Arg := Get_Pragma_Arg (Arg1);
- Preanalyze_Spec_Expression (Arg, Any_Integer);
+ Preanalyze_And_Resolve_Spec_Expression (Arg, Any_Integer);
if not Is_OK_Static_Expression (Arg) then
Check_Restriction (Static_Storage_Size, Arg);
@@ -28241,7 +28250,7 @@ package body Sem_Prag is
end if;
Errors := Serious_Errors_Detected;
- Preanalyze_Assert_Expression (Expr, Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression (Expr, Standard_Boolean);
-- Emit a clarification message when the expression contains at least
-- one undefined reference, possibly due to contract freezing.
@@ -31452,10 +31461,10 @@ package body Sem_Prag is
Errors := Serious_Errors_Detected;
- -- Preanalyze_Assert_Expression, but without enforcing any of the
- -- acceptable types.
+ -- Preanalyze_And_Resolve_Assert_Expression, but without enforcing
+ -- any of the acceptable types.
- Preanalyze_Assert_Expression (Expr);
+ Preanalyze_And_Resolve_Assert_Expression (Expr);
-- Expression of a discrete type is allowed. Nothing more to check
-- for structural variants.
@@ -31633,7 +31642,7 @@ package body Sem_Prag is
From_Aspect => True);
if Present (Arg) then
- Preanalyze_Assert_Expression
+ Preanalyze_And_Resolve_Assert_Expression
(Expression (Arg), Standard_Boolean);
end if;
end if;
@@ -31641,7 +31650,8 @@ package body Sem_Prag is
Arg := Test_Case_Arg (N, Arg_Nam);
if Present (Arg) then
- Preanalyze_Assert_Expression (Expression (Arg), Standard_Boolean);
+ Preanalyze_And_Resolve_Assert_Expression
+ (Expression (Arg), Standard_Boolean);
end if;
end Preanalyze_Test_Case_Arg;
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 0df6c27c30d7..bbf7bb95ed84 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -2106,8 +2106,6 @@ package body Sem_Res is
Full_Analysis := False;
Expander_Mode_Save_And_Set (False);
- -- See also Preanalyze_And_Resolve in sem.adb for similar handling
-
-- Normally, we suppress all checks for this preanalysis. There is no
-- point in processing them now, since they will be applied properly
-- and in the proper location when the default expressions reanalyzed
@@ -2150,8 +2148,13 @@ package body Sem_Res is
Full_Analysis := False;
Expander_Mode_Save_And_Set (False);
- Analyze (N);
- Resolve (N, Etype (N), Suppress => All_Checks);
+ -- See previous version of Preanalyze_And_Resolve for similar handling
+
+ if GNATprove_Mode then
+ Analyze_And_Resolve (N);
+ else
+ Analyze_And_Resolve (N, Suppress => All_Checks);
+ end if;
Expander_Mode_Restore;
Full_Analysis := Save_Full_Analysis;
