[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 8a0250d4155c3991409cc180fd9ebcf9a70f8e66..3dd8c84d1d5713f0b91c2d5b4b7c45763fa8538e 100644 (file)
--- 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 246d9eb9dc089c82f1bf627159ecdc63cb8c68f4..a7f9fbd2961ccc898e05588a98f63ac1f8806881 100644 (file)
--- 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;