mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-25 12:41:01 +08:00
* gnat.dg/abstract1.ad[sb]: New test.
From-SVN: r136151
This commit is contained in:
parent
fb8368fdcc
commit
b3d5f74124
@ -1,3 +1,7 @@
|
||||
2008-05-29 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* gnat.dg/abstract1.ad[sb]: New test.
|
||||
|
||||
2008-05-28 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/36325
|
||||
|
31
gcc/testsuite/gnat.dg/abstract1.adb
Normal file
31
gcc/testsuite/gnat.dg/abstract1.adb
Normal file
@ -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;
|
19
gcc/testsuite/gnat.dg/abstract1.ads
Normal file
19
gcc/testsuite/gnat.dg/abstract1.ads
Normal file
@ -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;
|
Loading…
x
Reference in New Issue
Block a user