From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 23524384A87E for ; Tue, 24 Nov 2020 10:17:02 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 23524384A87E Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=derodat@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id E6AD5116A13; Tue, 24 Nov 2020 05:17:01 -0500 (EST) X-Virus-Scanned: Debian amavisd-new at gnat.com Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id W3yg6CNcTlBJ; Tue, 24 Nov 2020 05:17:01 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id CB784116A63; Tue, 24 Nov 2020 05:17:01 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id CA79F107; Tue, 24 Nov 2020 05:17:01 -0500 (EST) Date: Tue, 24 Nov 2020 05:17:01 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [Ada] Fix resolution of subtype_indication in delta aggregates Message-ID: <20201124101701.GA1158@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="azLHFNyN32YCQGCU" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-10.8 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 24 Nov 2020 10:17:05 -0000 --azLHFNyN32YCQGCU Content-Type: text/plain; charset=us-ascii Content-Disposition: inline For a Subtype_Indication in ordinary array aggregates we explicitly call Resolve_Discrete_Subtype_Indication; for a Subtype_Indication in delta array aggregates we implicitly call Sem_Ch3.Analyze_Subtype_Indication, which is only meant to be used in declarations, not in expressions. This subtle difference causes a crash in GNATprove mode when delta aggregate appears inside a body that is inlined-for-proof (which involves an unusual combination of flags Expander_Active, Full_Analysis and GNATprove_Mode). Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_aggr.adb (Resolve_Delta_Array_Aggregate): If the choice is a subtype_indication then call Resolve_Discrete_Subtype_Indication; both for choices immediately inside array delta aggregates and inside iterated_component_association within array delta aggregates. --azLHFNyN32YCQGCU Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -3072,6 +3072,10 @@ package body Sem_Aggr is Error_Msg_N ("others not allowed in delta aggregate", Choice); + elsif Nkind (Choice) = N_Subtype_Indication then + Resolve_Discrete_Subtype_Indication + (Choice, Base_Type (Index_Type)); + else Analyze_And_Resolve (Choice, Index_Type); end if; @@ -3109,28 +3113,31 @@ package body Sem_Aggr is else Choice := First (Choice_List (Assoc)); while Present (Choice) loop + Analyze (Choice); + if Nkind (Choice) = N_Others_Choice then Error_Msg_N ("others not allowed in delta aggregate", Choice); - else - Analyze (Choice); + elsif Is_Entity_Name (Choice) + and then Is_Type (Entity (Choice)) + then + -- Choice covers a range of values - if Is_Entity_Name (Choice) - and then Is_Type (Entity (Choice)) + if Base_Type (Entity (Choice)) /= + Base_Type (Index_Type) then - -- Choice covers a range of values - - if Base_Type (Entity (Choice)) /= - Base_Type (Index_Type) - then - Error_Msg_NE - ("choice does not match index type of &", - Choice, Typ); - end if; - else - Resolve (Choice, Index_Type); + Error_Msg_NE + ("choice does not match index type of &", + Choice, Typ); end if; + + elsif Nkind (Choice) = N_Subtype_Indication then + Resolve_Discrete_Subtype_Indication + (Choice, Base_Type (Index_Type)); + + else + Resolve (Choice, Index_Type); end if; Next (Choice); --azLHFNyN32YCQGCU--