The Ada 2012 RM introduces the notion of an incomplete view of an ancestor
type: 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. This makes some type
conversions legal even if other operations are not available for the type.
Compiling p-child.ads in the following example from RM 7.3.1 (5.2/3), must
yield the following errors and no others:
p-child.ads:8:12: invalid conversion, not compatible with type
universal integer
p-child.ads:9:12: expected type universal integer
p-child.ads:9:12: found private type "T3" defined at line 3
package P is
type T is private;
C: constant T;
private
type T is new Integer;
C: constant T := 42;
end P;
---
with P;
package Q is
type T2 is new P.T;
end Q;
with Q;
---
package P.Child is
type T3 is new Q.T2;
private
Int: Integer := 52;
V: T3 := T3 (P.C); -- legal
W: T3 := T3 (Int); -- legal
X: T3 := T3 ( 42); -- error, T3 not numeric
Y: T3 := X + 1; -- error, no visible "+"
Z: T3 := T3 (Integer (W) + 1); -- legal
end P.Child;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-04-11 Ed Schonberg <schonb...@adacore.com>
* sem_util.ads, sem_util.adb (Get_Incomplete_View_Of_Ancestor):
New function to implement the notion introduced 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.
* sem_res.adb (Valid_Conversion): if all else fails, examine if an
incomplete view of an ancestor makes a numeric conversion legal.
Index: sem_util.adb
===================================================================
--- sem_util.adb (revision 197773)
+++ sem_util.adb (working copy)
@@ -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 --
----------------------
Index: sem_util.ads
===================================================================
--- sem_util.ads (revision 197743)
+++ sem_util.ads (working copy)
@@ -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
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 197768)
+++ sem_res.adb (working copy)
@@ -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;
