https://gcc.gnu.org/g:003ed7d39343cdfb9dde70980c2aa67454bcacef
commit r15-6148-g003ed7d39343cdfb9dde70980c2aa67454bcacef
Author: Ronan Desplanques <desplanq...@adacore.com>
Date: Tue Nov 19 10:10:31 2024 +0100
ada: Accept static strings with External_Initialization
Before this patch, the argument to the External_Initialization aspect
had to be a string literal. This patch extends the possibilities so that
any static string is accepted.
A new helper function, Is_OK_Static_Expression_Of_Type, is introduced,
and in addition to the main change of this patch a couple of calls to
that helper function are added in other places to replace equivalent
inline code.
gcc/ada/ChangeLog:
* sem_eval.ads (Is_OK_Static_Expression_Of_Type): New function.
* sem_eval.adb (Is_OK_Static_Expression_Of_Type): Likewise.
* sem_ch13.adb (Check_Expr_Is_OK_Static_Expression): Use new
function.
* sem_prag.adb (Check_Expr_Is_OK_Static_Expression): Likewise.
* sem_ch3.adb (Apply_External_Initialization): Accept static strings
for the parameter.
Diff:
---
gcc/ada/sem_ch13.adb | 39 +++++++++++++--------------------------
gcc/ada/sem_ch3.adb | 24 ++++++++++++++++--------
gcc/ada/sem_eval.adb | 39 +++++++++++++++++++++++++++++++++++++++
gcc/ada/sem_eval.ads | 9 +++++++++
gcc/ada/sem_prag.adb | 50 ++++++++++++++------------------------------------
5 files changed, 91 insertions(+), 70 deletions(-)
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 1a3a16ac9ee5..14bc33582eba 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2581,35 +2581,22 @@ package body Sem_Ch13 is
----------------------------------------
procedure Check_Expr_Is_OK_Static_Expression
- (Expr : Node_Id;
- Typ : Entity_Id := Empty)
- is
+ (Expr : Node_Id; Typ : Entity_Id := Empty) is
begin
- if Present (Typ) then
- Analyze_And_Resolve (Expr, Typ);
- else
- Analyze_And_Resolve (Expr);
- end if;
-
- -- An expression cannot be considered static if its resolution
- -- failed or if it's erroneous. Stop the analysis of the
- -- related aspect.
-
- if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
- raise Aspect_Exit;
-
- elsif Is_OK_Static_Expression (Expr) then
- return;
+ case Is_OK_Static_Expression_Of_Type (Expr, Typ) is
+ when Static =>
+ null;
- -- Finally, we have a real error
+ when Not_Static =>
+ Error_Msg_Name_1 := Nam;
+ Flag_Non_Static_Expr
+ ("entity for aspect% must be a static expression!",
+ Expr);
+ raise Aspect_Exit;
- else
- Error_Msg_Name_1 := Nam;
- Flag_Non_Static_Expr
- ("entity for aspect% must be a static expression!",
- Expr);
- raise Aspect_Exit;
- end if;
+ when Invalid =>
+ raise Aspect_Exit;
+ end case;
end Check_Expr_Is_OK_Static_Expression;
------------------------
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f88c5adc9296..a5d69c33b151 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3906,15 +3906,22 @@ package body Sem_Ch3 is
Set_Expression (N, Error);
E := Error;
- if Nkind (Def) /= N_String_Literal then
- Error_Msg_N
- ("External_Initialization aspect expects a string literal value",
- Specification);
- return;
- end if;
+ case Is_OK_Static_Expression_Of_Type (Def, Standard_String) is
+ when Static =>
+ null;
+
+ when Not_Static =>
+ Error_Msg_N
+ ("External_Initialization aspect expects a static string",
+ Specification);
+ return;
+
+ when Invalid =>
+ return;
+ end case;
if not (Is_String_Type (T)
- or else Is_RTE (Base_Type (T), RE_Stream_Element_Array))
+ or else Is_RTE (Base_Type (T), RE_Stream_Element_Array))
then
Error_Msg_N
("External_Initialization aspect can only be applied to objects "
@@ -3924,7 +3931,8 @@ package body Sem_Ch3 is
end if;
declare
- S : constant String := Stringt.To_String (Strval (Def));
+ S : constant String :=
+ Stringt.To_String (Strval (Expr_Value_S (Def)));
begin
if System.OS_Lib.Is_Absolute_Path (S) then
Data_Path := Name_Find (S);
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 9ea042ba0d33..f0f83d29c383 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -5527,6 +5527,45 @@ package body Sem_Eval is
return Is_Static_Expression (N) and then not Raises_Constraint_Error (N);
end Is_OK_Static_Expression;
+ -------------------------------------
+ -- Is_OK_Static_Expression_Of_Type --
+ -------------------------------------
+
+ function Is_OK_Static_Expression_Of_Type
+ (Expr : Node_Id; Typ : Entity_Id := Empty) return Staticity is
+ begin
+ if Present (Typ) then
+ Analyze_And_Resolve (Expr, Typ);
+ else
+ Analyze_And_Resolve (Expr);
+ end if;
+
+ -- An expression cannot be considered static if its resolution
+ -- failed or if an error was flagged.
+
+ if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
+ return Invalid;
+ end if;
+
+ if Is_OK_Static_Expression (Expr) then
+ return Static;
+ end if;
+
+ -- An interesting special case, if we have a string literal and we
+ -- are in Ada 83 mode, then we allow it even though it will not be
+ -- flagged as static. This allows the use of Ada 95 pragmas like
+ -- Import in Ada 83 mode. They will of course be flagged with
+ -- warnings as usual, but will not cause errors.
+
+ if Ada_Version = Ada_83
+ and then Nkind (Expr) = N_String_Literal
+ then
+ return Static;
+ end if;
+
+ return Not_Static;
+ end Is_OK_Static_Expression_Of_Type;
+
------------------------
-- Is_OK_Static_Range --
------------------------
diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads
index b79f61f783de..177a3e2c585a 100644
--- a/gcc/ada/sem_eval.ads
+++ b/gcc/ada/sem_eval.ads
@@ -422,6 +422,15 @@ package Sem_Eval is
-- for compile time evaluation purposes. Use Compile_Time_Known_Value
-- instead (see section on "Compile-Time Known Values" above).
+ type Staticity is (Static, Not_Static, Invalid);
+
+ function Is_OK_Static_Expression_Of_Type
+ (Expr : Node_Id; Typ : Entity_Id := Empty) return Staticity;
+ -- Return whether Expr is a static expression of the given type (i.e. it
+ -- will be analyzed and resolved using this type, which can be any valid
+ -- argument to Resolve, e.g. Any_Integer is OK). Includes checking that the
+ -- expression does not raise Constraint_Error.
+
function Is_OK_Static_Range (N : Node_Id) return Boolean;
-- Determines if range is static, as defined in RM 4.9(26), and also checks
-- that neither bound of the range raises constraint error, thus ensuring
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index cc94b02e43ce..777870a9ab54 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -6395,45 +6395,23 @@ package body Sem_Prag is
----------------------------------------
procedure Check_Expr_Is_OK_Static_Expression
- (Expr : Node_Id;
- Typ : Entity_Id := Empty)
- is
+ (Expr : Node_Id; Typ : Entity_Id := Empty) is
begin
- if Present (Typ) then
- Analyze_And_Resolve (Expr, Typ);
- else
- Analyze_And_Resolve (Expr);
- end if;
-
- -- An expression cannot be considered static if its resolution failed
- -- or if it's erroneous. Stop the analysis of the related pragma.
-
- if Etype (Expr) = Any_Type or else Error_Posted (Expr) then
- raise Pragma_Exit;
-
- elsif Is_OK_Static_Expression (Expr) then
- return;
-
- -- An interesting special case, if we have a string literal and we
- -- are in Ada 83 mode, then we allow it even though it will not be
- -- flagged as static. This allows the use of Ada 95 pragmas like
- -- Import in Ada 83 mode. They will of course be flagged with
- -- warnings as usual, but will not cause errors.
-
- elsif Ada_Version = Ada_83
- and then Nkind (Expr) = N_String_Literal
- then
- return;
+ case Is_OK_Static_Expression_Of_Type (Expr, Typ) is
+ when Static =>
+ null;
- -- Finally, we have a real error
+ when Not_Static =>
+ Error_Msg_Name_1 := Pname;
+ Flag_Non_Static_Expr
+ (Fix_Error
+ ("argument for pragma% must be a static expression!"),
+ Expr);
+ raise Pragma_Exit;
- else
- Error_Msg_Name_1 := Pname;
- Flag_Non_Static_Expr
- (Fix_Error ("argument for pragma% must be a static expression!"),
- Expr);
- raise Pragma_Exit;
- end if;
+ when Invalid =>
+ raise Pragma_Exit;
+ end case;
end Check_Expr_Is_OK_Static_Expression;
-------------------------
