3 ! Check the fix for PR34640 comments 1 and 3.
5 ! This involves passing and returning pointer array components that
6 ! point to components of arrays of derived types.
15 SUBROUTINE get_values(values
, switch
)
16 INTEGER, POINTER :: values(:)
18 TYPE(my_type
), POINTER :: d(:)
19 allocate (d
, source
= [my_type(1,101), my_type(2,102)])
20 if (switch
.eq
. 1) then
22 if (any (values
.ne
. [1,2])) print *, values(2)
25 if (any (values
.ne
. [101,102])) STOP 1
29 function return_values(switch
) result (values
)
30 INTEGER, POINTER :: values(:)
32 TYPE(my_type
), POINTER :: d(:)
33 allocate (d
, source
= [my_type(1,101), my_type(2,102)])
34 if (switch
.eq
. 1) then
36 if (any (values
.ne
. [1,2])) STOP 2
39 if (any (values([2,1]) .ne
. [102,101])) STOP 3
45 integer, pointer :: x(:)
47 integer, pointer :: x(:)
51 call get_values (x
, 1)
52 if (any (x
.ne
. [1,2])) STOP 4
53 call get_values (y
%x
, 2)
54 if (any (y
%x
.ne
. [101,102])) STOP 5
56 x
=> return_values (2)
57 if (any (x
.ne
. [101,102])) STOP 6
58 y
%x
=> return_values (1)
59 if (any (y
%x
.ne
. [1,2])) STOP 7