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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
|
C Substring range checking test program, to check behavior with respect
C to X3J3/90.4 paragraph 5.7.1.
C
C Patches relax substring checking for subscript expressions in order to
C simplify coding (elimination of length checks for strings passed as
C parameters) and to avoid contradictory behavior of subscripted substring
C expressions with respect to unsubscripted string expressions.
C
C Key part of 5.7.1 interpretation comes down to statement that in the
C substring expression,
C v ( e1 : e2 )
C 1 <= e1 <= e2 <= len to be valid, yet the expression
C v ( : )
C is equivalent to
C v(1:len(v))
C
C meaning that any statement that reads
C str = v // 'tail'
C (where v is a string passed as a parameter) would require coding as
C if (len(v) .gt. 0) then
C str = v // 'tail'
C else
C str = 'tail'
C endif
C to comply with the standard specification. Under the stricter
C interpretation, functions strcat and strlat would be incorrect as
C written for null values of str1 and/or str2.
C
C This code compiles and runs without error on
C SunOS 4.1.3 f77 (-C option)
C SUNWspro SPARCcompiler 4.2 f77 (-C option)
C (and with proposed patches, gcc-2.9.2 -fbounds-check except for test 6,
C which is a genuine, deliberate error - comment out to make further
C tests)
C
C { dg-do run }
C { dg-options "-fbounds-check" }
C
C G. Helffrich/Tokyo Inst. Technology Jul 24 2001
character str*8,strres*16,strfun*16,strcat*16,strlat*16
str='Hi there'
C Test 1 - (current+patched) two char substring result
strres=strfun(str,1,2)
write(*,*) 'strres is ',strres
C Test 2 - (current+patched) null string result
strres=strfun(str,5,4)
write(*,*) 'strres is ',strres
C Test 3 - (current+patched) null string result
strres=strfun(str,8,7)
write(*,*) 'strres is ',strres
C Test 4 - (current) error; (patched) null string result
strres=strfun(str,9,8)
write(*,*) 'strres is ',strres
C Test 5 - (current) error; (patched) null string result
strres=strfun(str,1,0)
write(*,*) 'strres is ',strres
C Test 6 - (current+patched) error
C strres=strfun(str,20,20)
C write(*,*) 'strres is ',strres
C Test 7 - (current+patched) str result
strres=strcat(str,'')
write(*,*) 'strres is ',strres
C Test 8 - (current) error; (patched) str result
strres=strlat('',str)
write(*,*) 'strres is ',strres
end
character*(*) function strfun(str,i,j)
character str*(*)
strfun = str(i:j)
end
character*(*) function strcat(str1,str2)
character str1*(*), str2*(*)
strcat = str1 // str2
end
character*(*) function strlat(str1,str2)
character str1*(*), str2*(*)
strlat = str1(1:len(str1)) // str2(1:len(str2))
end
|
