gcc/testsuite/gnat.dg/private_overriding.adb

   1 --  { dg-do compile }
   2
   3 procedure Private_Overriding is
   4
   5    package Foo is
   6
   7       type Bar is abstract tagged null record;
   8
   9       procedure Overloaded_Subprogram
  10          (Self : in out Bar)
  11          is abstract;
  12
  13       procedure Overloaded_Subprogram
  14          (Self : in out Bar;
  15           P1 : Integer)
  16          is abstract;
  17
  18       procedure Not_Overloaded_Subprogram
  19          (Self : in out Bar)
  20          is abstract;
  21
  22
  23       type Baz is new Bar with null record;
  24          -- promise to override both overloaded subprograms,
  25          -- shouldn't matter that they're defined in the private part,
  26
  27    private -- workaround: override in the public view
  28
  29       overriding
  30       procedure Overloaded_Subprogram
  31          (Self : in out Baz)
  32          is null;
  33
  34       overriding
  35       procedure Overloaded_Subprogram
  36          (Self : in out Baz;
  37           P1 : Integer)
  38           is null;
  39
  40       overriding
  41       procedure Not_Overloaded_Subprogram
  42          (Self : in out Baz)
  43          is null;
  44
  45    end Foo;
  46
  47    Qux : Foo.Baz;
  48 begin
  49
  50   -- this is allowed, as expected
  51   Foo.Not_Overloaded_Subprogram(Qux);
  52   Foo.Overloaded_Subprogram(Qux);
  53   Foo.Overloaded_Subprogram(Foo.Baz'Class(Qux));
  54   Foo.Overloaded_Subprogram(Foo.Bar'Class(Qux));
  55
  56   -- however, using object-dot notation
  57   Qux.Not_Overloaded_Subprogram; -- this is allowed
  58   Qux.Overloaded_Subprogram; -- "no selector..."
  59   Foo.Baz'Class(Qux).Overloaded_Subprogram; -- "no selector..."
  60   Foo.Bar'Class(Qux).Overloaded_Subprogram; -- this is allowed
  61
  62 end Private_Overriding;