From 3c3beb1a8137460bc485f9fbe3be8b21ee7f91a2 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 12 Nov 2020 12:49:53 +0100 Subject: [PATCH] Add test case for PR 97799. gcc/testsuite/ChangeLog: * gfortran.dg/entry_23.f: New test. --- gcc/testsuite/gfortran.dg/entry_23.f | 57 ++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/entry_23.f 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 + -- 2.7.4