1! { dg-do run }
2!
3! Check the fix for PR34640 comment 28.
4!
5! This involves pointer array components that point to components of arrays
6! of derived types.
7!
8  type var_tables
9     real, pointer :: rvar(:)
10  end type
11
12  type real_vars
13     real r
14     real :: index
15  end type
16
17  type(var_tables) ::  vtab_r
18  type(real_vars),  target :: x(2)
19  real, pointer :: z(:)
20  real :: y(2)
21
22  x = [real_vars (11.0, 1.0), real_vars (42.0, 2.0)]
23  vtab_r%rvar => x%r
24  if (any (abs (vtab_r%rvar - [11.0, 42.0]) > 1.0e-5)) STOP 1! Check skipping 'index; is OK.
25
26  y = vtab_r%rvar
27  if (any (abs (y - [11.0, 42.0]) > 1.0e-5)) STOP 2! Check that the component is usable in assignment.
28
29  call foobar (vtab_r, [11.0, 42.0])
30
31  vtab_r = barfoo ()
32
33  call foobar (vtab_r, [111.0, 142.0])
34
35contains
36  subroutine foobar (vtab, array)
37    type(var_tables) ::  vtab
38    real :: array (:)
39    if (any (abs (vtab%rvar - array) > 1.0e-5)) STOP 3! Check passing as a dummy.
40    if (abs (vtab%rvar(2) - array(2)) > 1.0e-5) STOP 4! Check component reference.
41  end subroutine
42
43  function barfoo () result(res)
44    type(var_tables) ::  res
45    allocate (res%rvar(2), source = [111.0, 142.0])  ! Check allocation
46  end function
47end
48