From: Gary Dismukes <dismukes@adacore.com>
Date: Fri, 17 Dec 2021 23:41:01 +0000 (-0500)
Subject: [Ada] Conformance error on protected subp with anonymous-access-to-tagged formal
X-Git-Tag: upstream/12.2.0~2249
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a115e497e64731bada3b8aeab2f9444c638a145f;p=platform%2Fupstream%2Fgcc.git

[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 --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 73d0e9d..cafe2c3 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.