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 --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 1a3a16ac9ee5913c48a0505dd90f8fe26903754a..14bc33582eba8c93d8344be8445a1a7375d5426e 100644 (file)
--- 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 f88c5adc92962a10755251fb610afb33c6cd50a2..a5d69c33b1519015bfa14e4604a9084c9c52cfb5 100644 (file)
--- 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 9ea042ba0d3376e7c01c0662e872bdc138d4d1c6..f0f83d29c3836e946de3a0dab78b6bc5fc1c1d2f 100644 (file)
--- 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 b79f61f783de9b33a56b9e60e791ed6e64bd5161..177a3e2c585ae3a10ed76b04b6d784a45051ee36 100644 (file)
--- 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 cc94b02e43ce145e9f7422c58d9a5496f8281436..777870a9ab544cf27a725774bc7c9f31de038ace 100644 (file)
--- 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;
 
       -------------------------