gcc/testsuite/gfortran.dg/pointer_array_component_1.f90

   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
  35 contains
  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
  47 end