From: Ed Schonberg <schonberg@adacore.com>
Date: Tue, 22 May 2018 13:22:06 +0000 (+0000)
Subject: [Ada] Crash on pragma Compile_Time_Warning with declared string constant
X-Git-Tag: basepoints/gcc-10~6650
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=531351e8f4b0290e252009d5667498db4570a3fb;p=thirdparty%2Fgcc.git

[Ada] Crash on pragma Compile_Time_Warning with declared string constant

This patch fixes a compiler abort on a pragma Compile_Time_Warning when its
second argument is a reference to a constsant string (rather than a string
literal or an expression that evaluates to a string literal).

Compiling msain.adb must yield:

   main.adb:5:33: warning: Good
   main.adb:6:33: warning: VALLUE
   main.adb:7:33: warning: Test

----
procedure Main is
   Value : constant String := "Test";
   Switch : constant Boolean := True;
begin
   pragma Compile_Time_Warning (Switch, "Good");
   pragma Compile_Time_Warning (Switch, "VAL" & "LUE");
   pragma Compile_Time_Warning (Switch, value);
   null;
end Main;

2018-05-22  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_prag.adb (Process_Compile_Time_Warning_Or_Error): Handle properly
	a second argument that is a constant of a given string value.

From-SVN: r260514
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 707ca720d6a2..c67e473f1f9c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-05-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Process_Compile_Time_Warning_Or_Error): Handle properly
+	a second argument that is a constant of a given string value.
+
 2018-05-22  Doug Rupp  <rupp@adacore.com>
 
 	* sigtramp-vxworks-target.inc: Align stack to 128bits on AArch64.
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ed7441ae7f4e..8dae23dc5d6e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -30359,11 +30359,18 @@ package body Sem_Prag is
 
       if Compile_Time_Known_Value (Arg1x) then
          if Is_True (Expr_Value (Arg1x)) then
+
+            --  We have already verified that the second argument is a static
+            --  string expression. Its string value must be retrieved
+            --  explicitly if it is a declared constant, otherwise it has
+            --  been constant-folded previously.
+
             declare
                Cent    : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
                Pname   : constant Name_Id   := Pragma_Name_Unmapped (N);
                Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname);
-               Str     : constant String_Id := Strval (Get_Pragma_Arg (Arg2));
+               Str     : constant String_Id :=
+                           Strval (Expr_Value_S (Get_Pragma_Arg (Arg2)));
                Str_Len : constant Nat       := String_Length (Str);
 
                Force : constant Boolean :=