[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

2 files changed, 33 insertions, 17 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8a0250d..3dd8c84 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,14 @@
 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
 	loop parameters.
 	* exp_ch7.adb (Check_Unnesting_Elaboration_Code): Handle subprogram
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 246d9eb..a7f9fbd 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;