From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 4 Nov 2025 19:05:25 +0000 (+0100)
Subject: Ada: Fix explicit raise on subtype of lock-free protected type
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=c0132281f671a79da992cec75a65c4f739ad991f;p=thirdparty%2Fgcc.git

Ada: Fix explicit raise on subtype of lock-free protected type

The issue is that the Uses_Lock_Free flag is not propagated to the subtype.

gcc/ada/
	* sem_ch3.adb (Analyze_Subtype_Declaration) <Concurrent_Kind>:
	Propagate the Uses_Lock_Free flag for protected types.

gcc/testsuite/
	* gnat.dg/protected_subtype1.adb: New test.
---

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 233f8237aa5..ba0af27471d 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6145,6 +6145,10 @@ package body Sem_Ch3 is
                Set_Is_Tagged_Type       (Id, Is_Tagged_Type        (T));
                Set_Last_Entity          (Id, Last_Entity           (T));
 
+               if Is_Protected_Type (T) then
+                  Set_Uses_Lock_Free (Id, Uses_Lock_Free (T));
+               end if;
+
                if Is_Tagged_Type (T) then
                   Set_No_Tagged_Streams_Pragma
                     (Id, No_Tagged_Streams_Pragma (T));
diff --git a/gcc/testsuite/gnat.dg/protected_subtype1.adb b/gcc/testsuite/gnat.dg/protected_subtype1.adb
new file mode 100644
index 00000000000..cb003c892a1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/protected_subtype1.adb
@@ -0,0 +1,26 @@
+-- { dg-do compile }
+
+procedure Protected_Subtype1 is
+
+   protected type Object with Lock_Free => True is
+   end Object;
+
+   protected body Object is
+   end Object;
+
+   A : Object;
+
+   subtype Object_Subtype is Object;
+
+   B : Object_Subtype;
+
+   type Rec is record
+      A : Object;         
+      B : Object_Subtype;
+   end record;
+
+   C : Rec;
+
+begin
+  null;
+end;