[gcc r12-6448] [Ada] Conformance error on protected subp with anonymous-access-to-tagged formal

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:a115e497e64731bada3b8aeab2f9444c638a145f

commit r12-6448-ga115e497e64731bada3b8aeab2f9444c638a145f
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Fri Dec 17 18:41:01 2021 -0500

    [Ada] Conformance error on protected subp with anonymous-access-to-tagged formal
    
    gcc/ada/
    
            * sem_disp.adb (Check_Controlling_Type): Add test for the case
            where Subp is a subprogram associated with a protected
            subprogram and return Empty, unless Tagged_Type is the
            corresponding record type of the protected type.

Diff:
---
 gcc/ada/sem_disp.adb | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 73d0e9dcb3b..cafe2c379f2 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -478,6 +478,29 @@ package body Sem_Disp is
       if No (Tagged_Type) or else Is_Class_Wide_Type (Tagged_Type) then
          return Empty;
 
+      --  In the special case of a protected subprogram of a tagged protected
+      --  type that has a formal of a tagged type (or access formal whose type
+      --  designates a tagged type), such a formal is not controlling unless
+      --  it's of the protected type's corresponding record type. The latter
+      --  can occur for the special wrapper subprograms created for protected
+      --  subprograms. Such subprograms may occur in the same scope where some
+      --  formal's tagged type is declared, and we don't want formals of that
+      --  tagged type being marked as controlling, for one thing because they
+      --  aren't controlling from the language point of view, but also because
+      --  this can cause errors for access formals when conformance is checked
+      --  between the spec and body of the protected subprogram (null-exclusion
+      --  status of the formals may be set differently, which is the case that
+      --  led to adding this check).
+
+      elsif Is_Subprogram (Subp)
+        and then Present (Protected_Subprogram (Subp))
+        and then Ekind (Scope (Protected_Subprogram (Subp))) = E_Protected_Type
+        and then
+          Base_Type (Tagged_Type)
+            /= Corresponding_Record_Type (Scope (Protected_Subprogram (Subp)))
+      then
+         return Empty;
+
       --  The dispatching type and the primitive operation must be defined in
       --  the same scope, except in the case of internal operations and formal
       --  abstract subprograms.