Ada: Fix internal error on pragma Machine_Attribute with string constant

This was reported a long time ago and is a fairly pathological case,
so the fix is purposely ad hoc: when the attribute name of a pragma
Machine_Attribute is not a string literal, its processing needs to
be delayed for the back-end.

gcc/ada/
	PR ada/13370
	* sem_prag.adb (Analyze_Pragma) <Pragma_Machine_Attribute>: Set the
	Has_Delayed_Freeze flag if the argument is not a literal.

gcc/testsuite/
	* gnat.dg/machine_attr3.ads, gnat.dg/machine_attr3.adb: New test.

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 28c5f1776dbb2699cde004983f991b8cbe6a4ab9..6b38de037bf9fad5de96e270bb5cd5a33a3f9fb6 100644 (file)
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -21867,8 +21867,17 @@ package body Sem_Prag is
 
             if Rep_Item_Too_Late (Def_Id, N) then
                return;
-            else
-               Set_Has_Gigi_Rep_Item (Def_Id);
+            end if;
+
+            Set_Has_Gigi_Rep_Item (Def_Id);
+
+            --  The pragma is processed directly by the back end when Def_Id is
+            --  translated. If the argument is not a string literal, it may be
+            --  declared after Def_Id and before the pragma, which requires the
+            --  processing of Def_Id to be delayed for the back end.
+
+            if Nkind (Get_Pragma_Arg (Arg2)) /= N_String_Literal then
+               Set_Has_Delayed_Freeze (Def_Id);
             end if;
          end Machine_Attribute;
 

diff --git a/gcc/testsuite/gnat.dg/machine_attr3.adb b/gcc/testsuite/gnat.dg/machine_attr3.adb
new file mode 100644 (file)
index 0000000..68a9c77
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/machine_attr3.adb
@@ -0,0 +1,7 @@
+-- { dg-do compile }
+
+package body Machine_Attr3 is
+
+  procedure Proc is null;
+
+end Machine_Attr3;

diff --git a/gcc/testsuite/gnat.dg/machine_attr3.ads b/gcc/testsuite/gnat.dg/machine_attr3.ads
new file mode 100644 (file)
index 0000000..edb7b7d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/machine_attr3.ads
@@ -0,0 +1,10 @@
+package Machine_Attr3 is
+
+  procedure Proc;
+
+private
+
+  Attr : constant String := "nothrow";
+  pragma Machine_Attribute (Proc, Attr);
+
+end Machine_Attr3;