From: charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 6 Aug 2008 09:16:07 +0000 (+0000)
Subject: New tests.
X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=2d2eb41552ed7d573c6902f5cfb790562e1caee1

New tests.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138782 138bc75d-0d04-0410-961f-82ee72b054a4
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 92c95cc547b..7a1b82cd640 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-08-06  Arnaud Charlet  <charlet@adacore.com>
+
+	* gnat.dg/iface_test.ad[s,b]: New test.
+	* gnat.dg/test_call.adb: New test.
+
 2008-08-06  Andreas Krebbel  <krebbel1@de.ibm.com>
 
  	* gcc.c-torture/compile/20080806-1.c: New testcase.
diff --git a/gcc/testsuite/gnat.dg/iface_test.adb b/gcc/testsuite/gnat.dg/iface_test.adb
new file mode 100644
index 00000000000..b47814f85d5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iface_test.adb
@@ -0,0 +1,28 @@
+--  { dg-do compile }
+package body Iface_Test is
+   protected SQLite_Safe is
+      function Prepare_Select
+        (DB   : DT_1;
+         Iter : Standard.Iface_Test.Iface_2'Class)
+      return Standard.Iface_Test.Iface_2'Class;
+   end;
+
+   overriding procedure Prepare_Select
+     (DB   : DT_1;
+      Iter : in out Standard.Iface_Test.Iface_2'Class)
+   is
+   begin
+      Iter := SQLite_Safe.Prepare_Select (DB, Iter);  --  test
+   end;
+
+   protected body SQLite_Safe is
+      function Prepare_Select
+        (DB   : DT_1;
+         Iter : Standard.Iface_Test.Iface_2'Class)
+        return Standard.Iface_Test.Iface_2'Class
+      is
+      begin
+         return Iter;
+      end;
+   end;
+end;
diff --git a/gcc/testsuite/gnat.dg/iface_test.ads b/gcc/testsuite/gnat.dg/iface_test.ads
new file mode 100644
index 00000000000..d093c28226f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/iface_test.ads
@@ -0,0 +1,18 @@
+package Iface_Test is
+   type Iface_1 is interface;
+   type Iface_2 is interface;
+   
+   procedure Prepare_Select
+     (DB   : Iface_1;
+      Iter : in out Iface_2'Class) is abstract; 
+        
+   type DT_1 is new Iface_1 with null record;
+        
+   type Iterator is new Iface_2 with record
+      More : Boolean;
+   end record;
+
+   overriding procedure Prepare_Select
+     (DB   : DT_1;
+      Iter : in out Standard.Iface_Test.Iface_2'Class);
+end;
diff --git a/gcc/testsuite/gnat.dg/test_call.adb b/gcc/testsuite/gnat.dg/test_call.adb
new file mode 100644
index 00000000000..f1ea10f73b4
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/test_call.adb
@@ -0,0 +1,24 @@
+--  { dg-do compile }
+
+with System; with Ada.Unchecked_Conversion;
+procedure Test_Call is
+   type F_ACC is access function (Str : String) return String;
+        
+   function Do_Something (V : F_Acc) return System.Address is
+   begin
+      return System.Null_Address;
+   end Do_Something;
+
+   function BUG_1 (This : access Integer) return F_Acc is
+   begin
+      return null;
+   end BUG_1;
+
+   function Unch is new Ada.Unchecked_Conversion (F_Acc, System.Address);
+   Func : System.Address := Unch (BUG_1 (null));
+
+   V : System.Address := Do_Something (BUG_1 (null));
+
+begin
+   null;
+end Test_Call;