From patchwork Thu Oct 10 15:29:47 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 1174648 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-510636-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="st/KfXMi"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 46pw6D4M8Cz9sCJ for ; Fri, 11 Oct 2019 02:31:16 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=Ge1P1pvdYZYZXgWkKZiygdALVvXLzrdxLSZX+GE2tx556rxo2k ojusEg/J/Yxr+K8lsgPasKGieXBNMWi4ahjdhJ1y1IA3coEJ8U+pMLKkxzcCoyPO e4bU9C13hHDJIM8Wvv5n26lzsayTC0+GhIaOHWP4JNUMfMvqHjWPv9Lgg= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=xDAoEiewm7zilH+6X9C7LnZRdNs=; b=st/KfXMic6RscttYfBlf h98rwkcPV1FfpeHIbNZkdDrhgygAnWlCfQfBPyOQSFnELvgvYM/bvsw30la6odoX OqgFImMK5/PEvYFe7PTVoC3G43cDkO6PHEjQLGZPPZzRZmh7t/GYNOZU0STifgRS uM+bs3C1RbFvilSIiqLro5w= Received: (qmail 42654 invoked by alias); 10 Oct 2019 15:29:54 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 42568 invoked by uid 89); 10 Oct 2019 15:29:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.2 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=sem_aggr X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 10 Oct 2019 15:29:51 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 4AF085609D; Thu, 10 Oct 2019 11:29:47 -0400 (EDT) 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 7RuQdVpP-GsD; Thu, 10 Oct 2019 11:29:47 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 2D46F56099; Thu, 10 Oct 2019 11:29:47 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id 2BE9E646; Thu, 10 Oct 2019 11:29:47 -0400 (EDT) Date: Thu, 10 Oct 2019 11:29:47 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Bob Duff Subject: [Ada] 'others' in conditional_expressions Message-ID: <20191010152947.GA87586@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch fixes a bug in which an 'others' array aggregate in a dependent_expression of a conditional_expression is rejected, even in cases where 'others' is legal. See RM-4.3.3(15.1). Running this command: gcc -c others_test.ads On the following sources: package Others_Test is X : String (1 .. 10) := (case True is when Boolean => (others => 'x')); end Others_Test; Should execute silently. Tested on x86_64-pc-linux-gnu, committed on trunk 2019-10-10 Bob Duff gcc/ada/ * sem_aggr.adb (Resolve_Aggregate): Add missing cases in the Others_Allowed => True case -- N_Case_Expression_Alternative and N_If_Expression. Use Nkind_In. * atree.adb, atree.ads, sinfo.adb, sinfo.ads (Nkind_In): New 16-parameter version. --- gcc/ada/atree.adb +++ gcc/ada/atree.adb @@ -1924,6 +1924,30 @@ package body Atree is V11); end Nkind_In; + function Nkind_In + (N : Node_Id; + V1 : Node_Kind; + V2 : Node_Kind; + V3 : Node_Kind; + V4 : Node_Kind; + V5 : Node_Kind; + V6 : Node_Kind; + V7 : Node_Kind; + V8 : Node_Kind; + V9 : Node_Kind; + V10 : Node_Kind; + V11 : Node_Kind; + V12 : Node_Kind; + V13 : Node_Kind; + V14 : Node_Kind; + V15 : Node_Kind; + V16 : Node_Kind) return Boolean + is + begin + return Nkind_In (Nkind (N), V1, V2, V3, V4, V5, V6, V7, V8, V9, V10, + V11, V12, V13, V14, V15, V16); + end Nkind_In; + -------- -- No -- -------- --- gcc/ada/atree.ads +++ gcc/ada/atree.ads @@ -780,6 +780,27 @@ package Atree is V10 : Node_Kind; V11 : Node_Kind) return Boolean; + -- 12..15-parameter versions are not yet needed + + function Nkind_In + (N : Node_Id; + V1 : Node_Kind; + V2 : Node_Kind; + V3 : Node_Kind; + V4 : Node_Kind; + V5 : Node_Kind; + V6 : Node_Kind; + V7 : Node_Kind; + V8 : Node_Kind; + V9 : Node_Kind; + V10 : Node_Kind; + V11 : Node_Kind; + V12 : Node_Kind; + V13 : Node_Kind; + V14 : Node_Kind; + V15 : Node_Kind; + V16 : Node_Kind) return Boolean; + pragma Inline (Nkind_In); -- Inline all above functions --- gcc/ada/sem_aggr.adb +++ gcc/ada/sem_aggr.adb @@ -893,7 +893,6 @@ package body Sem_Aggr is procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is Loc : constant Source_Ptr := Sloc (N); - Pkind : constant Node_Kind := Nkind (Parent (N)); Aggr_Subtyp : Entity_Id; -- The actual aggregate subtype. This is not necessarily the same as Typ @@ -1078,16 +1077,17 @@ package body Sem_Aggr is -- permit it, or the aggregate type is unconstrained, an OTHERS -- choice is not allowed (except that it is always allowed on the -- right-hand side of an assignment statement; in this case the - -- constrainedness of the type doesn't matter). + -- constrainedness of the type doesn't matter, because an array + -- object is always constrained). -- If expansion is disabled (generic context, or semantics-only -- mode) actual subtypes cannot be constructed, and the type of an -- object may be its unconstrained nominal type. However, if the - -- context is an assignment, we assume that OTHERS is allowed, - -- because the target of the assignment will have a constrained - -- subtype when fully compiled. Ditto if the context is an - -- initialization procedure where a component may have a predicate - -- function that carries the base type. + -- context is an assignment statement, OTHERS is allowed, because + -- the target of the assignment will have a constrained subtype + -- when fully compiled. Ditto if the context is an initialization + -- procedure where a component may have a predicate function that + -- carries the base type. -- Note that there is no node for Explicit_Actual_Parameter. -- To test for this context we therefore have to test for node @@ -1101,24 +1101,26 @@ package body Sem_Aggr is Set_Etype (N, Aggr_Typ); -- May be overridden later on - if Pkind = N_Assignment_Statement + if Nkind (Parent (N)) = N_Assignment_Statement or else Inside_Init_Proc or else (Is_Constrained (Typ) - and then - (Pkind = N_Parameter_Association or else - Pkind = N_Function_Call or else - Pkind = N_Procedure_Call_Statement or else - Pkind = N_Generic_Association or else - Pkind = N_Formal_Object_Declaration or else - Pkind = N_Simple_Return_Statement or else - Pkind = N_Object_Declaration or else - Pkind = N_Component_Declaration or else - Pkind = N_Parameter_Specification or else - Pkind = N_Qualified_Expression or else - Pkind = N_Reference or else - Pkind = N_Aggregate or else - Pkind = N_Extension_Aggregate or else - Pkind = N_Component_Association)) + and then Nkind_In (Parent (N), + N_Parameter_Association, + N_Function_Call, + N_Procedure_Call_Statement, + N_Generic_Association, + N_Formal_Object_Declaration, + N_Simple_Return_Statement, + N_Object_Declaration, + N_Component_Declaration, + N_Parameter_Specification, + N_Qualified_Expression, + N_Reference, + N_Aggregate, + N_Extension_Aggregate, + N_Component_Association, + N_Case_Expression_Alternative, + N_If_Expression)) then Aggr_Resolved := Resolve_Array_Aggregate --- gcc/ada/sinfo.adb +++ gcc/ada/sinfo.adb @@ -7295,6 +7295,44 @@ package body Sinfo is T = V11; end Nkind_In; + function Nkind_In + (T : Node_Kind; + V1 : Node_Kind; + V2 : Node_Kind; + V3 : Node_Kind; + V4 : Node_Kind; + V5 : Node_Kind; + V6 : Node_Kind; + V7 : Node_Kind; + V8 : Node_Kind; + V9 : Node_Kind; + V10 : Node_Kind; + V11 : Node_Kind; + V12 : Node_Kind; + V13 : Node_Kind; + V14 : Node_Kind; + V15 : Node_Kind; + V16 : Node_Kind) return Boolean + is + begin + return T = V1 or else + T = V2 or else + T = V3 or else + T = V4 or else + T = V5 or else + T = V6 or else + T = V7 or else + T = V8 or else + T = V9 or else + T = V10 or else + T = V11 or else + T = V12 or else + T = V13 or else + T = V14 or else + T = V15 or else + T = V16; + end Nkind_In; + -------------------------- -- Pragma_Name_Unmapped -- -------------------------- --- gcc/ada/sinfo.ads +++ gcc/ada/sinfo.ads @@ -11574,6 +11574,27 @@ package Sinfo is V10 : Node_Kind; V11 : Node_Kind) return Boolean; + -- 12..15-parameter versions are not yet needed + + function Nkind_In + (T : Node_Kind; + V1 : Node_Kind; + V2 : Node_Kind; + V3 : Node_Kind; + V4 : Node_Kind; + V5 : Node_Kind; + V6 : Node_Kind; + V7 : Node_Kind; + V8 : Node_Kind; + V9 : Node_Kind; + V10 : Node_Kind; + V11 : Node_Kind; + V12 : Node_Kind; + V13 : Node_Kind; + V14 : Node_Kind; + V15 : Node_Kind; + V16 : Node_Kind) return Boolean; + pragma Inline (Nkind_In); -- Inline all above functions