1-- { dg-do run } 2-- { dg-options "-gnatws" } 3 4procedure discr4 is 5 package Pkg is 6 type Rec_Comp (D : access Integer) is record 7 Data : Integer; 8 end record; 9-- 10 type I is interface; 11 procedure Test (Obj : I) is abstract; 12-- 13 Num : aliased Integer := 10; 14-- 15 type Root (D : access Integer) is tagged record 16 C1 : Rec_Comp (D); -- test 17 end record; 18-- 19 type DT is new Root and I with null record; 20-- 21 procedure Dummy (Obj : DT); 22 procedure Test (Obj : DT); 23 end; 24-- 25 package body Pkg is 26 procedure Dummy (Obj : DT) is 27 begin 28 raise Program_Error; 29 end; 30-- 31 procedure Test (Obj : DT) is 32 begin 33 null; 34 end; 35 end; 36-- 37 use Pkg; 38-- 39 procedure CW_Test (Obj : I'Class) is 40 begin 41 Obj.Test; 42 end; 43-- 44 Obj : DT (Num'Access); 45begin 46 CW_Test (Obj); 47end; 48