* gnat.dg/abstract1.ad[sb]: New test.

From-SVN: r136151

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c28d1fc3eca72de5aa120033aae4a767fe06cb38..f52843acc82591479c34c850e62c6ec1cf45f15a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gnat.dg/abstract1.adb b/gcc/testsuite/gnat.dg/abstract1.adb
new file mode 100644 (file)
index 0000000..97508fa
--- /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 (file)
index 0000000..bad9ee6
--- /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;