|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Check the fix for PR34640 comments 1 and 3.
|
|
|
4 !
|
|
|
5 ! This involves passing and returning pointer array components that
|
|
|
6 ! point to components of arrays of derived types.
|
|
|
7 !
|
|
|
8 MODULE test
|
|
|
9 IMPLICIT NONE
|
|
|
10 TYPE :: my_type
|
|
|
11 INTEGER :: value
|
|
|
12 integer :: tag
|
|
|
13 END TYPE
|
|
|
14 CONTAINS
|
|
|
15 SUBROUTINE get_values(values, switch)
|
|
|
16 INTEGER, POINTER :: values(:)
|
|
|
17 integer :: switch
|
|
|
18 TYPE(my_type), POINTER :: d(:)
|
|
|
19 allocate (d, source = [my_type(1,101), my_type(2,102)])
|
|
|
20 if (switch .eq. 1) then
|
|
|
21 values => d(:)%value
|
|
|
22 if (any (values .ne. [1,2])) print *, values(2)
|
|
|
23 else
|
|
|
24 values => d(:)%tag
|
|
131
|
25 if (any (values .ne. [101,102])) STOP 1
|
|
111
|
26 end if
|
|
|
27 END SUBROUTINE
|
|
|
28
|
|
|
29 function return_values(switch) result (values)
|
|
|
30 INTEGER, POINTER :: values(:)
|
|
|
31 integer :: switch
|
|
|
32 TYPE(my_type), POINTER :: d(:)
|
|
|
33 allocate (d, source = [my_type(1,101), my_type(2,102)])
|
|
|
34 if (switch .eq. 1) then
|
|
|
35 values => d(:)%value
|
|
131
|
36 if (any (values .ne. [1,2])) STOP 2
|
|
111
|
37 else
|
|
|
38 values => d(:)%tag
|
|
131
|
39 if (any (values([2,1]) .ne. [102,101])) STOP 3
|
|
111
|
40 end if
|
|
|
41 END function
|
|
|
42 END MODULE
|
|
|
43
|
|
|
44 use test
|
|
|
45 integer, pointer :: x(:)
|
|
|
46 type :: your_type
|
|
|
47 integer, pointer :: x(:)
|
|
|
48 end type
|
|
|
49 type(your_type) :: y
|
|
|
50
|
|
|
51 call get_values (x, 1)
|
|
131
|
52 if (any (x .ne. [1,2])) STOP 4
|
|
111
|
53 call get_values (y%x, 2)
|
|
131
|
54 if (any (y%x .ne. [101,102])) STOP 5
|
|
111
|
55
|
|
|
56 x => return_values (2)
|
|
131
|
57 if (any (x .ne. [101,102])) STOP 6
|
|
111
|
58 y%x => return_values (1)
|
|
131
|
59 if (any (y%x .ne. [1,2])) STOP 7
|
|
111
|
60 end
|
