From eb6ea9e54f1f275fd6ec3c61662243ca0165bd64 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 3 Sep 2020 03:38:40 -0400 Subject: [PATCH] Look at fullest view when checking for static types in unnesting 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. * 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. --- gcc/ada/exp_unst.adb | 30 ++++++++++-------- gcc/ada/sem_util.adb | 73 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 6 ++++ 3 files changed, 96 insertions(+), 13 deletions(-) diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 29fe2e59061..ffc30c304d1 100644 --- a/gcc/ada/exp_unst.adb +++ b/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 a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 679b3beb67b..a80cc5c5e15 100644 --- a/gcc/ada/sem_util.adb +++ b/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 a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index a6bd6e2a02c..e2147e04bee 100644 --- a/gcc/ada/sem_util.ads +++ b/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 -- 2.30.2