===================================================================
@@ -5380,6 +5380,55 @@
end if;
end Get_Generic_Entity;
+ -------------------------------------
+ -- Get_Incomplete_View_Of_Ancestor --
+ -------------------------------------
+
+ function Get_Incomplete_View_Of_Ancestor (E : Entity_Id) return Entity_Id is
+ Cur_Unit : constant Entity_Id := Cunit_Entity (Current_Sem_Unit);
+ Par_Scope : Entity_Id;
+ Par_Type : Entity_Id;
+
+ begin
+ -- The incomplete view of an ancestor is only relevant for private
+ -- derived types in child units.
+
+ if not Is_Derived_Type (E)
+ or else not Is_Child_Unit (Cur_Unit)
+ then
+ return Empty;
+
+ else
+ Par_Scope := Scope (Cur_Unit);
+ if No (Par_Scope) then
+ return Empty;
+ end if;
+
+ Par_Type := Etype (Base_Type (E));
+
+ -- Traverse list of ancestor types until we find one declared in
+ -- a parent or grandparent unit (two levels seem sufficient).
+
+ while Present (Par_Type) loop
+ if Scope (Par_Type) = Par_Scope
+ or else Scope (Par_Type) = Scope (Par_Scope)
+ then
+ return Par_Type;
+
+ elsif not Is_Derived_Type (Par_Type) then
+ return Empty;
+
+ else
+ Par_Type := Etype (Base_Type (Par_Type));
+ end if;
+ end loop;
+
+ -- If none found, there is no relevant ancestor type.
+
+ return Empty;
+ end if;
+ end Get_Incomplete_View_Of_Ancestor;
+
----------------------
-- Get_Index_Bounds --
----------------------
===================================================================
@@ -582,6 +582,12 @@
-- Returns the true generic entity in an instantiation. If the name in the
-- instantiation is a renaming, the function returns the renamed generic.
+ function Get_Incomplete_View_Of_Ancestor (E : Entity_Id) return Entity_Id;
+ -- Implements the notion introduced ever-so briefly in RM 7.3.1 (5.2/3):
+ -- in a child unit a derived type is within the derivation class of an
+ -- ancestor declared in a parent unit, even if there is an intermediate
+ -- derivation that does not see the full view of that ancestor.
+
procedure Get_Index_Bounds (N : Node_Id; L, H : out Node_Id);
-- This procedure assigns to L and H respectively the values of the low and
-- high bounds of node N, which must be a range, subtype indication, or the
===================================================================
@@ -10504,8 +10504,9 @@
Operand : Node_Id;
Report_Errs : Boolean := True) return Boolean
is
- Target_Type : constant Entity_Id := Base_Type (Target);
- Opnd_Type : Entity_Id := Etype (Operand);
+ Target_Type : constant Entity_Id := Base_Type (Target);
+ Opnd_Type : Entity_Id := Etype (Operand);
+ Inc_Ancestor : Entity_Id;
function Conversion_Check
(Valid : Boolean;
@@ -10883,6 +10884,13 @@
end;
end if;
+ -- If we are within a child unit, check whether the type of the
+ -- expression has an ancestor in a parent unit, in which case it
+ -- belongs to its derivation class even if the ancestor is private.
+ -- See RM 7.3.1 (5.2/3).
+
+ Inc_Ancestor := Get_Incomplete_View_Of_Ancestor (Opnd_Type);
+
-- Numeric types
if Is_Numeric_Type (Target_Type) then
@@ -10911,7 +10919,10 @@
else
return Conversion_Check
- (Is_Numeric_Type (Opnd_Type),
+ (Is_Numeric_Type (Opnd_Type)
+ or else
+ (Present (Inc_Ancestor)
+ and then Is_Numeric_Type (Inc_Ancestor)),
"illegal operand for numeric conversion");
end if;