https://gcc.gnu.org/g:6fdee070ff386bb5c284234afa3dfda9ba3d22db

commit r16-4226-g6fdee070ff386bb5c284234afa3dfda9ba3d22db
Author: Franck Behaghel <[email protected]>
Date:   Sun Oct 5 12:17:10 2025 +0200

    Ada: Fix assertion failure on allocators for discriminated type with default
    
    This is an incorrect node sharing for allocators built for a discriminated
    type with default values.
    
    gcc/ada/
            PR ada/110314
            * sem_ch4.adb (Analyze_Allocator): Add call to New_Copy_Tree.
    
    gcc/testsuite/
            * gnat.dg/allocator3.adb: New test.

Diff:
---
 gcc/ada/sem_ch4.adb                  |  3 ++-
 gcc/testsuite/gnat.dg/allocator3.adb | 23 +++++++++++++++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 61a53f56a98c..5704bf142c84 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -630,7 +630,8 @@ package body Sem_Ch4 is
 
                begin
                   while Present (Discr) loop
-                     Append (Discriminant_Default_Value (Discr), Constr);
+                     Append_To (Constr,
+                       New_Copy_Tree (Discriminant_Default_Value (Discr)));
                      Next_Discriminant (Discr);
                   end loop;
 
diff --git a/gcc/testsuite/gnat.dg/allocator3.adb 
b/gcc/testsuite/gnat.dg/allocator3.adb
new file mode 100644
index 000000000000..ac04344fbb1d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/allocator3.adb
@@ -0,0 +1,23 @@
+--  { dg-do compile }
+
+with Ada.Containers.Synchronized_Queue_Interfaces;
+with Ada.Containers.Unbounded_Synchronized_Queues;
+
+procedure Allocator3 is
+
+  package Queue_Interfaces is
+    new Ada.Containers.Synchronized_Queue_Interfaces (Integer);
+
+  package Synchronized_Queues is
+    new Ada.Containers.Unbounded_Synchronized_Queues (Queue_Interfaces);
+
+  subtype Queue is Synchronized_Queues.Queue;
+
+  type Access_Type is access all Queue;
+
+  Q1 : Access_Type := new Queue;
+  Q2 : Access_Type := new Queue;
+
+begin
+  null;
+end;

Reply via email to