From: Arnaud Charlet Date: Thu, 29 May 2008 08:57:36 +0000 (+0000) Subject: * gnat.dg/abstract1.ad[sb]: New test. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b3d5f74124228eafaf92a3b63a18cd9265f2cf25;p=gcc.git * gnat.dg/abstract1.ad[sb]: New test. From-SVN: r136151 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c28d1fc3eca..f52843acc82 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2008-05-29 Arnaud Charlet + + * gnat.dg/abstract1.ad[sb]: New test. + 2008-05-28 Janus Weil PR fortran/36325 diff --git a/gcc/testsuite/gnat.dg/abstract1.adb b/gcc/testsuite/gnat.dg/abstract1.adb new file mode 100644 index 00000000000..97508fac2b8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/abstract1.adb @@ -0,0 +1,31 @@ +-- { dg-do compile } +with Ada.Tags.Generic_Dispatching_Constructor; use Ada.Tags; +package body abstract1 is + + function New_T (Stream : not null access Root_Stream_Type'Class) + return T'Class is + function Construct is + new Generic_Dispatching_Constructor (T, Root_Stream_Type'Class, Input); + E : constant String := String'Input (Stream); + I : constant Tag := Internal_Tag (E); + + begin + return Construct (I, Stream); + end New_T; + + function Input (Stream : not null access Root_Stream_Type'Class) + return IT is + begin + return O : IT do + Integer'Read (Stream, O.I); + end return; + end Input; + + function Input (Stream : not null access Root_Stream_Type'Class) + return FT is + begin + return O : FT do + Float'Read (Stream, O.F); + end return; + end Input; +end abstract1; diff --git a/gcc/testsuite/gnat.dg/abstract1.ads b/gcc/testsuite/gnat.dg/abstract1.ads new file mode 100644 index 00000000000..bad9ee69874 --- /dev/null +++ b/gcc/testsuite/gnat.dg/abstract1.ads @@ -0,0 +1,19 @@ +with Ada.Streams; use Ada.Streams; +package abstract1 is + type T is abstract tagged limited null record; + function Input (Stream : not null access Root_Stream_Type'Class) return T + is abstract; + + function New_T (Stream : not null access Root_Stream_Type'Class) + return T'Class; + + type IT is limited new T with record + I : Integer; + end record; + function Input (Stream : not null access Root_Stream_Type'Class) return IT; + + type FT is limited new T with record + F : Float; + end record; + function Input (Stream : not null access Root_Stream_Type'Class) return FT; +end abstract1;