+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.
--- /dev/null
+-- { 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;
--- /dev/null
+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;
--- /dev/null
+-- { 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;