gcc/testsuite/gfortran.dg/associate_43.f90

   1 ! { dg-do run }
   2 !
   3 ! Check that PR83146 remains fixed.
   4 !
   5 ! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
   6 !
   7   type foo
   8     integer n
   9   end type
  10   type bar
  11     type(foo) array(2)
  12   end type
  13
  14   type(bar) b
  15   integer :: m=0
  16
  17   b%array(1)%n = 42
  18   b%array(2)%n = 43
  19
  20   call assoc(1)
  21   m = 1
  22   call assoc(2)
  23 contains
  24   subroutine assoc (n)
  25     integer :: n
  26     associate (n_array => b%array%n)
  27       select case (n_array(n))
  28         case (42)
  29           if (m .ne. 0) stop 1
  30       case default
  31           if (m .eq. 0) stop 2
  32       end select
  33     end associate
  34   end subroutine assoc
  35 end