Commit 531351e8 by Ed Schonberg Committed by Pierre-Marie de Rodat

[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
parent 9c629d61
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> 2018-05-22 Doug Rupp <rupp@adacore.com>
* sigtramp-vxworks-target.inc: Align stack to 128bits on AArch64. * sigtramp-vxworks-target.inc: Align stack to 128bits on AArch64.
......
...@@ -30359,11 +30359,18 @@ package body Sem_Prag is ...@@ -30359,11 +30359,18 @@ package body Sem_Prag is
if Compile_Time_Known_Value (Arg1x) then if Compile_Time_Known_Value (Arg1x) then
if Is_True (Expr_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 declare
Cent : constant Entity_Id := Cunit_Entity (Current_Sem_Unit); Cent : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
Pname : constant Name_Id := Pragma_Name_Unmapped (N); Pname : constant Name_Id := Pragma_Name_Unmapped (N);
Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pname); 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); Str_Len : constant Nat := String_Length (Str);
Force : constant Boolean := Force : constant Boolean :=
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment