--- /dev/null
+! { 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
+