procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Look at fullest view when checking for static types in unnesting

Browse source 
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.
This commit is contained in:
Arnaud Charlet 2020-09-03 03:38:40 -04:00
parent 4337341269
commit eb6ea9e54f
3 changed files with 95 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
gcc/ada/exp_unst.adb
View file

@ -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.
-- 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 T or its full view is an access
-- type, check whether the designated type has dynamic bounds.
-- 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

73
gcc/ada/sem_util.adb
View file

@ -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 --
------------------------

6
gcc/ada/sem_util.ads
View file

@ -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