From patchwork Tue Jul 12 12:25:18 2022 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: 1655376 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: bilbo.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=dkPRV9/6; dkim-atps=neutral Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by bilbo.ozlabs.org (Postfix) with ESMTPS id 4Lj0Nv5C2Wz9sB4 for ; Tue, 12 Jul 2022 22:26:39 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5FABE382A2E6 for ; Tue, 12 Jul 2022 12:26:37 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 5FABE382A2E6 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1657628797; bh=AY6bwwcsb4zDC+43wTlii6pmQTHr2WXU6iC246Y+NGc=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=dkPRV9/6ZVjBYvIHNJJ5k9ZHHoa9H+hMVnzkG7yG99jXRy+Gz5nMypETld6xbBwbC 6GMQLkXwL1kb6cQDKQSOg/WDGU556Yjqn2C28aoeQ4y43+QuKUZoSHkd7L0OAGuO3a jLK4eL5biyurz5RXX1hXxDAByT5GLjwEe+Q+7pZ4= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org 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 AE26B385B83E for ; Tue, 12 Jul 2022 12:25:20 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org AE26B385B83E Received: by mail-ed1-x52c.google.com with SMTP id w12so9143924edd.13 for ; Tue, 12 Jul 2022 05:25:20 -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=AY6bwwcsb4zDC+43wTlii6pmQTHr2WXU6iC246Y+NGc=; b=F75mIJb8VcdfYIqTd8GOv7KTm4CajcEeYCwBRsi7yV+54EY8oeR3GBt5Ts9Ng26EOk TCWu8J2hEUZv5N0AOgdPBNXJczuMgRLhCRa+gQU8R4hZYlL7RBWOq2nI5XzqPnpk2AYO pBdlX/sH14/WGf2QOFsjQpojWPJo5Pm4hRosWNa8eDK2sKbkvehrUsh8a3tPMLzI1MFo JcG4iL8a3pZn4pb1MXKp+6YtS80iarXuAuFNnUyFF/tSRJgQxwcoUyDhmHB5x4e2I02q Jjp/iHaOwnDDc3z0ZXekonvx0r3ZL6dCjQrYUu84CGAPMrb9CVZnoUf5nd2lsTyqfvSZ CHRg== X-Gm-Message-State: AJIora+vGUxIChHTBlHwTYPR8BbBNshDSrtcSoRA9SlFL9oYscDd4pBh k3QS5DN8zWY22xa+vr/KY3HJr6TSdi5a6A== X-Google-Smtp-Source: AGRyM1twd30Hgg8ud1SPduqh6w6X56W/55nHtwlRQq3+65I2Zu1AG4zSAMSCBP15WIWez5ch3CXKGg== X-Received: by 2002:a05:6402:270b:b0:43a:d89e:8c2d with SMTP id y11-20020a056402270b00b0043ad89e8c2dmr11965130edd.413.1657628719536; Tue, 12 Jul 2022 05:25:19 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id ca17-20020aa7cd71000000b0043aa5c2ce17sm5975284edb.35.2022.07.12.05.25.18 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 12 Jul 2022 05:25:18 -0700 (PDT) Date: Tue, 12 Jul 2022 12:25:18 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Proper freezing for dispatching expression functions. Message-ID: <20220712122518.GA3404707@adacore.com> MIME-Version: 1.0 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-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Ed Schonberg Errors-To: gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" In the case of an expression function that is a primitive function of a tagged type, freezing the tagged type needs to freeze the function (and its return expression). A bug in this area could result in incorrect behavior both at compile time and at run time. At compile time, freezing rule violations could go undetected so that an illegal program could be incorrectly accepted. At run time, a dispatching call to the primitive function could end up dispatching through a not-yet-initialized slot in the dispatch table, typically (although not always) resulting in a segmentation fault. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * freeze.adb (Check_Expression_Function.Find_Constant): Add a check that a type that is referenced as the prefix of an attribute is fully declared. (Freeze_And_Append): Do not freeze the profile when freezing an expression function. (Freeze_Entity): When a tagged type is frozen, also freeze any primitive operations of the type that are expression functions. * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not prevent freezing associated with an expression function body if the function is a dispatching op. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1470,6 +1470,10 @@ package body Freeze is if Is_Entity_Name (Prefix (Nod)) and then Is_Type (Entity (Prefix (Nod))) then + if Expander_Active then + Check_Fully_Declared (Entity (Prefix (Nod)), N); + end if; + Freeze_Before (N, Entity (Prefix (Nod))); end if; end if; @@ -2632,7 +2636,13 @@ package body Freeze is N : Node_Id; Result : in out List_Id) is - L : constant List_Id := Freeze_Entity (Ent, N); + -- Freezing an Expression_Function does not freeze its profile: + -- the formals will have been frozen otherwise before the E_F + -- can be called. + + L : constant List_Id := + Freeze_Entity + (Ent, N, Do_Freeze_Profile => not Is_Expression_Function (Ent)); begin if Is_Non_Empty_List (L) then if Result = No_List then @@ -7807,11 +7817,37 @@ package body Freeze is -- type itself is frozen, because the class-wide type refers to the -- tagged type which generates the class. + -- For a tagged type, freeze explicitly those primitive operations + -- that are expression functions, which otherwise have no clear + -- freeze point: these have to be frozen before the dispatch table + -- for the type is built, and before any explicit call to the + -- primitive, which would otherwise be the freeze point for it. + if Is_Tagged_Type (E) and then not Is_Class_Wide_Type (E) and then Present (Class_Wide_Type (E)) then Freeze_And_Append (Class_Wide_Type (E), N, Result); + + declare + Ops : constant Elist_Id := Primitive_Operations (E); + + Elmt : Elmt_Id; + Subp : Entity_Id; + + begin + if Ops /= No_Elist then + Elmt := First_Elmt (Ops); + while Present (Elmt) loop + Subp := Node (Elmt); + if Is_Expression_Function (Subp) then + Freeze_And_Append (Subp, N, Result); + end if; + + Next_Elmt (Elmt); + end loop; + end if; + end; end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -4508,7 +4508,16 @@ package body Sem_Ch6 is -- This also needs to be done in the case of an ignored Ghost -- expression function, where the expander isn't active. - Set_Is_Frozen (Spec_Id); + -- A further complication arises if the expression function is + -- a primitive operation of a tagged type: in that case the + -- function entity must be frozen before the dispatch table for + -- the type is constructed, so it will be frozen like other local + -- entities, at the end of the current scope. + + if not Is_Dispatching_Operation (Spec_Id) then + Set_Is_Frozen (Spec_Id); + end if; + Mask_Types := Mask_Unfrozen_Types (Spec_Id); elsif not Is_Frozen (Spec_Id)