From: Eric Botcazou <ebotcazou@adacore.com>
Date: Thu, 30 Apr 2026 07:27:06 +0000 (+0200)
Subject: Ada: Fix spurious error on primitive function of tagged task type
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=edc868bc73f4b8ab076a8a87749a3f33326cfd5f;p=thirdparty%2Fgcc.git

Ada: Fix spurious error on primitive function of tagged task type

This comes from an internal confusion about the subtype of the controlling
result.  This has probably never worked, but the fix is trivial.

gcc/ada/
	PR ada/125044
	* sem_disp.adb (Check_Controlling_Formals): Apply the same massaging
	to the result subtype as to the parameter subtypes.

gcc/testsuite/
	* gnat.dg/task6.ads, gnat.dg/task6.adb: New test.
---

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 36699e237f0..ff606c7cfa7 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -336,9 +336,7 @@ package body Sem_Disp is
          end if;
 
          if Present (Ctrl_Type) then
-
-            --  Obtain the full type in case we are looking at an incomplete
-            --  view.
+            --  Use the full view for an incomplete type
 
             if Ekind (Ctrl_Type) = E_Incomplete_Type
               and then Present (Full_View (Ctrl_Type))
@@ -346,8 +344,7 @@ package body Sem_Disp is
                Ctrl_Type := Full_View (Ctrl_Type);
             end if;
 
-            --  When controlling type is concurrent and declared within a
-            --  generic or inside an instance use corresponding record type.
+            --  Use the corresponding record type for a concurrent type
 
             if Is_Concurrent_Type (Ctrl_Type)
               and then Present (Corresponding_Record_Type (Ctrl_Type))
@@ -439,6 +436,22 @@ package body Sem_Disp is
          Ctrl_Type := Check_Controlling_Type (Etype (Subp), Subp);
 
          if Present (Ctrl_Type) then
+            --  Use the full view for an incomplete type
+
+            if Ekind (Ctrl_Type) = E_Incomplete_Type
+              and then Present (Full_View (Ctrl_Type))
+            then
+               Ctrl_Type := Full_View (Ctrl_Type);
+            end if;
+
+            --  Use the corresponding record type for a concurrent type
+
+            if Is_Concurrent_Type (Ctrl_Type)
+              and then Present (Corresponding_Record_Type (Ctrl_Type))
+            then
+               Ctrl_Type := Corresponding_Record_Type (Ctrl_Type);
+            end if;
+
             if Ctrl_Type = Typ then
                Set_Has_Controlling_Result (Subp);
 
diff --git a/gcc/testsuite/gnat.dg/task6.adb b/gcc/testsuite/gnat.dg/task6.adb
new file mode 100644
index 00000000000..dd0ebfc3ebe
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task6.adb
@@ -0,0 +1,15 @@
+-- { dg-do compile }
+
+package body Task6 is
+
+   task body T is
+   begin
+     accept E;
+   end T;
+
+   function Make return T is
+   begin
+     return Ret : T;
+   end;
+
+end Task6;
diff --git a/gcc/testsuite/gnat.dg/task6.ads b/gcc/testsuite/gnat.dg/task6.ads
new file mode 100644
index 00000000000..d1e605c2a73
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task6.ads
@@ -0,0 +1,13 @@
+package Task6 is
+
+  type Int is task interface;
+
+  procedure E (T: Int) is abstract;
+
+  task type T is new Int with
+    entry E;
+  end T;
+
+  function Make return T;
+
+end Task6;