gcc/testsuite/gfortran.dg/associated_8.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR92959, where compilation of ASSOCIATED segfaulted in 's1' and 's2'.
   4 !
   5 ! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
   6 !
   7 program p
   8    character(:), pointer :: x, y => NULL()
   9    character, pointer :: u, v => NULL ()
  10    character(4), target :: tgt = "abcd"
  11
  12 ! Manifestly not associated
  13    x => tgt
  14    u => tgt(1:1)
  15    call s1 (.false., 1)
  16    call s2 (.false., 2)
  17 ! Manifestly associated
  18    y => x
  19    v => u
  20    call s1 (.true., 3)
  21    call s2 (.true., 4)
  22 ! Zero sized storage sequences must give a false.
  23    y => tgt(1:0)
  24    x => y
  25    call s1 (.false., 5)
  26 contains
  27    subroutine s1 (state, err_no)
  28       logical :: state
  29       integer :: err_no
  30       if (associated(x, y) .neqv. state) stop err_no
  31    end
  32    subroutine s2 (state, err_no)
  33       logical :: state
  34       integer :: err_no
  35       if (associated(u, v) .neqv. state) stop err_no
  36     end
  37 end