From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 16 Jul 2018 14:11:58 +0000 (+0000)
Subject: [Ada] Fix Default_Storage_Pool aspect handling in generic instantiations
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=dbe5b438d26161111824727534ef99f4d41e39c4;p=gcc.git

[Ada] Fix Default_Storage_Pool aspect handling in generic instantiations

2018-07-16  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch12.adb (Analyze_Package_Instantiation): Handle properly an
	instance that carries an aspect Default_Storage_Pool that overrides a
	default storage pool that applies to the generic unit. The aspect in
	the generic unit was removed before copying it in the instance, rather
	than removing it from the copy of the aspects that are appended to the
	aspects in the instance.

From-SVN: r262724
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8a0250d4155..3dd8c84d1d5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2018-07-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Analyze_Package_Instantiation): Handle properly an
+	instance that carries an aspect Default_Storage_Pool that overrides a
+	default storage pool that applies to the generic unit. The aspect in
+	the generic unit was removed before copying it in the instance, rather
+	than removing it from the copy of the aspects that are appended to the
+	aspects in the instance.
+
 2018-07-16  Ed Schonberg  <schonberg@adacore.com>
 
 	* einfo.adb (Set_Is_Uplevel_Referenced_Entity): Flag can appear on
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 246d9eb9dc0..a7f9fbd2961 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -4217,34 +4217,41 @@ package body Sem_Ch12 is
             else
                declare
                   ASN1, ASN2 : Node_Id;
+                  Inherited_Aspects : constant List_Id :=
+                    New_Copy_List_Tree (Aspect_Specifications (Gen_Spec));
+                  Pool_Present : Boolean := False;
 
                begin
                   ASN1 := First (Aspect_Specifications (N));
                   while Present (ASN1) loop
                      if Chars (Identifier (ASN1)) = Name_Default_Storage_Pool
                      then
-                        --  If generic carries a default storage pool, remove
-                        --  it in favor of the instance one.
-
-                        ASN2 := First (Aspect_Specifications (Gen_Spec));
-                        while Present (ASN2) loop
-                           if Chars (Identifier (ASN2)) =
-                                                    Name_Default_Storage_Pool
-                           then
-                              Remove (ASN2);
-                              exit;
-                           end if;
-
-                           Next (ASN2);
-                        end loop;
+                        Pool_Present := True;
+                        exit;
                      end if;
 
                      Next (ASN1);
                   end loop;
 
-                  Prepend_List_To (Aspect_Specifications (N),
-                    (New_Copy_List_Tree
-                      (Aspect_Specifications (Gen_Spec))));
+                  if Pool_Present then
+                     --  If generic carries a default storage pool, remove
+                     --  it in favor of the instance one.
+
+                     ASN2 := First (Inherited_Aspects);
+                     while Present (ASN2) loop
+                        if Chars (Identifier (ASN2)) =
+                                                 Name_Default_Storage_Pool
+                        then
+                           Remove (ASN2);
+                           exit;
+                        end if;
+
+                        Next (ASN2);
+                     end loop;
+                  end if;
+
+                  Prepend_List_To
+                    (Aspect_Specifications (N), Inherited_Aspects);
                end;
             end if;
          end if;