From patchwork Thu May 25 08:06:28 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 70051 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 780593883020 for ; Thu, 25 May 2023 08:19:49 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 780593883020 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1685002789; bh=OUFnOPJp/tRClTZhs/ohD3HzIH7gjFN6T32Ek77sHPE=; h=To:Cc:Subject:Date:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:List-Subscribe:From:Reply-To:From; b=ntC2b6BBgmmby7GKcSU3ZgxSOYysXLXpWYgQ41V3910vwSy1klBFOinOjftf6Zame bG+GHXhNHleyGMf8r1lqpKlaX+6xcsimdTDnmWox3ssmds++QeJE+9rHNvBFuW2ds3 CIIO29Wd87zCH2PaqCBBG1Dw5L/E3Fc+F8KK5jIo= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x432.google.com (mail-wr1-x432.google.com [IPv6:2a00:1450:4864:20::432]) by sourceware.org (Postfix) with ESMTPS id 11ED1388202D for ; Thu, 25 May 2023 08:06:31 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 11ED1388202D Received: by mail-wr1-x432.google.com with SMTP id ffacd0b85a97d-30a8c4afa46so497266f8f.1 for ; Thu, 25 May 2023 01:06:31 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1685001989; x=1687593989; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=OUFnOPJp/tRClTZhs/ohD3HzIH7gjFN6T32Ek77sHPE=; b=I5bGcmydspPQhRKnSVIak6wc8deOt+bYIVMWC6USL8Z6yx4K9Py/PWpmv8H17ORpY0 FOAvUpuk7dAi8YXF5AORq2E3L7Zk2oa3sH+LVlGKWhWzR1+sUMUfUf0CzTf5ngLDr6Ph Xyw2/c/VZoqelLVj2gBYYPM8dil7S2IP+zXrgZOpRZUmNbLqRKsUT8Io69LHj3b/h/Ka W9HcLprJ+uzrfS3vKdlm7wGorNM+OR1iTEYSXe3t3mW3dZ0118ljlQ7qiVVSm2cieYYq X/dCUMoChH17YYGrrsJib/l3M5ezqOvNtrTOJkv+Tpnyc627cCdiU9p0hkM2Ic5chOV8 XkNQ== X-Gm-Message-State: AC+VfDy+PubCdYbLZGBnmB4vyuiHNYXmw15bXHUx4cdg+j4miysF9Y8F xRCOHYifVy68aHvtXVY41D+4slGg58MKPwrP+ZDaeQ== X-Google-Smtp-Source: ACHHUZ5wrjVaraOgPh5kiSqwVjKl/hCUjW7a6Gf+lq9FVOztx0wxpFA5w754G3TjVWWxj8n/6M8Jxg== X-Received: by 2002:adf:eac4:0:b0:2fb:ea86:36b8 with SMTP id o4-20020adfeac4000000b002fbea8636b8mr1319023wrn.5.1685001989555; Thu, 25 May 2023 01:06:29 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id t7-20020adff047000000b003068f5cca8csm871545wro.94.2023.05.25.01.06.28 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 25 May 2023 01:06:29 -0700 (PDT) To: gcc-patches@gcc.gnu.org Cc: Javier Miranda Subject: [COMMITTED] ada: Missing warning on null-excluding array aggregate component Date: Thu, 25 May 2023 10:06:28 +0200 Message-Id: <20230525080628.1957926-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 X-Spam-Status: No, score=-13.3 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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-Patchwork-Original-From: =?utf-8?q?Marc_Poulhi=C3=A8s_via_Gcc-patches?= From: =?utf-8?q?Marc_Poulhi=C3=A8s?= Reply-To: =?utf-8?q?Marc_Poulhi=C3=A8s?= Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" From: Javier Miranda The compiler does not report warnings on the initialization of arrays of null-excluding access type components by means of iterated component association, when the expression initializing each component is either a conditional expression or a case expression that may initialize some component with a null value. gcc/ada/ * sem_aggr.adb (Warn_On_Null_Component_Association): New subprogram. (Empty_Range): Adding missing support for iterated component association node. (Resolve_Array_Aggregate): Report warning on iterated component association that may initialize some component of an array of null-excluding access type components with a null value. * exp_ch4.adb (Expand_N_Expression_With_Actions): Add missing type check since the subtype of the EWA node and the subtype of the expression may differ. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_ch4.adb | 5 ++ gcc/ada/sem_aggr.adb | 163 ++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 165 insertions(+), 3 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index c7727904df2..48692c06f01 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5728,6 +5728,11 @@ package body Exp_Ch4 is -- the usual forced evaluation to encapsulate potential aliasing. else + -- A check is also needed since the subtype of the EWA node and the + -- subtype of the expression may differ (for example, the EWA node + -- may have a null-excluding access subtype). + + Apply_Constraint_Check (Expression (N), Etype (N)); Force_Evaluation (Expression (N)); end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d9520ca8f4b..e7643277460 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1340,6 +1340,12 @@ package body Sem_Aggr is Index_Typ : Entity_Id); -- For AI12-061 + procedure Warn_On_Null_Component_Association (Expr : Node_Id); + -- Expr is either a conditional expression or a case expression of an + -- iterated component association initializing the aggregate N with + -- components that can never be null. Report warning on associations + -- that may initialize some component with a null value. + --------- -- Add -- --------- @@ -1877,6 +1883,132 @@ package body Sem_Aggr is End_Scope; end Resolve_Iterated_Component_Association; + ---------------------------------------- + -- Warn_On_Null_Component_Association -- + ---------------------------------------- + + procedure Warn_On_Null_Component_Association (Expr : Node_Id) is + Comp_Typ : constant Entity_Id := Component_Type (Etype (N)); + + procedure Check_Case_Expr (N : Node_Id); + -- Check if a case expression may initialize some component with a + -- null value. + + procedure Check_Cond_Expr (N : Node_Id); + -- Check if a conditional expression may initialize some component + -- with a null value. + + procedure Check_Expr (Expr : Node_Id); + -- Check if an expression may initialize some component with a + -- null value. + + procedure Warn_On_Null_Expression_And_Rewrite (Null_Expr : Node_Id); + -- Report warning on known null expression and replace the expression + -- by a raise constraint error node. + + --------------------- + -- Check_Case_Expr -- + --------------------- + + procedure Check_Case_Expr (N : Node_Id) is + Alt_Node : Node_Id := First (Alternatives (N)); + + begin + while Present (Alt_Node) loop + Check_Expr (Expression (Alt_Node)); + Next (Alt_Node); + end loop; + end Check_Case_Expr; + + --------------------- + -- Check_Cond_Expr -- + --------------------- + + procedure Check_Cond_Expr (N : Node_Id) is + If_Expr : Node_Id := N; + Then_Expr : Node_Id; + Else_Expr : Node_Id; + + begin + Then_Expr := Next (First (Expressions (If_Expr))); + Else_Expr := Next (Then_Expr); + + Check_Expr (Then_Expr); + + -- Process elsif parts (if any) + + while Nkind (Else_Expr) = N_If_Expression loop + If_Expr := Else_Expr; + Then_Expr := Next (First (Expressions (If_Expr))); + Else_Expr := Next (Then_Expr); + + Check_Expr (Then_Expr); + end loop; + + if Known_Null (Else_Expr) then + Warn_On_Null_Expression_And_Rewrite (Else_Expr); + end if; + end Check_Cond_Expr; + + ---------------- + -- Check_Expr -- + ---------------- + + procedure Check_Expr (Expr : Node_Id) is + begin + if Known_Null (Expr) then + Warn_On_Null_Expression_And_Rewrite (Expr); + + elsif Nkind (Expr) = N_If_Expression then + Check_Cond_Expr (Expr); + + elsif Nkind (Expr) = N_Case_Expression then + Check_Case_Expr (Expr); + end if; + end Check_Expr; + + ----------------------------------------- + -- Warn_On_Null_Expression_And_Rewrite -- + ----------------------------------------- + + procedure Warn_On_Null_Expression_And_Rewrite (Null_Expr : Node_Id) is + begin + Error_Msg_N + ("(Ada 2005) NULL not allowed in null-excluding component??", + Null_Expr); + Error_Msg_N + ("\Constraint_Error might be raised at run time??", Null_Expr); + + -- We cannot use Apply_Compile_Time_Constraint_Error because in + -- some cases the components are rewritten and the runtime error + -- would be missed. + + Rewrite (Null_Expr, + Make_Raise_Constraint_Error (Sloc (Null_Expr), + Reason => CE_Access_Check_Failed)); + + Set_Etype (Null_Expr, Comp_Typ); + Set_Analyzed (Null_Expr); + end Warn_On_Null_Expression_And_Rewrite; + + -- Start of processing for Warn_On_Null_Component_Association + + begin + pragma Assert (Can_Never_Be_Null (Comp_Typ)); + + case Nkind (Expr) is + when N_If_Expression => + Check_Cond_Expr (Expr); + + when N_Case_Expression => + Check_Case_Expr (Expr); + + when others => + pragma Assert (False); + null; + end case; + end Warn_On_Null_Component_Association; + -- Local variables Assoc : Node_Id; @@ -2146,8 +2278,15 @@ package body Sem_Aggr is ----------------- function Empty_Range (A : Node_Id) return Boolean is - R : constant Node_Id := First (Choices (A)); + R : Node_Id; + begin + if Nkind (A) = N_Iterated_Component_Association then + R := First (Discrete_Choices (A)); + else + R := First (Choices (A)); + end if; + return No (Next (R)) and then Nkind (R) = N_Range and then Compile_Time_Compare @@ -2313,10 +2452,28 @@ package body Sem_Aggr is -- Ada 2005 (AI-231) if Ada_Version >= Ada_2005 - and then Known_Null (Expression (Assoc)) and then not Empty_Range (Assoc) then - Check_Can_Never_Be_Null (Etype (N), Expression (Assoc)); + if Known_Null (Expression (Assoc)) then + Check_Can_Never_Be_Null (Etype (N), Expression (Assoc)); + + -- Report warning on iterated component association that may + -- initialize some component of an array of null-excluding + -- access type components with a null value. For example: + + -- type AList is array (...) of not null access Integer; + -- L : AList := + -- [for J in A'Range => + -- (if Func (J) = 0 then A(J)'Access else Null)]; + + elsif Ada_Version >= Ada_2022 + and then Can_Never_Be_Null (Component_Type (Etype (N))) + and then Nkind (Assoc) = N_Iterated_Component_Association + and then Nkind (Expression (Assoc)) in N_If_Expression + | N_Case_Expression + then + Warn_On_Null_Component_Association (Expression (Assoc)); + end if; end if; -- Ada 2005 (AI-287): In case of default initialized component