From: Franck Behaghel <franckbehaghel_gcc@protonmail.com>
Date: Sun, 5 Oct 2025 10:17:10 +0000 (+0200)
Subject: Ada: Fix assertion failure on allocators for discriminated type with default
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=6fdee070ff386bb5c284234afa3dfda9ba3d22db;p=thirdparty%2Fgcc.git

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 --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 61a53f56a98..5704bf142c8 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 00000000000..ac04344fbb1
--- /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;