view gcc/testsuite/gnat.dg/delta_aggr.adb @ 138:fc828634a951

merge
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 08 Nov 2018 14:17:14 +0900
parents 84e7813d76e9
children
line wrap: on
line source

--  { dg-do compile }
--  { dg-options "-gnat2020" }

procedure Delta_Aggr is
   type T1 is tagged record
      F1, F2, F3 : Integer := 0;
   end record;

   function Make (X : Integer)  return T1 is
   begin
      return (10, 20, 30);
   end Make;

   package Pkg is
      type T2 is new T1 with private;
      X, Y : constant T2;
      function Make (X : Integer) return T2;
   private
      type T2 is new T1 with
         record
            F4 : Integer := 0;
         end record;
      X : constant T2 := (0, 0, 0, 0);
      Y : constant T2 := (1, 2, 0, 0);
   end Pkg;

   package body Pkg is
      function Make (X : Integer) return T2 is
      begin
         return (X, X ** 2, X ** 3, X ** 4);
      end Make;
   end Pkg;

   use Pkg;

   Z : T2 := (Y with delta F1 => 111);

   -- a legal delta aggregate whose type is a private extension
   pragma Assert (Y = (X with delta F1 => 1, F2 => 2));
   pragma assert (Y.F2 = X.F1);

begin
   Z := (X with delta F1 => 1);

   --  The base of the delta aggregate can be overloaded, in which case
   --  the candidate interpretations for the aggregate are those of the
   --  base, to be resolved from context.

   Z := (Make (2) with delta F1 => 1);
   null;
end Delta_Aggr;