gcc/testsuite/gfortran.dg/entry_23.f

   1 ! { dg-do run }
   2 ! PR 97799 - this used to segfault intermittently.
   3 ! Test case by George Hockney.
   4       PROGRAM MAIN
   5       IMPLICIT NONE
   6
   7       character *(20) CA(4)  ! four cells of length 20
   8
   9       call CHAR_ENTRY(CA)  ! call char_sub through entry
  10
  11       write (*,*) CA       ! write result -- not needed for bug
  12       call CHAR_SUB(CA)    ! call char_sb directly -- not needed
  13       write (*,*) CA       ! write result -- not needed for bug
  14       STOP
  15       END
  16
  17
  18
  19       SUBROUTINE CHAR_SUB(CARRAY)  ! sets carray cells to 'Something'
  20       IMPLICIT NONE
  21
  22       CHARACTER*(*)       CARRAY(*)
  23
  24       integer i
  25       integer nelts
  26
  27       nelts = 4    ! same as size of array in main program
  28       write (*,*) 'CHAR_SUB'
  29       write (*,*) 'len(carray(1))', len(carray(1)) ! len is OK at 20
  30       call flush() ! since the next loop segfaults
  31       do 1 i=1, nelts
  32          CARRAY(i) = 'Something'
  33   1   continue
  34       RETURN
  35       END
  36
  37
  38       SUBROUTINE             TOP_ENTRY
  39 !
  40 ! TOP_ENTRY is never called directly.  It organizes entry points
  41 ! and sometimes saves variables for other entry points.  Its
  42 ! signature does not matter for the failure
  43 !
  44       IMPLICIT NONE
  45 !
  46 ! Declare input variables for all entry points.  Just one here
  47 !
  48       CHARACTER*(*)       CARRAY(*)
  49 !
  50 !  Entry point CHAR_ENTRY
  51 !
  52       ENTRY  CHAR_ENTRY( CARRAY)
  53       CALL   CHAR_SUB(CARRAY)
  54       RETURN
  55
  56       END SUBROUTINE TOP_ENTRY
  57