view gcc/testsuite/gnat.dg/inline_tagged.adb @ 143:76e1cf5455ef

add cbc_gc test
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 23 Dec 2018 19:24:05 +0900
parents 04ced10e8804
children
line wrap: on
line source

-- { dg-do run }
-- { dg-options "-gnatN" }

with Text_IO; use Text_IO;
with system; use system; 
procedure inline_tagged is
   package Pkg is
      type T_Inner is tagged record
         Value : Integer;
      end record; 
      type T_Inner_access is access all T_Inner;
      procedure P2 (This : in T_Inner; Ptr : address);
      pragma inline (P2);
      type T_Outer is record
           Inner : T_Inner_Access;
      end record; 
      procedure P1 (This : access T_Outer);
   end Pkg;
   package body Pkg is
      procedure P2 (This : in T_Inner; Ptr : address) is
      begin   
         if this'address /= Ptr then
            raise Program_Error;
         end if;
      end;    
      procedure P1 (This : access T_Outer) is
      begin
         P2 (This.Inner.all, This.Inner.all'Address);
      end P1; 
   end Pkg;
   use Pkg;
   Thing : aliased T_Outer := (inner => new T_Inner);
begin   
   P1 (Thing'access);
end;