]>
Commit | Line | Data |
---|---|---|
ab6e6969 GH |
1 | C Substring range checking test program, to check behavior with respect |
2 | C to X3J3/90.4 paragraph 5.7.1. | |
3 | C | |
4 | C Patches relax substring checking for subscript expressions in order to | |
5 | C simplify coding (elimination of length checks for strings passed as | |
6 | C parameters) and to avoid contradictory behavior of subscripted substring | |
7 | C expressions with respect to unsubscripted string expressions. | |
8 | C | |
9 | C Key part of 5.7.1 interpretation comes down to statement that in the | |
10 | C substring expression, | |
11 | C v ( e1 : e2 ) | |
12 | C 1 <= e1 <= e2 <= len to be valid, yet the expression | |
13 | C v ( : ) | |
14 | C is equivalent to | |
15 | C v(1:len(v)) | |
16 | C | |
17 | C meaning that any statement that reads | |
18 | C str = v // 'tail' | |
19 | C (where v is a string passed as a parameter) would require coding as | |
20 | C if (len(v) .gt. 0) then | |
21 | C str = v // 'tail' | |
22 | C else | |
23 | C str = 'tail' | |
24 | C endif | |
25 | C to comply with the standard specification. Under the stricter | |
26 | C interpretation, functions strcat and strlat would be incorrect as | |
27 | C written for null values of str1 and/or str2. | |
28 | C | |
29 | C This code compiles and runs without error on | |
30 | C SunOS 4.1.3 f77 (-C option) | |
002b4ef1 | 31 | C SUNWspro SPARCcompiler 4.2 f77 (-C option) |
ab6e6969 GH |
32 | C (and with proposed patches, gcc-2.9.2 -fbounds-check except for test 6, |
33 | C which is a genuine, deliberate error - comment out to make further | |
34 | C tests) | |
35 | C | |
36 | C { dg-do run } | |
37 | C { dg-options "-fbounds-check" } | |
38 | C | |
39 | C G. Helffrich/Tokyo Inst. Technology Jul 24 2001 | |
40 | ||
41 | character str*8,strres*16,strfun*16,strcat*16,strlat*16 | |
42 | ||
43 | str='Hi there' | |
44 | ||
45 | C Test 1 - (current+patched) two char substring result | |
46 | strres=strfun(str,1,2) | |
47 | write(*,*) 'strres is ',strres | |
48 | ||
49 | C Test 2 - (current+patched) null string result | |
50 | strres=strfun(str,5,4) | |
51 | write(*,*) 'strres is ',strres | |
52 | ||
53 | C Test 3 - (current+patched) null string result | |
54 | strres=strfun(str,8,7) | |
55 | write(*,*) 'strres is ',strres | |
56 | ||
57 | C Test 4 - (current) error; (patched) null string result | |
58 | strres=strfun(str,9,8) | |
59 | write(*,*) 'strres is ',strres | |
60 | ||
61 | C Test 5 - (current) error; (patched) null string result | |
62 | strres=strfun(str,1,0) | |
63 | write(*,*) 'strres is ',strres | |
64 | ||
65 | C Test 6 - (current+patched) error | |
66 | C strres=strfun(str,20,20) | |
67 | C write(*,*) 'strres is ',strres | |
68 | ||
69 | C Test 7 - (current+patched) str result | |
70 | strres=strcat(str,'') | |
71 | write(*,*) 'strres is ',strres | |
72 | ||
73 | C Test 8 - (current) error; (patched) str result | |
74 | strres=strlat('',str) | |
75 | write(*,*) 'strres is ',strres | |
76 | ||
77 | end | |
78 | ||
79 | character*(*) function strfun(str,i,j) | |
80 | character str*(*) | |
81 | ||
82 | strfun = str(i:j) | |
83 | end | |
84 | ||
85 | character*(*) function strcat(str1,str2) | |
86 | character str1*(*), str2*(*) | |
87 | ||
88 | strcat = str1 // str2 | |
89 | end | |
90 | ||
91 | character*(*) function strlat(str1,str2) | |
92 | character str1*(*), str2*(*) | |
93 | ||
94 | strlat = str1(1:len(str1)) // str2(1:len(str2)) | |
95 | end |