From patchwork Tue Sep 3 08:20:54 2024 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: 1979881 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=ItYfFzGK; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4Wydrb0qPgz1ygj for ; Tue, 3 Sep 2024 18:21:51 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id D0994386101C for ; Tue, 3 Sep 2024 08:21:48 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id 8E60C385DDDE for ; Tue, 3 Sep 2024 08:21:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8E60C385DDDE Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 8E60C385DDDE Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::329 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1725351679; cv=none; b=xOf6v1hP9UbU8gZ0twxzbfowfC6Wkz2kzcaLSFuhVUs1HE4yOzCKnDefLpdZybFak5CAgdSfjb8GkjEHlQ3RBVIdAF9gk+borNKNKYSZEP1z/711QW/upGOjd+qWFqHSrcfCBawzOnyJrw5oeGAgnN5yzef4PBFi+fpJXvKda5s= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1725351679; c=relaxed/simple; bh=s1+pSR/WJzSt/LtgDUktBHiDptAAVVs/7ee7guVJtbg=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=Jknto/nF4FXh1LZsEjGl9ENzmg6tgIO3pe23UmRsDL4WEoK9sVsHhoRTKXeah3VKzoDcKjx18+BrSoC9B/dPegcloJuW0NuMzLulLCAT4ytw/jx5BkC2VIqUp4SeLnZsnnwJaZDOrhSMVAHMhKu/AuB0EzTldSo2g/Bq4hvDf9g= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-42c7b5b2d01so29085935e9.3 for ; Tue, 03 Sep 2024 01:21:16 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1725351675; x=1725956475; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=VJZi89ZvN0AjLDPZyHoCxuGH/w3D6efaeSqCopRO8/w=; b=ItYfFzGKD1DmSav+KEq5ctuZQRtFgsT01SBHaVjjZO2SSgv990g5E0HtBYAMW07hLW 54H/mtZ0sJkbfyAiyXKI+A7/EcsqaLZ9IjekqJz5r3tkDOVQxVTN0Dlmvs0JO2/1oK1Q D/jycQCu0lMz2rwS5UWxHiPFuf2wn3OYxucQvVVpJYk90JM66NNDs2clD1pIgyPmbPYD 7Eggt7xhrCe/zjvTDTgzYl7kbvdL2cXC+Nqzcc6pwyX2PyxOAEo0KJCmncS7pifLIV1t N1xLg9CrkoR2fqJTo6GUiH1W3UE3TXo5DzMw8MGGOqHwcpibQCq+9uTt7CoirsSQYGT/ snkg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1725351675; x=1725956475; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=VJZi89ZvN0AjLDPZyHoCxuGH/w3D6efaeSqCopRO8/w=; b=ADb6aeYFd0HOOMnMPlnp2A3/IJx6s0MdzH7Z6B9W/ADXzHBKAs+d6C8sxWZ5BKg37g VtX0TqSHLWwyat+0TMcMTscKYkadkjFcDNGeo7RCe+s8sx1a/m+3OqbpbC5RTzXRbVX+ Upu6uBoebY0dSo9CONGU8Q8F/RcPrTdGIbWLiFtLsb59N1XPWQeTvypmJsWLUaPnGO/i W9XuFXVILlwySMlX8e8iTtZdwjo8bkFw/ki9VVM7lBUW2PfHbzOQtDeRIqOddu23ymHG +/awr0Kml12YAIwujqOTy5lZbNOTrKj5rYiIunWdUs4ctGiYQxsc7LkO9EtdaSYbrbVs 0liw== X-Gm-Message-State: AOJu0YwW6tkHbYV2atAvh3ueSo5Fw+jlZTN8b9NHjLD/aKmPyA74Fror xqjDlnuMBOb+eSh592auu1ehZOeScRaWIk46JY9FGlG4tKw8yeTRuelSGkB25pGexmjKb5PUFz8 = X-Google-Smtp-Source: AGHT+IGnFLCCWl7tMUGLd0ZahyuYoFLkvEZSk7iDBOS7WmQpvri9zMtNqbfbslJRLm2hBSZWRhmKNQ== X-Received: by 2002:a05:600c:45c4:b0:425:64c5:5780 with SMTP id 5b1f17b1804b1-42bb01ae2d7mr132667705e9.1.1725351674529; Tue, 03 Sep 2024 01:21:14 -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 5b1f17b1804b1-42bb6e27467sm162553425e9.38.2024.09.03.01.21.13 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 03 Sep 2024 01:21:14 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Steve Baird Subject: [COMMITTED 02/10] ada: Reject illegal array aggregates as per AI22-0106. Date: Tue, 3 Sep 2024 10:20:54 +0200 Message-ID: <20240903082102.2268026-2-poulhies@adacore.com> X-Mailer: git-send-email 2.45.2 In-Reply-To: <20240903082102.2268026-1-poulhies@adacore.com> References: <20240903082102.2268026-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.7 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, 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org From: Steve Baird Implement the new legality rules of AI22-0106 which (as discussed in the AI) are needed to disallow constructs whose semantics would otherwise be poorly defined. gcc/ada/ * sem_aggr.adb (Resolve_Array_Aggregate): Implement the two new legality rules of AI11-0106. Add code to avoid cascading error messages. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/sem_aggr.adb | 114 ++++++++++++++++++++++++++++++++++++------- 1 file changed, 97 insertions(+), 17 deletions(-) diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 8319ff5af62..63bdeca9658 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -301,7 +301,7 @@ package body Sem_Aggr is -- In addition this step analyzes and resolves each discrete_choice, -- making sure that its type is the type of the corresponding Index. -- If we are not at the lowest array aggregate level (in the case of - -- multi-dimensional aggregates) then invoke Resolve_Array_Aggregate + -- multidimensional aggregates) then invoke Resolve_Array_Aggregate -- recursively on each component expression. Otherwise, resolve the -- bottom level component expressions against the expected component -- type ONLY IF the component corresponds to a single discrete choice @@ -314,7 +314,7 @@ package body Sem_Aggr is -- 3. For positional aggregates: -- -- (A) Loop over the component expressions either recursively invoking - -- Resolve_Array_Aggregate on each of these for multi-dimensional + -- Resolve_Array_Aggregate on each of these for multidimensional -- array aggregates or resolving the bottom level component -- expressions against the expected component type. -- @@ -1596,6 +1596,8 @@ package body Sem_Aggr is Nb_Choices : Nat := 0; -- Contains the overall number of named choices in this sub-aggregate + Saved_SED : constant Nat := Serious_Errors_Detected; + function Add (Val : Uint; To : Node_Id) return Node_Id; -- Creates a new expression node where Val is added to expression To. -- Tries to constant fold whenever possible. To must be an already @@ -1968,7 +1970,7 @@ package body Sem_Aggr is Nxt_Ind_Constr : constant Node_Id := Next_Index (Index_Constr); -- Index is the current index corresponding to the expression - Resolution_OK : Boolean := True; + Resolution_OK : Boolean := True; -- Set to False if resolution of the expression failed begin @@ -2038,6 +2040,9 @@ package body Sem_Aggr is Resolution_OK := Resolve_Array_Aggregate (Expr, Nxt_Ind, Nxt_Ind_Constr, Component_Typ, Others_Allowed); + if Resolution_OK = Failure then + return Failure; + end if; else -- If it's "... => <>", nothing to resolve @@ -2135,10 +2140,10 @@ package body Sem_Aggr is -- Local variables - Choice : Node_Id; - Dummy : Boolean; - Scop : Entity_Id; - Expr : constant Node_Id := Expression (N); + Choice : Node_Id; + Resolution_OK : Boolean; + Scop : Entity_Id; + Expr : constant Node_Id := Expression (N); -- Start of processing for Resolve_Iterated_Component_Association @@ -2208,7 +2213,11 @@ package body Sem_Aggr is -- rewritting as a loop with a new index variable; when not -- generating code we leave the analyzed expression as it is. - Dummy := Resolve_Aggr_Expr (Expr, Single_Elmt => False); + Resolution_OK := Resolve_Aggr_Expr (Expr, Single_Elmt => False); + + if not Resolution_OK then + return; + end if; if Operating_Mode /= Check_Semantics then Remove_References (Expr); @@ -2610,6 +2619,14 @@ package body Sem_Aggr is if Nkind (Assoc) = N_Iterated_Component_Association and then Present (Iterator_Specification (Assoc)) then + if Number_Dimensions (Etype (N)) /= 1 then + Error_Msg_N ("iterated_component_association with an" & + " iterator_specification not allowed for" & + " multidimensional array aggregate", + Assoc); + return Failure; + end if; + -- All other component associations must have an iterator spec. Next (Assoc); @@ -2931,16 +2948,75 @@ package body Sem_Aggr is Get_Index_Bounds (Choice, Low, High); end if; - if (Dynamic_Or_Null_Range (Low, High) - or else (Nkind (Choice) = N_Subtype_Indication - and then - Dynamic_Or_Null_Range (S_Low, S_High))) - and then Nb_Choices /= 1 + if Dynamic_Or_Null_Range (Low, High) + or else (Nkind (Choice) = N_Subtype_Indication + and then Dynamic_Or_Null_Range (S_Low, S_High)) then - Error_Msg_N - ("dynamic or empty choice in aggregate " - & "must be the only choice", Choice); - return Failure; + if Nb_Choices /= 1 then + Error_Msg_N + ("dynamic or empty choice in aggregate " + & "must be the only choice", Choice); + return Failure; + elsif Number_Dimensions (Etype (N)) > 1 then + declare + function Check_Bound_Subexpression + (Exp : Node_Id) return Traverse_Result; + -- A bound expression for a subaggregate of an + -- array aggregate is not permitted to reference + -- a loop iteration variable defined in an earlier + -- dimension of the same enclosing aggregate, as + -- in (for X in 1 .. 3 => (1 .. X + 2 => ...)) . + -- Always returns OK. + + -------------------------------- + -- Check_Bound_Subexpression -- + -------------------------------- + + function Check_Bound_Subexpression + (Exp : Node_Id) return Traverse_Result + is + Scope_Parent : Node_Id; + begin + if Nkind (Exp) /= N_Identifier + or else not Present (Entity (Exp)) + or else not Present (Scope (Entity (Exp))) + or else Ekind (Scope (Entity (Exp))) /= E_Loop + then + return OK; + end if; + + Scope_Parent := Parent (Scope (Entity (Exp))); + + if Nkind (Scope_Parent) = N_Aggregate + + -- We want to know whether the aggregate + -- where this loop var is defined is + -- "the same" aggregate as N, where "the + -- same" means looking through subaggregates. + -- To do this, we compare Etypes of the two. + -- + -- ??? There may be very obscure cases + -- involving allocators where this is too + -- strict and will generate a spurious error. + + and then Etype (Scope_Parent) = Etype (N) + then + Error_Msg_N ("bound expression for a " + & "subaggregate of an array aggregate must " + & "not refer to an index parameter of an " + & "earlier dimension", Exp); + end if; + + return OK; + end Check_Bound_Subexpression; + + procedure Check_Bound_Expression is new + Traverse_Proc (Check_Bound_Subexpression); + begin + Check_Bound_Expression (Low); + Check_Bound_Expression (High); + end; + end if; end if; if not (All_Composite_Constraints_Static (Low) @@ -3706,6 +3782,10 @@ package body Sem_Aggr is Analyze_Dimension_Array_Aggregate (N, Component_Typ); + if Serious_Errors_Detected /= Saved_SED then + return Failure; + end if; + return Success; end Resolve_Array_Aggregate;