https://gcc.gnu.org/g:baa73659cd03da29441004466ace3f57a05e6b8f

commit r16-4629-gbaa73659cd03da29441004466ace3f57a05e6b8f
Author: Eric Botcazou <[email protected]>
Date:   Sun Oct 26 10:21:31 2025 +0100

    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:
---
 gcc/ada/sem_prag.adb                    | 13 +++++++++++--
 gcc/testsuite/gnat.dg/machine_attr3.adb |  7 +++++++
 gcc/testsuite/gnat.dg/machine_attr3.ads | 10 ++++++++++
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 28c5f1776dbb..6b38de037bf9 100644
--- 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
index 000000000000..68a9c77cbf13
--- /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
index 000000000000..edb7b7d0ee53
--- /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;

Reply via email to