gcc/testsuite/gnat.dg/sync_tag_discriminals.adb

   1 -- This test is related to sync_tag_limited in that previous versions of GNAT
   2 -- failed to consider a synchronized private extension as limited if it was
   3 -- not derrived from a synchronized interface (i.e. a limited interface). Since
   4 -- such a private type would not be considered limited, GNAT would fail to
   5 -- correctly build the expected discriminals later needed by the creation of
   6 -- the concurrent type's "corresponding record type", leading to a compilation
   7 -- error where the discriminants of the corresponding record type had no
   8 -- identifiers.
   9 --
  10 -- This test is in addition to sync_tag_limited because the sync_tag_limited
  11 -- would fail for "legality" reasons (default discriminants not allowed for
  12 -- a non-limited taged type). It is also an opportunity to ensure that non-
  13 -- defaulted discriminated synchronized private extensions work as expected.
  14
  15 --  { dg-do compile }
  16
  17 procedure Sync_Tag_Discriminals is
  18
  19    package Ifaces is
  20
  21       type Test_Interface is limited interface;
  22
  23       procedure Interface_Action (Test: in out Test_Interface) is abstract;
  24
  25    end Ifaces;
  26
  27
  28    package Implementation is
  29       type Test_Implementation
  30         (Constraint: Positive) is
  31         synchronized new Ifaces.Test_Interface with private;
  32
  33    private
  34       protected type Test_Implementation
  35         (Constraint: Positive)
  36       is new Ifaces.Test_Interface with
  37
  38          overriding procedure Interface_Action;
  39
  40       end Test_Implementation;
  41    end Implementation;
  42
  43    package body Implementation is
  44       protected body Test_Implementation is
  45          procedure Interface_Action is null;
  46       end;
  47    end Implementation;
  48
  49 begin
  50    null;
  51 end Sync_Tag_Discriminals;