gcc/testsuite/gnat.dg/sync_tag_limited.adb

   1 --  Synchronized tagged types created by a private extension with the keyword
   2 --  'synchronized' shall be seen as an (immutably) limited tagged type, and
   3 --  should therefore accept default disciminant spectifications.
   4 --  This was a bug in earlier versions of GNAT, whereby GNAT erroneously
   5 --  relied on a parent synchronized interface to determine limitedness
   6 --  of a synchronized private extension. The problem being that a synchronized
   7 --  private extension can derive a non-synchronized interface (specifically a
   8 --  limited interface), Yet the RM makes it clear (7.3(6/2)) that such
   9 --  synchronized private extensions are always limited.
  10 --
  11 --  Ergo: Default discriminants are of course legal on any synchronized private
  12 --  extension.
  13
  14 --  { dg-do compile }
  15
  16 procedure Sync_Tag_Limited is
  17
  18    package Ifaces is
  19
  20       type Test_Interface is limited interface;
  21
  22       procedure Interface_Action (Test: in out Test_Interface) is abstract;
  23
  24    end Ifaces;
  25
  26
  27    package Implementation is
  28       type Test_Implementation
  29         (Constraint: Positive := 1) is
  30         synchronized new Ifaces.Test_Interface with private;
  31
  32    private
  33       protected type Test_Implementation
  34         (Constraint: Positive := 1)
  35       is new Ifaces.Test_Interface with
  36
  37          overriding procedure Interface_Action;
  38
  39       end Test_Implementation;
  40    end Implementation;
  41
  42    package body Implementation is
  43       protected body Test_Implementation is
  44          procedure Interface_Action is null;
  45       end;
  46    end Implementation;
  47
  48 begin
  49    null;
  50 end Sync_Tag_Limited;