From patchwork Thu Sep 3 08:16:15 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 1356405 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com 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 (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4Bhttb2N9lz9sTS for ; Thu, 3 Sep 2020 18:16:21 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C0C673987487; Thu, 3 Sep 2020 08:16:18 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from rock.gnat.com (rock.gnat.com [205.232.38.15]) by sourceware.org (Postfix) with ESMTP id 391C63987438 for ; Thu, 3 Sep 2020 08:16:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 391C63987438 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=charlet@adacore.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 047AB117534 for ; Thu, 3 Sep 2020 04:16:16 -0400 (EDT) X-Virus-Scanned: Debian amavisd-new at gnat.com 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 LTK+e6jwbVtA for ; Thu, 3 Sep 2020 04:16:15 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id E93A2117531 for ; Thu, 3 Sep 2020 04:16:15 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id E2DE610C; Thu, 3 Sep 2020 04:16:15 -0400 (EDT) Date: Thu, 3 Sep 2020 04:16:15 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Subject: [Ada] Look at fullest view when checking for static types in unnesting Message-ID: <20200903081615.GA117200@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-Spam-Status: No, score=-9.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, KAM_ASCII_DIVIDERS, KAM_DMARC_STATUS, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" When seeing if any bound involved in a type is an uplevel reference, we must look at the fullest view of a type, since that's what the backends will do. Similarly for private types. We introduce Get_Fullest_View for that purpose. Tested on x86_64-pc-linux-gnu, committed on master * sem_util.ads, sem_util.adb (Get_Fullest_View): New procedure. * exp_unst.adb (Check Static_Type): Do all processing on fullest view of specified type. diff --git gcc/ada/exp_unst.adb gcc/ada/exp_unst.adb index 29fe2e5..ffc30c3 100644 --- gcc/ada/exp_unst.adb +++ gcc/ada/exp_unst.adb @@ -471,21 +471,23 @@ package body Exp_Unst is Callee : Entity_Id; procedure Check_Static_Type - (T : Entity_Id; + (In_T : Entity_Id; N : Node_Id; DT : in out Boolean; Check_Designated : Boolean := False); - -- Given a type T, checks if it is a static type defined as a type - -- with no dynamic bounds in sight. If so, the only action is to - -- set Is_Static_Type True for T. If T is not a static type, then - -- all types with dynamic bounds associated with T are detected, - -- and their bounds are marked as uplevel referenced if not at the - -- library level, and DT is set True. If N is specified, it's the - -- node that will need to be replaced. If not specified, it means - -- we can't do a replacement because the bound is implicit. - - -- If Check_Designated is True and T or its full view is an access - -- type, check whether the designated type has dynamic bounds. + -- Given a type In_T, checks if it is a static type defined as + -- a type with no dynamic bounds in sight. If so, the only + -- action is to set Is_Static_Type True for In_T. If In_T is + -- not a static type, then all types with dynamic bounds + -- associated with In_T are detected, and their bounds are + -- marked as uplevel referenced if not at the library level, + -- and DT is set True. If N is specified, it's the node that + -- will need to be replaced. If not specified, it means we + -- can't do a replacement because the bound is implicit. + + -- If Check_Designated is True and In_T or its full view + -- is an access type, check whether the designated type + -- has dynamic bounds. procedure Note_Uplevel_Ref (E : Entity_Id; @@ -505,11 +507,13 @@ package body Exp_Unst is ----------------------- procedure Check_Static_Type - (T : Entity_Id; + (In_T : Entity_Id; N : Node_Id; DT : in out Boolean; Check_Designated : Boolean := False) is + T : constant Entity_Id := Get_Fullest_View (In_T); + procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id); -- N is the bound of a dynamic type. This procedure notes that -- this bound is uplevel referenced, it can handle references diff --git gcc/ada/sem_util.adb gcc/ada/sem_util.adb index 679b3be..a80cc5c 100644 --- gcc/ada/sem_util.adb +++ gcc/ada/sem_util.adb @@ -9958,6 +9958,79 @@ package body Sem_Util is end if; end Get_Enum_Lit_From_Pos; + ---------------------- + -- Get_Fullest_View -- + ---------------------- + + function Get_Fullest_View + (E : Entity_Id; Include_PAT : Boolean := True) return Entity_Id is + begin + -- Strictly speaking, the recursion below isn't necessary, but + -- it's both simplest and safest. + + case Ekind (E) is + when Incomplete_Kind => + if From_Limited_With (E) then + return Get_Fullest_View (Non_Limited_View (E), Include_PAT); + elsif Present (Full_View (E)) then + return Get_Fullest_View (Full_View (E), Include_PAT); + elsif Ekind (E) = E_Incomplete_Subtype then + return Get_Fullest_View (Etype (E)); + end if; + + when Private_Kind => + if Present (Underlying_Full_View (E)) then + return + Get_Fullest_View (Underlying_Full_View (E), Include_PAT); + elsif Present (Full_View (E)) then + return Get_Fullest_View (Full_View (E), Include_PAT); + elsif Etype (E) /= E then + return Get_Fullest_View (Etype (E), Include_PAT); + 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)); + end if; + + when E_Record_Subtype => + if Present (Cloned_Subtype (E)) then + return Get_Fullest_View (Cloned_Subtype (E), Include_PAT); + end if; + + when E_Class_Wide_Type => + return Get_Fullest_View (Root_Type (E), Include_PAT); + + when E_Class_Wide_Subtype => + if Present (Equivalent_Type (E)) then + return Get_Fullest_View (Equivalent_Type (E), Include_PAT); + elsif Present (Cloned_Subtype (E)) then + return Get_Fullest_View (Cloned_Subtype (E), Include_PAT); + end if; + + when E_Protected_Type | E_Protected_Subtype + | E_Task_Type | E_Task_Subtype => + if Present (Corresponding_Record_Type (E)) then + return Get_Fullest_View (Corresponding_Record_Type (E), + Include_PAT); + 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); + end if; + + when E_Access_Subtype => + return Get_Fullest_View (Base_Type (E), Include_PAT); + + when others => + null; + end case; + + return E; + end Get_Fullest_View; + ------------------------ -- Get_Generic_Entity -- ------------------------ diff --git gcc/ada/sem_util.ads gcc/ada/sem_util.ads index a6bd6e2..e2147e0 100644 --- gcc/ada/sem_util.ads +++ gcc/ada/sem_util.ads @@ -1228,6 +1228,12 @@ package Sem_Util is -- UFull_Typ - the underlying full view, if the full view is private -- CRec_Typ - the corresponding record type of the full views + function Get_Fullest_View + (E : Entity_Id; Include_PAT : 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. + function Has_Access_Values (T : Entity_Id) return Boolean; -- Returns true if type or subtype T is an access type, or has a component -- (at any recursive level) that is an access type. This is a conservative