mirrored from git://gcc.gnu.org/git/gcc.git
-
Notifications
You must be signed in to change notification settings - Fork 4.4k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
gcc/testsuite/ChangeLog: * gfortran.dg/entry_23.f: New test. (cherry picked from commit 3c3beb1)
- Loading branch information
Thomas Koenig
committed
Nov 12, 2020
1 parent
d183dd5
commit 910250c
Showing
1 changed file
with
57 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,57 @@ | ||
! { 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 | ||
|