blob: ebc5f6681aa279a5032bacd7d900dc928e132c7e [file] [log] [blame]
! { dg-do run }
! PR 97799 - this used to segfault intermittently.
! Test case by George Hockney.
PROGRAM MAIN
IMPLICIT NONE
character *(20) CA(4) ! four cells of length 20
call CHAR_ENTRY(CA) ! call char_sub through entry
write (*,*) CA ! write result -- not needed for bug
call CHAR_SUB(CA) ! call char_sb directly -- not needed
write (*,*) CA ! write result -- not needed for bug
STOP
END
SUBROUTINE CHAR_SUB(CARRAY) ! sets carray cells to 'Something'
IMPLICIT NONE
CHARACTER*(*) CARRAY(*)
integer i
integer nelts
nelts = 4 ! same as size of array in main program
write (*,*) 'CHAR_SUB'
write (*,*) 'len(carray(1))', len(carray(1)) ! len is OK at 20
call flush() ! since the next loop segfaults
do 1 i=1, nelts
CARRAY(i) = 'Something'
1 continue
RETURN
END
SUBROUTINE TOP_ENTRY
!
! TOP_ENTRY is never called directly. It organizes entry points
! and sometimes saves variables for other entry points. Its
! signature does not matter for the failure
!
IMPLICIT NONE
!
! Declare input variables for all entry points. Just one here
!
CHARACTER*(*) CARRAY(*)
!
! Entry point CHAR_ENTRY
!
ENTRY CHAR_ENTRY( CARRAY)
CALL CHAR_SUB(CARRAY)
RETURN
END SUBROUTINE TOP_ENTRY