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!
8MODULE test
9  IMPLICIT NONE
10  TYPE :: my_type
11    INTEGER :: value
12    integer :: tag
13  END TYPE
14CONTAINS
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
25      if (any (values .ne. [101,102])) STOP 1
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
36      if (any (values .ne. [1,2])) STOP 2
37    else
38      values => d(:)%tag
39      if (any (values([2,1]) .ne. [102,101])) STOP 3
40    end if
41  END function
42END 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)
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
55
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
60end
61