PR target/84336
[official-gcc.git] / gcc / testsuite / gnat.dg / inline_tagged.adb
blobe0692884f6b2ff95dc4f7475ccff77556ad63867
1 -- { dg-do run }
2 -- { dg-options "-gnatN" }
4 with Text_IO; use Text_IO;
5 with system; use system;
6 procedure inline_tagged is
7 package Pkg is
8 type T_Inner is tagged record
9 Value : Integer;
10 end record;
11 type T_Inner_access is access all T_Inner;
12 procedure P2 (This : in T_Inner; Ptr : address);
13 pragma inline (P2);
14 type T_Outer is record
15 Inner : T_Inner_Access;
16 end record;
17 procedure P1 (This : access T_Outer);
18 end Pkg;
19 package body Pkg is
20 procedure P2 (This : in T_Inner; Ptr : address) is
21 begin
22 if this'address /= Ptr then
23 raise Program_Error;
24 end if;
25 end;
26 procedure P1 (This : access T_Outer) is
27 begin
28 P2 (This.Inner.all, This.Inner.all'Address);
29 end P1;
30 end Pkg;
31 use Pkg;
32 Thing : aliased T_Outer := (inner => new T_Inner);
33 begin
34 P1 (Thing'access);
35 end;