| ! { 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 |
| |