From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-lf1-x12a.google.com (mail-lf1-x12a.google.com [IPv6:2a00:1450:4864:20::12a]) by sourceware.org (Postfix) with ESMTPS id 922A1385800A for ; Mon, 11 Oct 2021 13:39:14 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 922A1385800A Received: by mail-lf1-x12a.google.com with SMTP id x27so73814202lfa.9 for ; Mon, 11 Oct 2021 06:39:14 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=E65UoMeVxD+6s4zfBp46Qr3eghKTmiY0kdiRs2cRWjc=; b=Y2edd66m7oSdf3Q5MRDwY4iM0d5HtW5poPBPCfTw9+CFmFTMKJ40+t6KO1Y+FX74hN Z42ScgDKOf4hbBLDRooIYvE0Yi/gUw6CZqkQ3ZQB7QkuDpCAtmoLY1XuYyuaVbeIpcF7 tUB+jZP0HPNk+R2P526ybSbZFOi4l9F1BilaVn9WrkLMSM/zZgKOtEYQ5bwDFg+lrE8Z oKN6MszZNGqa60Z8fpPXwXtlyhaWO+YzhafFDxH16HLAnZ1JJHMDhRLFnHmM5+Gs/7Vi NTAZSa4vGs4pPohue7jjkRm0AxJn0ju/5kTCSHvllWyPiO3W6yYdlJt2KrWNY1BBsuGR a+rQ== X-Gm-Message-State: AOAM532xgVw6oNk9LDAQfOhSGkfVthqDjxlpvt7ZJTbBHDmd4ZE72r52 g2uxcZ8BRAk3XGb3x0VxPsgyEP+VpMGtMQ== X-Google-Smtp-Source: ABdhPJzE2phCQ1Kk+ww1bioLqwBrKXTAHx2+DklOa6/UabFU1wUPgYX8HVMETF1S6LtrrVLHq+NgKg== X-Received: by 2002:a2e:4b19:: with SMTP id y25mr23092209lja.501.1633959544857; Mon, 11 Oct 2021 06:39:04 -0700 (PDT) Received: from adacore.com ([2a02:2ab8:224:2ce:72b5:e8ff:feef:ee60]) by smtp.gmail.com with ESMTPSA id q10sm733490lfe.294.2021.10.11.06.39.03 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 11 Oct 2021 06:39:04 -0700 (PDT) Date: Mon, 11 Oct 2021 13:39:03 +0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Piotr Trojanek Subject: [Ada] Fix crash on array component with Default_Value Message-ID: <20211011133903.GA1518538@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="NzB8fVQJ5HfG6fxh" Content-Disposition: inline X-Spam-Status: No, score=-13.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Mon, 11 Oct 2021 13:39:19 -0000 --NzB8fVQJ5HfG6fxh Content-Type: text/plain; charset=us-ascii Content-Disposition: inline When complaining about a compile-time constraint error within a default initialization procedure we assumed that this procedure initializes a record object. However, it can initialize an array object too. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_util.adb (Inside_Init_Proc): Simplify. * sem_aggr.adb (Resolve_Record_Aggregate): Fix style. * sem_util.adb (Compile_Time_Constraint_Error): Guard against calling Corresponding_Concurrent_Type with an array type entity. --NzB8fVQJ5HfG6fxh Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -7994,10 +7994,8 @@ package body Exp_Util is ---------------------- function Inside_Init_Proc return Boolean is - Proc : constant Entity_Id := Enclosing_Init_Proc; - begin - return Proc /= Empty; + return Present (Enclosing_Init_Proc); end Inside_Init_Proc; ---------------------- 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 @@ -5307,8 +5307,8 @@ package body Sem_Aggr is Add_Association (Component => Component, - Expr => Empty, - Assoc_List => New_Assoc_List, + Expr => Empty, + Assoc_List => New_Assoc_List, Is_Box_Present => True); elsif Present (Parent (Component)) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6589,11 +6589,16 @@ package body Sem_Util is if Inside_Init_Proc then declare + Init_Proc_Type : constant Entity_Id := + Entity (Parameter_Type (First + (Parameter_Specifications + (Parent (Current_Scope_No_Loops))))); + Conc_Typ : constant Entity_Id := - Corresponding_Concurrent_Type - (Entity (Parameter_Type (First - (Parameter_Specifications - (Parent (Current_Scope)))))); + (if Present (Init_Proc_Type) + and then Init_Proc_Type in E_Record_Type_Id + then Corresponding_Concurrent_Type (Init_Proc_Type) + else Empty); begin -- Don't complain if the corresponding concurrent type --NzB8fVQJ5HfG6fxh--