[PATCH 1/2 v2] Ada: Synchronized private extensions are always limited

[Richard Wai <richard@annexi-strayline.com>]

[-- Attachment #1: Type: text/plain, Size: 326 bytes --]

Hi Arno,

No worries, and sorry for the trouble. I’m going to try using a different client for the gcc mailing list, it doesn’t seem to like Outlook. Thanks for catching that mistake!

Please advise how I can get this patch actually applied, given my lack of commit privilege.

Revised patch attached!

Thanks!


[-- Attachment #2: ada-synchronized-private-types-are-limited-v2.patch --]
[-- Type: application/octet-stream, Size: 5896 bytes --]

From f87d0da43296b87cd242380a4077a167e5ea1291 Mon Sep 17 00:00:00 2001
From: Richard Wai <richard@annexi-strayline.com>
Date: Wed, 9 Aug 2023 01:54:48 -0400
Subject: [PATCH 1/2] ada: Consider that any synchronized private extension is
 always a limited type, even if it inherits from a non-concurrent interface.
 Add two regression tests for two separate problems that arose

---
 gcc/ada/sem_ch3.adb                           | 12 +++--
 .../gnat.dg/sync_tag_discriminals.adb         | 51 +++++++++++++++++++
 gcc/testsuite/gnat.dg/sync_tag_limited.adb    | 50 ++++++++++++++++++
 3 files changed, 110 insertions(+), 3 deletions(-)
 create mode 100644 gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
 create mode 100644 gcc/testsuite/gnat.dg/sync_tag_limited.adb

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 042ace01724..48731a7bf04 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9494,9 +9494,15 @@ package body Sem_Ch3 is
 
       --  AI-419: Limitedness is not inherited from an interface parent, so to
       --  be limited in that case the type must be explicitly declared as
-      --  limited. However, task and protected interfaces are always limited.
-
-      if Limited_Present (Type_Def) then
+      --  limited, or synchronized. While task and protected interfaces are
+      --  always limited, a synchronized private extension might not inherit
+      --  from such interfaces, and so we also need to recognize the
+      --  explicit limitedness implied by a synchronized private extension
+      --  that does not derive from a synchronized interface (see RM-7.3(6/2)).
+
+      if Limited_Present (Type_Def)
+        or else Synchronized_Present (Type_Def)
+      then
          Set_Is_Limited_Record (Derived_Type);
 
       elsif Is_Limited_Record (Parent_Type)
diff --git a/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb b/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
new file mode 100644
index 00000000000..b105acf6e98
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_tag_discriminals.adb
@@ -0,0 +1,51 @@
+-- This test is related to sync_tag_limited in that previous versions of GNAT
+-- failed to consider a synchronized private extension as limited if it was
+-- not derrived from a synchronized interface (i.e. a limited interface). Since
+-- such a private type would not be considered limited, GNAT would fail to
+-- correctly build the expected discriminals later needed by the creation of
+-- the concurrent type's "corresponding record type", leading to a compilation
+-- error where the discriminants of the corresponding record type had no
+-- identifiers.
+--
+-- This test is in addition to sync_tag_limited because the sync_tag_limited
+-- would fail for "legality" reasons (default discriminants not allowed for
+-- a non-limited taged type). It is also an opportunity to ensure that non-
+-- defaulted discriminated synchronized private extensions work as expected.
+
+--  { dg-do compile }
+
+procedure Sync_Tag_Discriminals is
+   
+   package Ifaces is
+      
+      type Test_Interface is limited interface;
+      
+      procedure Interface_Action (Test: in out Test_Interface) is abstract;
+      
+   end Ifaces;
+   
+   
+   package Implementation is
+      type Test_Implementation
+        (Constraint: Positive) is
+        synchronized new Ifaces.Test_Interface with private;
+      
+   private
+      protected type Test_Implementation
+        (Constraint: Positive)
+      is new Ifaces.Test_Interface with
+      
+         overriding procedure Interface_Action;
+         
+      end Test_Implementation;
+   end Implementation;
+   
+   package body Implementation is
+      protected body Test_Implementation is
+         procedure Interface_Action is null;
+      end;
+   end Implementation;
+   
+begin
+   null;
+end Sync_Tag_Discriminals;
diff --git a/gcc/testsuite/gnat.dg/sync_tag_limited.adb b/gcc/testsuite/gnat.dg/sync_tag_limited.adb
new file mode 100644
index 00000000000..608f10662a3
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/sync_tag_limited.adb
@@ -0,0 +1,50 @@
+--  Synchronized tagged types created by a private extension with the keyword
+--  'synchronized' shall be seen as an (immutably) limited tagged type, and
+--  should therefore accept default disciminant spectifications.
+--  This was a bug in earlier versions of GNAT, whereby GNAT erroneously
+--  relied on a parent synchronized interface to determine limitedness
+--  of a synchronized private extension. The problem being that a synchronized
+--  private extension can derive a non-synchronized interface (specifically a
+--  limited interface), Yet the RM makes it clear (7.3(6/2)) that such
+--  synchronized private extensions are always limited.
+--
+--  Ergo: Default discriminants are of course legal on any synchronized private
+--  extension.
+
+--  { dg-do compile }
+
+procedure Sync_Tag_Limited is
+   
+   package Ifaces is
+      
+      type Test_Interface is limited interface;
+      
+      procedure Interface_Action (Test: in out Test_Interface) is abstract;
+      
+   end Ifaces;
+   
+   
+   package Implementation is
+      type Test_Implementation
+        (Constraint: Positive := 1) is
+        synchronized new Ifaces.Test_Interface with private;
+      
+   private
+      protected type Test_Implementation
+        (Constraint: Positive := 1)
+      is new Ifaces.Test_Interface with
+      
+         overriding procedure Interface_Action;
+         
+      end Test_Implementation;
+   end Implementation;
+   
+   package body Implementation is
+      protected body Test_Implementation is
+         procedure Interface_Action is null;
+      end;
+   end Implementation;
+   
+begin
+   null;
+end Sync_Tag_Limited;
-- 
2.40.1


[-- Attachment #3: Type: text/plain, Size: 461 bytes --]




> On Sep 1, 2023, at 08:08, Arnaud Charlet <charlet@adacore.com> wrote:
> 
>> For some reason, your email is endeing up in a strange format, I almost
>> missed the .patch file attached, making the review harder.
> 
> Never mind, I was on vacation earlier this month and then busy with a seminar last week, so I started looking at your ping email before the original email which did contain the patch easily found, sorry for the noise!
> 
> Arno