@@ -10487,9 +10487,10 @@ package body Sem_Ch6 is
is
function Check_Conforming_Parameters
(E1_Param : Node_Id;
- E2_Param : Node_Id) return Boolean;
+ E2_Param : Node_Id;
+ Ctype : Conformance_Type) return Boolean;
-- Starting from the given parameters, check that all the parameters
- -- of two entries or subprograms are subtype conformant. Used to skip
+ -- of two entries or subprograms are conformant. Used to skip
-- the check on the controlling argument.
function Matching_Entry_Or_Subprogram
@@ -10516,26 +10517,38 @@ package body Sem_Ch6 is
-- whose name matches the original name of Subp and has a profile
-- conformant with the profile of Subp; return Empty if not found.
+ function Normalized_First_Parameter_Type
+ (E : Entity_Id) return Entity_Id;
+ -- Return the type of the first parameter unless that type
+ -- is an anonymous access type, in which case return the
+ -- designated type. Used to treat anonymous-access-to-synchronized
+ -- the same as synchronized for purposes of checking for
+ -- prefixed view profile conflicts.
+
---------------------------------
-- Check_Conforming_Parameters --
---------------------------------
function Check_Conforming_Parameters
(E1_Param : Node_Id;
- E2_Param : Node_Id) return Boolean
+ E2_Param : Node_Id;
+ Ctype : Conformance_Type) return Boolean
is
Param_E1 : Node_Id := E1_Param;
Param_E2 : Node_Id := E2_Param;
begin
while Present (Param_E1) and then Present (Param_E2) loop
- if Ekind (Defining_Identifier (Param_E1)) /=
- Ekind (Defining_Identifier (Param_E2))
- or else not
+ if (Ctype >= Mode_Conformant) and then
+ Ekind (Defining_Identifier (Param_E1)) /=
+ Ekind (Defining_Identifier (Param_E2))
+ then
+ return False;
+ elsif not
Conforming_Types
(Find_Parameter_Type (Param_E1),
Find_Parameter_Type (Param_E2),
- Subtype_Conformant)
+ Ctype)
then
return False;
end if;
@@ -10568,7 +10581,8 @@ package body Sem_Ch6 is
and then
Check_Conforming_Parameters
(First (Parameter_Specifications (Parent (E))),
- Next (First (Parameter_Specifications (Parent (Subp)))))
+ Next (First (Parameter_Specifications (Parent (Subp)))),
+ Type_Conformant)
then
return E;
end if;
@@ -10608,7 +10622,8 @@ package body Sem_Ch6 is
and then
Check_Conforming_Parameters
(First (Parameter_Specifications (Parent (Ent))),
- Next (First (Parameter_Specifications (Parent (E)))))
+ Next (First (Parameter_Specifications (Parent (E)))),
+ Subtype_Conformant)
then
return E;
end if;
@@ -10662,6 +10677,21 @@ package body Sem_Ch6 is
return Empty;
end Matching_Original_Protected_Subprogram;
+ -------------------------------------
+ -- Normalized_First_Parameter_Type --
+ -------------------------------------
+
+ function Normalized_First_Parameter_Type
+ (E : Entity_Id) return Entity_Id
+ is
+ Result : Entity_Id := Etype (First_Entity (E));
+ begin
+ if Ekind (Result) = E_Anonymous_Access_Type then
+ Result := Designated_Type (Result);
+ end if;
+ return Result;
+ end Normalized_First_Parameter_Type;
+
-- Start of processing for Has_Matching_Entry_Or_Subprogram
begin
@@ -10672,20 +10702,23 @@ package body Sem_Ch6 is
if Comes_From_Source (E)
and then Is_Subprogram (E)
and then Present (First_Entity (E))
- and then Is_Concurrent_Record_Type (Etype (First_Entity (E)))
+ and then Is_Concurrent_Record_Type
+ (Normalized_First_Parameter_Type (E))
then
if Scope (E) =
Scope (Corresponding_Concurrent_Type
- (Etype (First_Entity (E))))
+ (Normalized_First_Parameter_Type (E)))
and then
Present
(Matching_Entry_Or_Subprogram
- (Corresponding_Concurrent_Type (Etype (First_Entity (E))),
+ (Corresponding_Concurrent_Type
+ (Normalized_First_Parameter_Type (E)),
Subp => E))
then
Report_Conflict (E,
Matching_Entry_Or_Subprogram
- (Corresponding_Concurrent_Type (Etype (First_Entity (E))),
+ (Corresponding_Concurrent_Type
+ (Normalized_First_Parameter_Type (E)),
Subp => E));
return True;
end if;