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