From patchwork Fri Jan 7 16:26:56 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: 49697 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E514D3858D28 for ; Fri, 7 Jan 2022 16:30:23 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E514D3858D28 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1641573023; bh=p12gsJYhi71uGQE9Z+V9O9N3Hr2bLrrXyPjesgp8fWI=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=M3Pm9caaCJPjKKTj/hT61EX0/0+UmkfUOaMIVZAkHxVA02jD5J12XK/HeIdteQgeG miWzpDB0wZ34447ThksDeXbBjOw4tXd7cgS28dknDTidRE9LlbNPinumdNyEimKNuk iaZH5tzlIkeqsSoVA12MFSumcfk/ZLju/kvf709o= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42c.google.com (mail-wr1-x42c.google.com [IPv6:2a00:1450:4864:20::42c]) by sourceware.org (Postfix) with ESMTPS id 503CD3857C5E for ; Fri, 7 Jan 2022 16:26:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 503CD3857C5E Received: by mail-wr1-x42c.google.com with SMTP id k18so11998294wrg.11 for ; Fri, 07 Jan 2022 08:26:58 -0800 (PST) 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=p12gsJYhi71uGQE9Z+V9O9N3Hr2bLrrXyPjesgp8fWI=; b=YwtX6+NU5MzNE6zGlR5trLs6Wgjh9GPJLUBvAcPPjZYn0pbUoa9H0G24BC9mp9PcvG gtg8BhDZOy17mVrBIzfkojga4qAvSY2JPxAOT5o8yBF9LugtTRGZn4eb1LlmtdhCEsjW JO3QG7I473cyJul3szM4E1fYiKuqwQb3iPSwFL6tC55RwlcxEx8i0qIJdN+NzvkzdktT m4+EKXuOUhwPfjvOSitLs+s9oTqtr92yqyIuqmQRB9pqSqaft/PHSXiH+uYKHa7o2Mxc PMMKxQLUYqh9pzOm3fKgTYy7zgalY6n9wmD1el7E9Mo2q2jLMsh39hJECicxAEkmUDB+ yLNg== X-Gm-Message-State: AOAM532i7ADhE6Z5roivxxpJUjj5cB5yC/Sm6/pUZqbmQVuBQjNrMtQq DJDusJlyqWLgrgmSazGz4hdTA0SGIScUJw== X-Google-Smtp-Source: ABdhPJwz7N5PE2xixAvta1/w0gK8Fo3l7pvVQwP+kI2exkgVV4DvVhrMIhrw1y3oZniOjYCP2fWE4g== X-Received: by 2002:a05:6000:18a6:: with SMTP id b6mr53710802wri.675.1641572817422; Fri, 07 Jan 2022 08:26:57 -0800 (PST) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id p18sm8974321wmq.23.2022.01.07.08.26.56 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Fri, 07 Jan 2022 08:26:56 -0800 (PST) Date: Fri, 7 Jan 2022 16:26:56 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Add an option to Get_Fullest_View to not recurse Message-ID: <20220107162656.GA948056@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-13.1 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 autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: Richard Kenner Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" This option is used by GNAT LLVM. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * sem_util.ads, sem_util.adb (Get_Fullest_View): Add option to not recurse and return the next-most-fullest view. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -10926,7 +10926,12 @@ package body Sem_Util is ---------------------- function Get_Fullest_View - (E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id is + (E : Entity_Id; + Include_PAT : Boolean := True; + Recurse : Boolean := True) return Entity_Id + is + New_E : Entity_Id := Empty; + begin -- Prevent cascaded errors @@ -10934,47 +10939,45 @@ package body Sem_Util is return E; end if; - -- Strictly speaking, the recursion below isn't necessary, but - -- it's both simplest and safest. + -- Look at each kind of entity to see where we may need to go deeper. case Ekind (E) is when Incomplete_Kind => if From_Limited_With (E) then - return Get_Fullest_View (Non_Limited_View (E), Include_PAT); + New_E := Non_Limited_View (E); elsif Present (Full_View (E)) then - return Get_Fullest_View (Full_View (E), Include_PAT); + New_E := Full_View (E); elsif Ekind (E) = E_Incomplete_Subtype then - return Get_Fullest_View (Etype (E)); + New_E := Etype (E); end if; when Private_Kind => if Present (Underlying_Full_View (E)) then - return - Get_Fullest_View (Underlying_Full_View (E), Include_PAT); + New_E := Underlying_Full_View (E); elsif Present (Full_View (E)) then - return Get_Fullest_View (Full_View (E), Include_PAT); + New_E := Full_View (E); elsif Etype (E) /= E then - return Get_Fullest_View (Etype (E), Include_PAT); + New_E := Etype (E); end if; when Array_Kind => if Include_PAT and then Present (Packed_Array_Impl_Type (E)) then - return Get_Fullest_View (Packed_Array_Impl_Type (E)); + New_E := Packed_Array_Impl_Type (E); end if; when E_Record_Subtype => if Present (Cloned_Subtype (E)) then - return Get_Fullest_View (Cloned_Subtype (E), Include_PAT); + New_E := Cloned_Subtype (E); end if; when E_Class_Wide_Type => - return Get_Fullest_View (Root_Type (E), Include_PAT); + New_E := Root_Type (E); when E_Class_Wide_Subtype => if Present (Equivalent_Type (E)) then - return Get_Fullest_View (Equivalent_Type (E), Include_PAT); + New_E := Equivalent_Type (E); elsif Present (Cloned_Subtype (E)) then - return Get_Fullest_View (Cloned_Subtype (E), Include_PAT); + New_E := Cloned_Subtype (E); end if; when E_Protected_Subtype @@ -10983,25 +10986,29 @@ package body Sem_Util is | E_Task_Type => if Present (Corresponding_Record_Type (E)) then - return Get_Fullest_View (Corresponding_Record_Type (E), - Include_PAT); + New_E := Corresponding_Record_Type (E); end if; when E_Access_Protected_Subprogram_Type | E_Anonymous_Access_Protected_Subprogram_Type => if Present (Equivalent_Type (E)) then - return Get_Fullest_View (Equivalent_Type (E), Include_PAT); + New_E := Equivalent_Type (E); end if; when E_Access_Subtype => - return Get_Fullest_View (Base_Type (E), Include_PAT); + New_E := Base_Type (E); when others => null; end case; - return E; + -- If we found a fuller view, either return it or recurse. Otherwise, + -- return our input. + + return (if No (New_E) then E + elsif Recurse then Get_Fullest_View (New_E, Include_PAT, Recurse) + else New_E); end Get_Fullest_View; ------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1354,10 +1354,13 @@ package Sem_Util is -- CRec_Typ - the corresponding record type of the full views function Get_Fullest_View - (E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id; + (E : Entity_Id; + Include_PAT : Boolean := True; + Recurse : Boolean := True) return Entity_Id; -- Get the fullest possible view of E, looking through private, limited, -- packed array and other implementation types. If Include_PAT is False, - -- don't look inside packed array types. + -- don't look inside packed array types. If Recurse is False, just + -- go down one level (so it's no longer the "fullest" view). function Has_Access_Values (T : Entity_Id) return Boolean; -- Returns true if the underlying type of T is an access type, or has a