diff options
-rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch12.adb | 41 |
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; |