Caller : Entity_Id;
Callee : Entity_Id;
- procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean);
+ procedure Check_Static_Type
+ (T : Entity_Id; N : Node_Id; DT : in out Boolean);
-- 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.
+ -- 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.
procedure Note_Uplevel_Ref
(E : Entity_Id;
+ N : Node_Id;
Caller : Entity_Id;
Callee : Entity_Id);
-- Called when we detect an explicit or implicit uplevel reference
-- Check_Static_Type --
-----------------------
- procedure Check_Static_Type (T : Entity_Id; DT : in out Boolean) is
- procedure Note_Uplevel_Bound (N : Node_Id);
+ procedure Check_Static_Type
+ (T : Entity_Id; N : Node_Id; DT : in out Boolean)
+ is
+ 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
-- to entities (typically _FIRST and _LAST entities), and also
-- attribute references of the form T'name (name is typically
-- FIRST or LAST) where T is the uplevel referenced bound.
+ -- Ref, if Present, is the location of the reference to
+ -- replace.
------------------------
-- Note_Uplevel_Bound --
------------------------
- procedure Note_Uplevel_Bound (N : Node_Id) is
+ procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id) is
begin
-- Entity name case. Make sure that the entity is declared
-- in a subprogram. This may not be the case for for a type
then
Note_Uplevel_Ref
(E => Entity (N),
+ N => Ref,
Caller => Current_Subprogram,
Callee => Enclosing_Subprogram (Entity (N)));
end if;
- -- Attribute case
+ -- Attribute or indexed component case
+
+ elsif Nkind_In (N, N_Attribute_Reference,
+ N_Indexed_Component)
+ then
+ Note_Uplevel_Bound (Prefix (N), Ref);
+
+ -- Conversion case
- elsif Nkind (N) = N_Attribute_Reference then
- Note_Uplevel_Bound (Prefix (N));
+ elsif Nkind (N) = N_Type_Conversion then
+ Note_Uplevel_Bound (Expression (N), Ref);
end if;
end Note_Uplevel_Bound;
begin
if not Is_Static_Expression (LB) then
- Note_Uplevel_Bound (LB);
+ Note_Uplevel_Bound (LB, N);
DT := True;
end if;
if not Is_Static_Expression (UB) then
- Note_Uplevel_Bound (UB);
+ Note_Uplevel_Bound (UB, N);
DT := True;
end if;
end;
begin
C := First_Component_Or_Discriminant (T);
while Present (C) loop
- Check_Static_Type (Etype (C), DT);
+ Check_Static_Type (Etype (C), N, DT);
Next_Component_Or_Discriminant (C);
end loop;
end;
declare
IX : Node_Id;
begin
- Check_Static_Type (Component_Type (T), DT);
+ Check_Static_Type (Component_Type (T), N, DT);
IX := First_Index (T);
while Present (IX) loop
- Check_Static_Type (Etype (IX), DT);
+ Check_Static_Type (Etype (IX), N, DT);
Next_Index (IX);
end loop;
end;
-- For private type, examine whether full view is static
elsif Is_Private_Type (T) and then Present (Full_View (T)) then
- Check_Static_Type (Full_View (T), DT);
+ Check_Static_Type (Full_View (T), N, DT);
if Is_Static_Type (Full_View (T)) then
Set_Is_Static_Type (T);
procedure Note_Uplevel_Ref
(E : Entity_Id;
+ N : Node_Id;
Caller : Entity_Id;
Callee : Entity_Id)
is
+ Full_E : Entity_Id := E;
begin
-- Nothing to do for static type
-- We have a new uplevel referenced entity
+ if Ekind (E) = E_Constant and then Present (Full_View (E)) then
+ Full_E := Full_View (E);
+ end if;
+
-- All we do at this stage is to add the uplevel reference to
-- the table. It's too early to do anything else, since this
-- uplevel reference may come from an unreachable subprogram
-- in which case the entry will be deleted.
- Urefs.Append ((N, E, Caller, Callee));
+ Urefs.Append ((N, Full_E, Caller, Callee));
end Note_Uplevel_Ref;
-- Start of processing for Visit_Node
end if;
end if;
+ -- References to bounds can be uplevel references if
+ -- the type isn't static.
+
when Attribute_First
| Attribute_Last
| Attribute_Length
=>
- -- Special-case attributes of array objects whose
- -- bounds may be uplevel references. More complex
- -- prefixes are handled during full traversal. Note
- -- that if the nominal subtype of the prefix is
- -- unconstrained, the bound must be obtained from
- -- the object, not from the (possibly) uplevel
- -- reference.
-
- if Is_Entity_Name (Prefix (N))
- and then Is_Constrained (Etype (Prefix (N)))
- then
+ -- Special-case attributes of objects whose bounds
+ -- may be uplevel references. More complex prefixes
+ -- handled during full traversal. Note that if the
+ -- nominal subtype of the prefix is unconstrained,
+ -- the bound must be obtained from the object, not
+ -- from the (possibly) uplevel reference.
+
+ if Is_Constrained (Etype (Prefix (N))) then
declare
DT : Boolean := False;
begin
- Check_Static_Type (Etype (Prefix (N)), DT);
+ Check_Static_Type (Etype (Prefix (N)),
+ Empty, DT);
end;
return OK;
end case;
end;
+ -- Indexed references can be uplevel if the type isn't static and
+ -- if the lower bound (or an inner bound for a multidimensional
+ -- array) is uplevel.
+
+ elsif Nkind_In (N, N_Indexed_Component, N_Slice)
+ and then Is_Constrained (Etype (Prefix (N)))
+ then
+ declare
+ DT : Boolean := False;
+ begin
+ Check_Static_Type (Etype (Prefix (N)), Empty, DT);
+ end;
+
-- Record a subprogram. We record a subprogram body that acts as
-- a spec. Otherwise we record a subprogram declaration, providing
-- that it has a corresponding body we can get hold of. The case
DT : Boolean := False;
begin
- Check_Static_Type (Ent, DT);
+ Check_Static_Type (Ent, N, DT);
if Is_Static_Type (Ent) then
return OK;
Callee := Enclosing_Subprogram (Ent);
if Callee /= Caller and then not Is_Static_Type (Ent) then
- Note_Uplevel_Ref (Ent, Caller, Callee);
+ Note_Uplevel_Ref (Ent, N, Caller, Callee);
end if;
end if;
-- to objects that will be referenced uplevel, and we use
-- the flag Is_Uplevel_Referenced_Entity to avoid making
-- duplicate entries in the list.
+ -- Discriminants are also excluded, only the enclosing
+ -- object can appear in the list.
- if not Is_Uplevel_Referenced_Entity (URJ.Ent) then
+ if not Is_Uplevel_Referenced_Entity (URJ.Ent)
+ and then Ekind (URJ.Ent) /= E_Discriminant
+ then
Set_Is_Uplevel_Referenced_Entity (URJ.Ent);
if not Is_Type (URJ.Ent) then
begin
-- Ignore type references, these are implicit references that do
-- not need rewriting (e.g. the appearence in a conversion).
+ -- Also ignore if no reference was specified.
- if Is_Type (UPJ.Ent) then
+ if Is_Type (UPJ.Ent) or else No (UPJ.Ref) then
goto Continue;
end if;
if No (Act) then
Set_First_Named_Actual (CTJ.N, Extra);
+ -- If call has been relocated (as with an expression in
+ -- an aggregate), set First_Named pointer in original node
+ -- as well, because that's the parent of the parameter list.
+
+ Set_First_Named_Actual
+ (Parent (List_Containing (ExtraP)), Extra);
+
-- Here we must follow the chain and append the new entry
else