Within an instance, a subprogram declaration and the corresponding body may be
fully conformant, but one may use in its profile a formal type while the other
uses a declared subtype of that formal. The routine Same_Generic_Actual is used
to recognize this case and prevent a spurious conformance error or the creation
of two different subprograms, which leads to errors at link time. This patch
makes the check symmetric, so that either the spec or the body may use a
declared subtype of the generic formal.
The following must execute quietly:
gnatmake -q main
---
with specific_vector;
procedure main is
sv : specific_vector.Object := (1.0, 2.0, 3.0);
begin
sv := specific_vector."-"(Right => sv);
end main;
---
with Vector_Types;
generic
type Vector_Element is digits <>;
type Vector is array (Vector_Types.Coordinate) of Vector_Element;
Package Generic_Vector is
subtype Object is Vector;
function "-" (Right : Object) return Object;
end Generic_Vector;
---
with Vector_Types;
package body Generic_Vector is
function "-" (Right : Vector) return Vector is
Negated_Vector : Vector := (vector_types.X => -Right(vector_types.X),
vector_types.Y => -Right(vector_types.Y),
vector_types.Z => -Right(vector_types.Z) );
begin
return Negated_Vector;
end "-";
end Generic_Vector;
---
with interfaces;
with Vector_Types;
with Generic_Vector;
package Specific_Vector is new
Generic_Vector(Vector_Element => Interfaces.IEEE_Float_64,
Vector => Vector_Types.Float_Vector_64);
---
with interfaces;
package Vector_Types is
type Coordinate is (X, Y, Z);
type Float_Vector_64 is array (Coordinate) of Interfaces.IEEE_Float_64;
end Vector_Types;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-08-01 Ed Schonberg <schonb...@adacore.com>
* sem_ch6.adb (Same_Generic_Actual): Make function symmetric,
because either type may be a subtype of the other.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 213434)
+++ sem_ch6.adb (working copy)
@@ -7274,21 +7274,38 @@
-- Check that the types of corresponding formals have the same
-- generic actual if any. We have to account for subtypes of a
-- generic formal, declared between a spec and a body, which may
- -- appear distinct in an instance but matched in the generic.
+ -- appear distinct in an instance but matched in the generic, and
+ -- the subtype may be used either in the spec or the body of the
+ -- subprogram being checked.
-------------------------
-- Same_Generic_Actual --
-------------------------
function Same_Generic_Actual (T1, T2 : Entity_Id) return Boolean is
+
+ function Is_Declared_Subtype (S1, S2 : Entity_Id) return Boolean;
+ -- Predicate to check whether S1 is a subtype of S2 in the source
+ -- of the instance.
+
+ -------------------------
+ -- Is_Declared_Subtype --
+ -------------------------
+
+ function Is_Declared_Subtype (S1, S2 : Entity_Id) return Boolean is
+ begin
+ return Comes_From_Source (Parent (S1))
+ and then Nkind (Parent (S1)) = N_Subtype_Declaration
+ and then Is_Entity_Name (Subtype_Indication (Parent (S1)))
+ and then Entity (Subtype_Indication (Parent (S1))) = S2;
+ end Is_Declared_Subtype;
+
+ -- Start of processing for Same_Generic_Actual
+
begin
return Is_Generic_Actual_Type (T1) = Is_Generic_Actual_Type (T2)
- or else
- (Present (Parent (T1))
- and then Comes_From_Source (Parent (T1))
- and then Nkind (Parent (T1)) = N_Subtype_Declaration
- and then Is_Entity_Name (Subtype_Indication (Parent (T1)))
- and then Entity (Subtype_Indication (Parent (T1))) = T2);
+ or else Is_Declared_Subtype (T1, T2)
+ or else Is_Declared_Subtype (T2, T1);
end Same_Generic_Actual;
-- Start of processing for Different_Generic_Profile
