blob: ebc5f6681aa279a5032bacd7d900dc928e132c7e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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
|
