gcc/testsuite/gfortran.dg/associate_46.f90

   1 ! { dg-do run }
   2 !
   3 ! Check the fix for PR88143, in which the associate name caused
   4 ! a segfault in resolve.c. Make sure that the associate construct
   5 ! does its job correctly, as well as compiles.
   6 !
   7 ! Contributed by Andrew Wood  <andrew@fluidgravity.co.uk>
   8 !
   9 MODULE m
  10    IMPLICIT NONE
  11    TYPE t
  12       INTEGER, DIMENSION(:), ALLOCATABLE :: i
  13    END TYPE
  14    CONTAINS
  15       SUBROUTINE s(x, idx1, idx2, k)
  16          CLASS(*), DIMENSION(:), INTENT(IN), OPTIONAL :: x
  17          INTEGER :: idx1, idx2, k
  18          SELECT TYPE ( x )
  19          CLASS IS ( t )
  20             ASSOCIATE ( j => x(idx1)%i )
  21                k = j(idx2)
  22             END ASSOCIATE
  23          END SELECT
  24       END
  25 END
  26
  27   use m
  28   class (t), allocatable :: c(:)
  29   integer :: k
  30   allocate (c(2))
  31   allocate (c(1)%i, source = [3,2,1])
  32   allocate (c(2)%i, source = [6,5,4])
  33   call s(c, 1, 3, k)
  34   if (k .ne. 1) stop 1
  35   call s(c, 2, 1, k)
  36   if (k .ne. 6) stop 2
  37 end