===================================================================
@@ -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
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 <schonberg@adacore.com> * sem_ch6.adb (Same_Generic_Actual): Make function symmetric, because either type may be a subtype of the other.