From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x32c.google.com (mail-wm1-x32c.google.com [IPv6:2a00:1450:4864:20::32c]) by sourceware.org (Postfix) with ESMTPS id 6FC013882172 for ; Tue, 16 May 2023 08:41:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 6FC013882172 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x32c.google.com with SMTP id 5b1f17b1804b1-3f49bf0223cso67773245e9.1 for ; Tue, 16 May 2023 01:41:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1684226504; x=1686818504; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=68hNkqOxaFBEnHg93Ge6oyA2MV6BHMcKjr68ReHL61c=; b=H31OINZ9dCsiycgA7/qEhC5AxPyoWdBYz2PVOhykzBOIZkPxrjv6s9CLdPFk63IGi7 7z634fnxxouaN6qB3sEyRqRp3bye/7RwMLaADIZqggc391S8lnYTvK5gVjK7y3MS2yrG HFzZEnurjAqsRdTjNCtK8lqlEI3D8RbX4OLnzebH3dWY+bofpd7hviedv42gPiTeMvBm ryVcVWjM//FusYZ7WiUdmbJZ7yQ2+WrnGV8GAgyS80VmT/x33L6nysO3o9VPubMKkTh4 9WEE65355gf9m1EQkBSCizA9qm7fGrv/9SE9xgWrzTkFe830L3wvDunm5946iTCIFtUT NSlw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684226504; x=1686818504; 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=68hNkqOxaFBEnHg93Ge6oyA2MV6BHMcKjr68ReHL61c=; b=O2wf2gxP4u2i3O1skyg4UCtIEoIFfGyupcCOFVdHd1xgX+o/81DXQP/0u1hIZ1Kas/ iWP3UAq70GqysoIeR/izrBzyId3E5omXl+eNYULsd44sUeRq72nRlbaJEzF0ICGszJ6f HuNxXypH+26C2dSJVMi/Z/nYaVpZLqe3cwFR3VJ7eikgUHPXQ2Srvr+sdsT5uyKKsx1o hBfLYK0ZYXsI5LSXgkW4uIpAoNY4HIZNYMjvsrHQnZaYxOhWGPcRKytXwlLO6uhcbm6H ckg0EcYe9Sg4GlCL0VTtAbX3yKvXegMpNZeAKJ+Tl5WD3ytPcj0J0rPkXEm7MfB8eySW U8Sw== X-Gm-Message-State: AC+VfDwrXs+fuhA0SJjkLgA+DcmGpijkH2EUBPonHIJgeo0/315M/H5/ 02EbegRYVr+vumviJbfmTObycDanVNv+zenGBMUV6A== X-Google-Smtp-Source: ACHHUZ4s315LYqVEeLQt7BD9uzWdxhYP46IZDg3HwkbKlBR+waY2bNluAe0LiaJSsF5fTWi1oc//Ig== X-Received: by 2002:a5d:62c1:0:b0:307:8548:f793 with SMTP id o1-20020a5d62c1000000b003078548f793mr26898513wrv.53.1684226504144; Tue, 16 May 2023 01:41:44 -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 n25-20020a7bcbd9000000b003f318be9442sm1506569wmi.40.2023.05.16.01.41.43 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 16 May 2023 01:41:43 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Use accumulator type in expansion of 'Reduce attribute Date: Tue, 16 May 2023 10:41:41 +0200 Message-Id: <20230516084141.1502523-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.5 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 List-Id: From: Eric Botcazou The current expansion of the 'Reduce attribute uses the resolution type of the expression for the accumulator. Now this type can be unresolved or set to a universal type, for example if it is itself the prefix of the 'Image attribute, and this may yield a spurious type mismatch error in that case. This changes the expansion to use the accumulator type instead as defined by the RM 4.5.10 clause, albeit only in the prefixed case for now. gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference) : Use the canonical accumulator type as the type of the accumulator in the prefixed case. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_attr.adb | 72 ++++++++++++++++++++++++++++++++++++++------ 1 file changed, 62 insertions(+), 10 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index aababd516d5..7e71422eba3 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -5978,27 +5978,30 @@ package body Exp_Attr is when Attribute_Reduce => declare Loc : constant Source_Ptr := Sloc (N); - E1 : constant Node_Id := First (Expressions (N)); - E2 : constant Node_Id := Next (E1); - Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N); - Typ : constant Entity_Id := Etype (N); + E1 : constant Node_Id := First (Expressions (N)); + E2 : constant Node_Id := Next (E1); + Bnn : constant Entity_Id := Make_Temporary (Loc, 'B', N); - New_Loop : Node_Id; - Stat : Node_Id; + Accum_Typ : Entity_Id; + New_Loop : Node_Id; function Build_Stat (Comp : Node_Id) return Node_Id; -- The reducer can be a function, a procedure whose first -- parameter is in-out, or an attribute that is a function, -- which (for now) can only be Min/Max. This subprogram - -- builds the corresponding computation for the generated loop. + -- builds the corresponding computation for the generated loop + -- and retrieves the accumulator type as per RM 4.5.10(19/5). ---------------- -- Build_Stat -- ---------------- function Build_Stat (Comp : Node_Id) return Node_Id is + Stat : Node_Id; + begin if Nkind (E1) = N_Attribute_Reference then + Accum_Typ := Entity (Prefix (E1)); Stat := Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Bnn, Loc), Expression => Make_Attribute_Reference (Loc, @@ -6009,12 +6012,14 @@ package body Exp_Attr is Comp))); elsif Ekind (Entity (E1)) = E_Procedure then + Accum_Typ := Etype (First_Formal (Entity (E1))); Stat := Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (Entity (E1), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Bnn, Loc), Comp)); else + Accum_Typ := Etype (Entity (E1)); Stat := Make_Assignment_Statement (Loc, Name => New_Occurrence_Of (Bnn, Loc), Expression => Make_Function_Call (Loc, @@ -6074,6 +6079,13 @@ package body Exp_Attr is End_Label => Empty, Statements => New_List (Build_Stat (Relocate_Node (Expr)))); + + -- If the reducer subprogram is a universal operator, then + -- we still look at the context to find the type for now. + + if Is_Universal_Numeric_Type (Accum_Typ) then + Accum_Typ := Etype (N); + end if; end; else @@ -6082,9 +6094,10 @@ package body Exp_Attr is -- a container with the proper aspects. declare - Iter : Node_Id; Elem : constant Entity_Id := Make_Temporary (Loc, 'E', N); + Iter : Node_Id; + begin Iter := Make_Iterator_Specification (Loc, @@ -6101,6 +6114,44 @@ package body Exp_Attr is End_Label => Empty, Statements => New_List ( Build_Stat (New_Occurrence_Of (Elem, Loc)))); + + -- If the reducer subprogram is a universal operator, then + -- we need to look at the prefix to find the type. This is + -- modeled on Analyze_Iterator_Specification in Sem_Ch5. + + if Is_Universal_Numeric_Type (Accum_Typ) then + declare + Ptyp : constant Entity_Id := + Base_Type (Etype (Prefix (N))); + + begin + if Is_Array_Type (Ptyp) then + Accum_Typ := Component_Type (Ptyp); + + elsif Has_Aspect (Ptyp, Aspect_Iterable) then + declare + Element : constant Entity_Id := + Get_Iterable_Type_Primitive + (Ptyp, Name_Element); + begin + if Present (Element) then + Accum_Typ := Etype (Element); + end if; + end; + + else + declare + Element : constant Node_Id := + Find_Value_Of_Aspect + (Ptyp, Aspect_Iterator_Element); + begin + if Present (Element) then + Accum_Typ := Entity (Element); + end if; + end; + end if; + end; + end if; end; end if; @@ -6110,10 +6161,11 @@ package body Exp_Attr is Make_Object_Declaration (Loc, Defining_Identifier => Bnn, Object_Definition => - New_Occurrence_Of (Typ, Loc), + New_Occurrence_Of (Accum_Typ, Loc), Expression => Relocate_Node (E2)), New_Loop), Expression => New_Occurrence_Of (Bnn, Loc))); - Analyze_And_Resolve (N, Typ); + + Analyze_And_Resolve (N, Accum_Typ); end; ---------- -- 2.40.0