]> gcc.gnu.org Git - gcc.git/blame - gcc/testsuite/g77.dg/strlen0.f
re PR rtl-optimization/9258 (ICE in compensate_edge, at reg-stack.c:2589)
[gcc.git] / gcc / testsuite / g77.dg / strlen0.f
CommitLineData
ab6e6969
GH
1C Substring range checking test program, to check behavior with respect
2C to X3J3/90.4 paragraph 5.7.1.
3C
4C Patches relax substring checking for subscript expressions in order to
5C simplify coding (elimination of length checks for strings passed as
6C parameters) and to avoid contradictory behavior of subscripted substring
7C expressions with respect to unsubscripted string expressions.
8C
9C Key part of 5.7.1 interpretation comes down to statement that in the
10C substring expression,
11C v ( e1 : e2 )
12C 1 <= e1 <= e2 <= len to be valid, yet the expression
13C v ( : )
14C is equivalent to
15C v(1:len(v))
16C
17C meaning that any statement that reads
18C str = v // 'tail'
19C (where v is a string passed as a parameter) would require coding as
20C if (len(v) .gt. 0) then
21C str = v // 'tail'
22C else
23C str = 'tail'
24C endif
25C to comply with the standard specification. Under the stricter
26C interpretation, functions strcat and strlat would be incorrect as
27C written for null values of str1 and/or str2.
28C
29C This code compiles and runs without error on
30C SunOS 4.1.3 f77 (-C option)
002b4ef1 31C SUNWspro SPARCcompiler 4.2 f77 (-C option)
ab6e6969
GH
32C (and with proposed patches, gcc-2.9.2 -fbounds-check except for test 6,
33C which is a genuine, deliberate error - comment out to make further
34C tests)
35C
36C { dg-do run }
37C { dg-options "-fbounds-check" }
38C
39C 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
45C Test 1 - (current+patched) two char substring result
46 strres=strfun(str,1,2)
47 write(*,*) 'strres is ',strres
48
49C Test 2 - (current+patched) null string result
50 strres=strfun(str,5,4)
51 write(*,*) 'strres is ',strres
52
53C Test 3 - (current+patched) null string result
54 strres=strfun(str,8,7)
55 write(*,*) 'strres is ',strres
56
57C Test 4 - (current) error; (patched) null string result
58 strres=strfun(str,9,8)
59 write(*,*) 'strres is ',strres
60
61C Test 5 - (current) error; (patched) null string result
62 strres=strfun(str,1,0)
63 write(*,*) 'strres is ',strres
64
65C Test 6 - (current+patched) error
66C strres=strfun(str,20,20)
67C write(*,*) 'strres is ',strres
68
69C Test 7 - (current+patched) str result
70 strres=strcat(str,'')
71 write(*,*) 'strres is ',strres
72
73C 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
This page took 0.518314 seconds and 5 git commands to generate.