gcc/testsuite/gnat.dg/delta_aggr.adb

   1 --  { dg-do compile }
   2 --  { dg-options "-gnat2020" }
   3
   4 procedure Delta_Aggr is
   5    type T1 is tagged record
   6       F1, F2, F3 : Integer := 0;
   7    end record;
   8
   9    function Make (X : Integer)  return T1 is
  10    begin
  11       return (10, 20, 30);
  12    end Make;
  13
  14    package Pkg is
  15       type T2 is new T1 with private;
  16       X, Y : constant T2;
  17       function Make (X : Integer) return T2;
  18    private
  19       type T2 is new T1 with
  20          record
  21             F4 : Integer := 0;
  22          end record;
  23       X : constant T2 := (0, 0, 0, 0);
  24       Y : constant T2 := (1, 2, 0, 0);
  25    end Pkg;
  26
  27    package body Pkg is
  28       function Make (X : Integer) return T2 is
  29       begin
  30          return (X, X ** 2, X ** 3, X ** 4);
  31       end Make;
  32    end Pkg;
  33
  34    use Pkg;
  35
  36    Z : T2 := (Y with delta F1 => 111);
  37
  38    -- a legal delta aggregate whose type is a private extension
  39    pragma Assert (Y = (X with delta F1 => 1, F2 => 2));
  40    pragma assert (Y.F2 = X.F1);
  41
  42 begin
  43    Z := (X with delta F1 => 1);
  44
  45    --  The base of the delta aggregate can be overloaded, in which case
  46    --  the candidate interpretations for the aggregate are those of the
  47    --  base, to be resolved from context.
  48
  49    Z := (Make (2) with delta F1 => 1);
  50    null;
  51 end Delta_Aggr;