From dbe5b438d26161111824727534ef99f4d41e39c4 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Mon, 16 Jul 2018 14:11:58 +0000 Subject: [PATCH] [Ada] Fix Default_Storage_Pool aspect handling in generic instantiations 2018-07-16 Ed Schonberg 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 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch12.adb | 41 ++++++++++++++++++++++++----------------- 2 files changed, 33 insertions(+), 17 deletions(-) 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 + + * 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 * 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; -- 2.30.2