1-- { dg-do run } 2 3procedure Equal2 is 4 5 package L1 is 6 type T is private; 7 overriding function "=" (Left, Right : T) return Boolean; 8 private 9 type T is tagged record 10 I : Integer := 0; 11 end record; 12 end L1; 13 14 package L2 is 15 type T is private; 16 private 17 type T is new L1.T; 18 overriding function "=" (Left, Right : T) return Boolean; 19 end L2; 20 21 package body L1 is 22 overriding function "=" (Left, Right : T) return Boolean is 23 begin 24 return False; 25 end "="; 26 end L1; 27 28 package body L2 is 29 overriding function "=" (Left, Right : T) return Boolean is 30 begin 31 return True; 32 end "="; 33 end L2; 34 35 use type L2.T; 36 Left, Right : L2.T; 37begin 38 if Left /= Right then 39 raise Program_Error; 40 end if; 41end; 42