diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2020-11-12 12:49:53 +0100 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2020-11-12 12:51:36 +0100 |
commit | 3c3beb1a8137460bc485f9fbe3be8b21ee7f91a2 (patch) | |
tree | 7cc3956519b8054138bfb17dc9eb9232e071bb9c /gcc | |
parent | 512c6ba04102295fccc62a173ee0086ca733c920 (diff) | |
download | gcc-3c3beb1a8137460bc485f9fbe3be8b21ee7f91a2.zip gcc-3c3beb1a8137460bc485f9fbe3be8b21ee7f91a2.tar.gz gcc-3c3beb1a8137460bc485f9fbe3be8b21ee7f91a2.tar.bz2 |
Add test case for PR 97799.
gcc/testsuite/ChangeLog:
* gfortran.dg/entry_23.f: New test.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/testsuite/gfortran.dg/entry_23.f | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/entry_23.f b/gcc/testsuite/gfortran.dg/entry_23.f new file mode 100644 index 0000000..ebc5f66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/entry_23.f @@ -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 + |