From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x331.google.com (mail-wm1-x331.google.com [IPv6:2a00:1450:4864:20::331]) by sourceware.org (Postfix) with ESMTPS id 2FC2B3858D39 for ; Tue, 19 Sep 2023 12:04:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 2FC2B3858D39 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x331.google.com with SMTP id 5b1f17b1804b1-403012f27e3so63381605e9.3 for ; Tue, 19 Sep 2023 05:04:17 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1695125056; x=1695729856; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=qMDFCqHmvjzTyyEHBvvRKl5Z0Ycpu+kMfvZRk4zk6zM=; b=NI532rreNSc8dcElpv73r2pPRXHR37kMQgpDgakTkDSxVL8I6LuR9uuhJaxyW0xkIW bhtf8EpeIENsYBYpwF1PcKHQ24WPbNUdm1ZrptCQDu24Jl9KM/2fRo2peaWEonrRl7hz yfDbUYWBe0PjNwAPfm3BW2vfPNIbXFD2qz49gex7IZ9ih/SyoyBZy4ozw2nt4r7fQ00x wDOAEe2Fjb4U/w91yYAwSaLL8XRJZWbeQZx8Y+l/H7kWHMMMW7V3AZ81vqM9N9/h5cAs CMMlFh/sCGMktjexf9h5SzdBf5nWfrkUgN4T063fvauyko+tROkxUA3LV89DHSN0RIM2 arQA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1695125056; x=1695729856; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=qMDFCqHmvjzTyyEHBvvRKl5Z0Ycpu+kMfvZRk4zk6zM=; b=kBODufa0Yw2guIlOIZrhgMFsIlZ7G+FDxtBwE4r2nh0VvxNjAdsEEiKzxv9yVAbAXY AtWrUTQJU/vFqUiqofzLu36HasLT5qszUIzeqaqVgPUqneXfrSNlsnxqm4Z33gamYpig RpVpJnumRIbhtLXrr95hIUZsXhBlPufzy4fSORryCc8A1u2k7mLcMRbUPC2wqnymmlzP v482TgR59SWNKxgWBVt3LJ2b2ZXrtvRechdOBD3/gQl4EtGKgte0MUyVtOGAIbKJMCO7 jAwOWwz/GNCU6CSIwSLLjghltJu50C4LIDiINC7dQBoAwKclK5Hu5JaEfOs1o5RHIPCB HFNw== X-Gm-Message-State: AOJu0YxhwRxuAdQugW6IDLorEE3XwZsl/8S0bogMqaonUobRsEj3w5aJ g36uX0lcM29VoGqCrg46bqAT8w== X-Google-Smtp-Source: AGHT+IHj1ZhBgYl+Tb0nMZpX2AFY/QSPgqi15nSz0bSzHfTWHRRJ7PW41Bi/68m82EYBZMJ9k4+YDQ== X-Received: by 2002:a05:600c:3641:b0:401:b652:b6cf with SMTP id y1-20020a05600c364100b00401b652b6cfmr10467426wmq.13.1695125055460; Tue, 19 Sep 2023 05:04:15 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:d64c:aec5:913b:4c80]) by smtp.gmail.com with ESMTPSA id s24-20020a7bc398000000b003feee8d8011sm18143188wmj.41.2023.09.19.05.04.14 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 19 Sep 2023 05:04:15 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: richard@annexi-strayline.com Cc: baird@adacore.com, charlet@adacore.com, dismukes@adacore.com, ebotcazou@adacore.com, gcc-patches@gcc.gnu.org, poulhies@adacore.com Subject: [COMMITTED] ada: Private extensions with the keyword "synchronized" are always limited. Date: Tue, 19 Sep 2023 14:03:42 +0200 Message-Id: <20230919120342.2276062-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 In-Reply-To: <010d018aab866671-d9917985-9044-42df-a441-de80df28c3b4-000000@ca-central-1.amazonses.com> References: <010d018aab866671-d9917985-9044-42df-a441-de80df28c3b4-000000@ca-central-1.amazonses.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.7 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Richard Wai 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 --- 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 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; -- 2.40.0