[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 11eca2c3dc7f530ef7b81afb1075661259521a5b..19e7fea30b95c92250e9de593851f5ac15644614 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+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

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5af3b7b7e196c997c05f25bc3b564b90f970616a..988edc682b12a07015e160a1495a10e5968d653b 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/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;