From baa73659cd03da29441004466ace3f57a05e6b8f Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Sun, 26 Oct 2025 10:21:31 +0100 Subject: [PATCH] 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) : 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. --- 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(-) create mode 100644 gcc/testsuite/gnat.dg/machine_attr3.adb create mode 100644 gcc/testsuite/gnat.dg/machine_attr3.ads diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 28c5f1776db..6b38de037bf 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 00000000000..68a9c77cbf1 --- /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 00000000000..edb7b7d0ee5 --- /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; -- 2.47.3