-- 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)
--- /dev/null
+-- 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;
--- /dev/null
+-- 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;