From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7871) id 8E0493858D39; Tue, 19 Sep 2023 12:03:19 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8E0493858D39 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1695124999; bh=/NCyDTjVtbV1JQExxkhnDhCdNDXpJW1pBnIEp5WW/Lg=; h=From:To:Subject:Date:From; b=pj+nFYw8rNUidoTHTxIRcVvVczGVxaGxQlP6G2rxfNVgNiMKUWTvc9ZaxjHMkVFXp NvnA8mkpFkDKYtBZwb/wKeBl3nJCcTzndF3GOXDPPnyoU4Ir0IH1G0IZFwrRY9ukEf lwyXlq0AyWwRAu601ZhGTQPcmmjfRmJoXtXlKndg= MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Content-Type: text/plain; charset="utf-8" From: Marc Poulhi?s To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-4132] ada: Private extensions with the keyword "synchronized" are always limited. X-Act-Checkin: gcc X-Git-Author: Richard Wai X-Git-Refname: refs/heads/master X-Git-Oldrev: 5b945243c77e3ecd8dfab4b8b44f21daa3de8fe1 X-Git-Newrev: eceb45bb2e0bf5518d9bd873e25a498456af8e1f Message-Id: <20230919120319.8E0493858D39@sourceware.org> Date: Tue, 19 Sep 2023 12:03:19 +0000 (GMT) List-Id: https://gcc.gnu.org/g:eceb45bb2e0bf5518d9bd873e25a498456af8e1f commit r14-4132-geceb45bb2e0bf5518d9bd873e25a498456af8e1f Author: Richard Wai Date: Wed Aug 9 01:54:48 2023 -0400 ada: Private extensions with the keyword "synchronized" are always limited. GNAT was relying on synchronized private type extensions deriving from a concurrent interface to determine its limitedness. This does not cover the case where such an extension derives a limited interface. RM-7.6(6/2) makes is clear that "synchronized" in a private extension implies the derived type is limited. GNAT should explicitly check for the presence of "synchronized" in a private extension declaration, and it should have the same effect as the presence of “limited”. gcc/ada/ChangeLog: * sem_ch3.adb (Build_Derived_Record_Type): Treat presence of keyword "synchronized" the same as "limited" when determining if a private extension is limited. gcc/testsuite/ChangeLog: * gnat.dg/sync_tag_discriminals.adb: New test. * gnat.dg/sync_tag_limited.adb: New test. Signed-off-by: Richard Wai Diff: --- gcc/ada/sem_ch3.adb | 12 ++++-- gcc/testsuite/gnat.dg/sync_tag_discriminals.adb | 51 +++++++++++++++++++++++++ gcc/testsuite/gnat.dg/sync_tag_limited.adb | 50 ++++++++++++++++++++++++ 3 files changed, 110 insertions(+), 3 deletions(-) diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 3262236dd14..92902a7debb 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9599,9 +9599,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;