[Ada] Tighten up semantic checking for protected subprogram declarations

2019-12-12  Steve Baird  <baird@adacore.com>

gcc/ada/

	* sem_ch6.adb
	(New_Overloaded_Entity.Check_Conforming_Paramters): Add new
	Conformance_Type parameter. With the value of
	Subtype_Conformant, the behavior of Check_Conforming_Parameters
	is unchanged.  The call in Matching_Entry_Or_Subprogram to
	instead passes in Type_Conformant. This corresponds to the use
	of "type conformant" in Ada RM 9.4(11.4/3).
	(New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add
	new Normalized_First_Parameter_Type function to help in ignoring
	the distinction between protected and access-to-protected first
	parameters when checking prefixed-view profile matching. Replace
	computations of the type of the first parameter with calls to
	this function as appropriate.

From-SVN: r279303

gcc/ada/ChangeLog

+2019-12-12  Steve Baird  <baird@adacore.com>
+
+	* sem_ch6.adb
+	(New_Overloaded_Entity.Check_Conforming_Paramters): Add new
+	Conformance_Type parameter. With the value of
+	Subtype_Conformant, the behavior of Check_Conforming_Parameters
+	is unchanged.  The call in Matching_Entry_Or_Subprogram to
+	instead passes in Type_Conformant. This corresponds to the use
+	of "type conformant" in Ada RM 9.4(11.4/3).
+	(New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add
+	new Normalized_First_Parameter_Type function to help in ignoring
+	the distinction between protected and access-to-protected first
+	parameters when checking prefixed-view profile matching. Replace
+	computations of the type of the first parameter with calls to
+	this function as appropriate.
+
 2019-12-12  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch5.adb: (Analyze_Iterator_Specification): If the

gcc/ada/sem_ch6.adb

@@ -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;