3 ! Test the fix for PR57116 as part of the overall fix for PR34640.
5 ! Contributed by Reinhold Bader <Bader@lrz.de>
14 subroutine extract(this
, v
, ic
)
15 class(*), target
:: this(:)
24 end subroutine extract
29 class(*), allocatable
, target
:: o(:)
32 allocate(o(3), source
=[1.0, 2.0, 3.0])
34 if (size(v
) == 2 .and
. all (v
== [2.0, 3.0])) then
40 allocate(o(3), source
=[foo(1.0, 1), foo(4.0, 4), foo(5.0, 5)])
42 if (size(v
) == 2 .and
. all (v
== [4.0, 5.0])) then
48 ! The rest tests the case in comment 2 <janus@gcc.gnu.org>
51 if (any (v
/= [1.0, 2.0])) call abort
52 call extract1 (v
, 2) ! Call to deallocate pointer.
55 subroutine extract1(v
, flag
)
60 class(foo
), pointer, save :: this(:)
65 allocate (this(2), source
= [foo (1.0, "one "), foo (2.0, "two ")])
75 end program prog_rtti_ptr