gcc/testsuite/gfortran.dg/associated_target_5.f03

   1 ! { dg-do run }
   2 ! Test the fix for PR57522, in which the associate name had a
   3 ! 'span' of an INTEGER rather than that of 'mytype'.
   4 !
   5 ! Contributed by A Briolat  <alan.briolat@gmail.com>
   6 !
   7 program test_associate
   8   type mytype
   9     integer :: a = 1, b = 2
  10   end type
  11   type(mytype) :: t(4), u(2,2)
  12   integer :: c(4)
  13   t%a = [0, 1, 2, 3]
  14   t%b = [4, 5, 6, 7]
  15   associate (a => t%a)
  16 ! Test 'a' is OK on lhs and/or rhs of assignments
  17     c = a - 1
  18     if (any (c .ne. [-1,0,1,2])) call abort
  19     a = a + 1
  20     if (any (a .ne. [1,2,3,4])) call abort
  21     a = t%b
  22     if (any (a .ne. t%b)) call abort
  23 ! Test 'a' is OK as an actual argument
  24     c = foo(a)
  25     if (any (c .ne. t%b + 10)) call abort
  26   end associate
  27 ! Make sure that the fix works for multi-dimensional arrays...
  28   associate (a => u%a)
  29     if (any (a .ne. reshape ([1,1,1,1],[2,2]))) call abort
  30   end associate
  31 ! ...and sections
  32   associate (a => t(2:3)%b)
  33     if (any (a .ne. [5,6])) call abort
  34   end associate
  35 contains
  36   function foo(arg) result(res)
  37     integer :: arg(4), res(4)
  38     res = arg + 10
  39   end function
  40 end program