-- Check for case of a derived subprogram for the instantiation of a
-- formal derived tagged type, if so mark the subprogram as dispatching
- -- and inherit the dispatching attributes of the parent subprogram. The
+ -- and inherit the dispatching attributes of the actual subprogram. The
-- derived subprogram is effectively renaming of the actual subprogram,
-- so it needs to have the same attributes as the actual.
if Present (Actual_Subp)
- and then Is_Dispatching_Operation (Parent_Subp)
+ and then Is_Dispatching_Operation (Actual_Subp)
then
Set_Is_Dispatching_Operation (New_Subp);
- if Present (DTC_Entity (Parent_Subp)) then
- Set_DTC_Entity (New_Subp, DTC_Entity (Parent_Subp));
- Set_DT_Position (New_Subp, DT_Position (Parent_Subp));
+ if Present (DTC_Entity (Actual_Subp)) then
+ Set_DTC_Entity (New_Subp, DTC_Entity (Actual_Subp));
+ Set_DT_Position (New_Subp, DT_Position (Actual_Subp));
end if;
end if;
elsif not Comes_From_Source (Original_Comp) then
return True;
- -- If we are in the body of an instantiation, the component is visible
- -- even when the parent type (possibly defined in an enclosing unit or
- -- in a parent unit) might not.
-
- elsif In_Instance_Body then
- return True;
-
-- Discriminants are always visible
elsif Ekind (Original_Comp) = E_Discriminant
then
return True;
+ -- If we are in the body of an instantiation, the component is visible
+ -- if the parent type is non-private, or in an enclosing scope. The
+ -- scope stack is not present when analyzing an instance body, so we
+ -- must inspect the chain of scopes explicitly.
+
+ elsif In_Instance_Body then
+ if not Is_Private_Type (Scope (C)) then
+ return True;
+
+ else
+ declare
+ S : Entity_Id;
+
+ begin
+ S := Current_Scope;
+ while Present (S)
+ and then S /= Standard_Standard
+ loop
+ if S = Type_Scope then
+ return True;
+ end if;
+
+ S := Scope (S);
+ end loop;
+
+ return False;
+ end;
+ end if;
+
-- If the component has been declared in an ancestor which is currently
-- a private type, then it is not visible. The same applies if the
-- component's containing type is not in an open scope and the original
-- do not know the exact end points at the time of the declaration. This
-- is true for three reasons:
- -- A size clause may affect the fudging of the end-points
- -- A small clause may affect the values of the end-points
- -- We try to include the end-points if it does not affect the size
+ -- A size clause may affect the fudging of the end-points.
+ -- A small clause may affect the values of the end-points.
+ -- We try to include the end-points if it does not affect the size.
- -- This means that the actual end-points must be established at the point
- -- when the type is frozen. Meanwhile, we first narrow the range as
- -- permitted (so that it will fit if necessary in a small specified size),
- -- and then build a range subtree with these narrowed bounds.
-
- -- Set_Fixed_Range constructs the range from real literal values, and sets
- -- the range as the Scalar_Range of the given fixed-point type entity.
+ -- This means that the actual end-points must be established at the
+ -- point when the type is frozen. Meanwhile, we first narrow the range
+ -- as permitted (so that it will fit if necessary in a small specified
+ -- size), and then build a range subtree with these narrowed bounds.
+ -- Set_Fixed_Range constructs the range from real literal values, and
+ -- sets the range as the Scalar_Range of the given fixed-point type entity.
-- The parent of this range is set to point to the entity so that it is
-- properly hooked into the tree (unlike normal Scalar_Range entries for
begin
Set_Scalar_Range (E, S);
Set_Parent (S, E);
+
+ -- Before the freeze point, the bounds of a fixed point are universal
+ -- and carry the corresponding type.
+
+ Set_Etype (Low_Bound (S), Universal_Real);
+ Set_Etype (High_Bound (S), Universal_Real);
end Set_Fixed_Range;
----------------------------------
OSDN Git Service
