From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-ed1-x52c.google.com (mail-ed1-x52c.google.com [IPv6:2a00:1450:4864:20::52c]) by sourceware.org (Postfix) with ESMTPS id DD8DC385BAF5 for ; Mon, 4 Jul 2022 07:50:30 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org DD8DC385BAF5 Received: by mail-ed1-x52c.google.com with SMTP id c65so10612004edf.4 for ; Mon, 04 Jul 2022 00:50:30 -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=t0pjIHKbNtf1v9WltlbYEgVFogLBmOBEB028SXQwuKg=; b=sL5tefxz9oIIGgk9hEwaTffI/znH5G/yvbzKe0650cROyfXKc4ykV9lVMaabYSUcy6 g4gj/gycnoM4h/UhIHEYDHEtFS28kY0BQeuceYsgOyybyu0OPkqgwgUEEkENhXXGE2Dl MWqtvdXRzNB4Yir2f+mNQHdl1XKNuYMUleo/1Ypua7I99sEFG74MTkXwgqaxALwV+r0F 7ZUTYXQEGewXdRkPOqGqIwSFSetgaJDZ8yKK4S76ubG74AsZzfdLHtxvqnPyBVft2OsR aAGCUFcmS4i/X+oZKR8B+5K8GBYagn4WT0Cd1UkajwcIXEI4ly3/Zm18ZdkdBPUg3Ty0 xpyQ== X-Gm-Message-State: AJIora/r+NauivIDLsJfABLKEGYILrB1uB4aCjLYLvqbU8JaQ5FjZQx6 /GmAst5EP/WlJHVYLNm3eFFRrczmauXzUQ== X-Google-Smtp-Source: AGRyM1sqOojLson1hIHB7diKHFf2peom2VYqgAAQeGu+ObMrzGvyzCMH3mdB2kHyhO5j/8Q/dYpLdg== X-Received: by 2002:a05:6402:500b:b0:431:78d0:bf9d with SMTP id p11-20020a056402500b00b0043178d0bf9dmr36888122eda.184.1656921029724; Mon, 04 Jul 2022 00:50:29 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id z10-20020aa7c64a000000b0043a21e3b4a5sm2785355edr.40.2022.07.04.00.50.29 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 04 Jul 2022 00:50:29 -0700 (PDT) Date: Mon, 4 Jul 2022 07:50:28 +0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix dispatching call to primitive function with controlling tagged result Message-ID: <20220704075028.GA99387@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="oyUTqETQ0mS9luUI" Content-Disposition: inline X-Spam-Status: No, score=-13.2 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.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Mon, 04 Jul 2022 07:50:33 -0000 --oyUTqETQ0mS9luUI Content-Type: text/plain; charset=us-ascii Content-Disposition: inline When a dispatching call is made to a primitive function with a controlling tagged result, the call is dispatching on result and thus must return the class-wide type of the tagged type to accommodate all possible results. This was ensured by Expand_Dispatching_Call only in the common case where the result type is the type of the controlling argument, which does not cover the case of a primitive function inherited from an ancestor type. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * exp_disp.adb (Expand_Dispatching_Call): Fix detection of calls that are dispatching on tagged result. --oyUTqETQ0mS9luUI Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -896,8 +896,14 @@ package body Exp_Disp is Copy_Strub_Mode (Subp_Typ, Subp); Set_Convention (Subp_Typ, Convention (Subp)); - if Etype (Subp) = Typ then - Set_Etype (Subp_Typ, CW_Typ); + -- If this is a function and it has a controlling tagged result, then + -- the call is dispatching on result and returns the class-wide type. + + if Ekind (Subp) = E_Function + and then Has_Controlling_Result (Subp) + and then Is_Tagged_Type (Etype (Subp)) + then + Set_Etype (Subp_Typ, Class_Wide_Type (Etype (Subp))); Set_Returns_By_Ref (Subp_Typ, True); else Set_Etype (Subp_Typ, Etype (Subp)); --oyUTqETQ0mS9luUI--