https://gcc.gnu.org/g:ac957a621cf1e9beeb52695250b7600ed066448f
commit r15-3564-gac957a621cf1e9beeb52695250b7600ed066448f
Author: Piotr Trojanek <troja...@adacore.com>
Date: Wed Aug 28 17:56:06 2024 +0200
ada: Evaluate calls to GNAT.Source_Info routines in semantic checking
When semantic checking mode is active, i.e. when switch -gnatc is
present or when the frontend is operating in the GNATprove mode,
we now rewrite calls to GNAT.Source_Info routines in evaluation
and not expansion (which is disabled in these modes).
This is needed to recognize constants initialized with calls to
GNAT.Source_Info as static constants, regardless of expansion being
enabled.
gcc/ada/
* exp_intr.ads, exp_intr.adb (Expand_Source_Info): Move
declaration to package spec.
* sem_eval.adb (Eval_Intrinsic_Call): Evaluate calls to
GNAT.Source_Info where possible.
Diff:
---
gcc/ada/exp_intr.adb | 6 ------
gcc/ada/exp_intr.ads | 5 +++++
gcc/ada/sem_eval.adb | 37 ++++++++++++++++++++++++++++++++++---
3 files changed, 39 insertions(+), 9 deletions(-)
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index a076eb0eeb6a..0db0a66ab1c9 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -109,12 +109,6 @@ package body Exp_Intr is
-- Expand a call to corresponding function, declared in an instance of
-- System.Address_To_Access_Conversions.
- procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
- -- Rewrite the node as the appropriate string literal or positive
- -- constant. Nam is the name of one of the intrinsics declared in
- -- GNAT.Source_Info; see g-souinf.ads for documentation of these
- -- intrinsics.
-
---------------------
-- Add_Source_Info --
---------------------
diff --git a/gcc/ada/exp_intr.ads b/gcc/ada/exp_intr.ads
index 699d1c8164f9..75f24bf54950 100644
--- a/gcc/ada/exp_intr.ads
+++ b/gcc/ada/exp_intr.ads
@@ -39,6 +39,11 @@ package Exp_Intr is
-- documentation of these intrinsics. Loc is passed to provide location
-- information where it is needed.
+ procedure Expand_Source_Info (N : Node_Id; Nam : Name_Id);
+ -- Rewrite the node as the appropriate string literal or positive constant.
+ -- Nam is the name of one of the intrinsics declared in GNAT.Source_Info;
+ -- see g-souinf.ads for documentation of these intrinsics.
+
procedure Expand_Intrinsic_Call (N : Node_Id; E : Entity_Id);
-- N is either a function call node, a procedure call statement node, or
-- an operator where the corresponding subprogram is intrinsic (i.e. was
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index aaf0a766dc31..de3f35e9a619 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -33,6 +33,7 @@ with Einfo.Utils; use Einfo.Utils;
with Elists; use Elists;
with Errout; use Errout;
with Eval_Fat; use Eval_Fat;
+with Exp_Intr; use Exp_Intr;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
@@ -191,7 +192,7 @@ package body Sem_Eval is
-- (it is an error to make the call if these conditions are not met).
procedure Eval_Intrinsic_Call (N : Node_Id; E : Entity_Id);
- -- Evaluate a call N to an intrinsic subprogram E.
+ -- Evaluate a call N to an intrinsic subprogram E
function Find_Universal_Operator_Type (N : Node_Id) return Entity_Id;
-- Check whether an arithmetic operation with universal operands which is a
@@ -2888,13 +2889,43 @@ package body Sem_Eval is
end if;
case Nam is
- when Name_Shift_Left =>
+
+ -- Compilation date and time are the same for the entire compilation
+ -- unit, so we can replace them with static strings.
+
+ when Name_Compilation_ISO_Date
+ | Name_Compilation_Date
+ | Name_Compilation_Time
+ =>
+ Expand_Source_Info (N, Nam);
+
+ -- Calls to other intrinsics from the GNAT.Source_Info package give
+ -- different results, depending on where they occur. In particular,
+ -- for generics their results depend on where those generics are
+ -- instantiated; same for default values of subprogram parameters.
+ -- Those calls will behave as nonstatic, and we postpone their
+ -- rewriting until expansion.
+
+ when Name_Enclosing_Entity
+ | Name_File
+ | Name_Line
+ | Name_Source_Location
+ =>
+ if Inside_A_Generic
+ or else In_Spec_Expression
+ then
+ null;
+ else
+ Expand_Source_Info (N, Nam);
+ end if;
+
+ when Name_Shift_Left =>
Eval_Shift (N, E, N_Op_Shift_Left);
when Name_Shift_Right =>
Eval_Shift (N, E, N_Op_Shift_Right);
when Name_Shift_Right_Arithmetic =>
Eval_Shift (N, E, N_Op_Shift_Right_Arithmetic);
- when others =>
+ when others =>
null;
end case;
end Eval_Intrinsic_Call;
