]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
[Ada] Conformance error on protected subp with anonymous-access-to-tagged formal
authorGary Dismukes <dismukes@adacore.com>
Fri, 17 Dec 2021 23:41:01 +0000 (18:41 -0500)
committerPierre-Marie de Rodat <derodat@adacore.com>
Tue, 11 Jan 2022 13:24:46 +0000 (13:24 +0000)
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.

gcc/ada/sem_disp.adb

index 73d0e9dcb3bd58d3459c74fd8e4ad3ac5e33f9d6..cafe2c379f2c6f4f6579bd527da71d8c6f1c3921 100644 (file)
@@ -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.