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