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 61a53f56a98c1fb168155459d0c58791e34f61fb..5704bf142c8428db65233700d15452cc1cd13f18 100644 (file)
--- 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 (file)
index 0000000..ac04344
--- /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;