summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/g77/strlen0.f
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/g77/strlen0.f
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/g77/strlen0.f')
-rw-r--r--gcc/testsuite/gfortran.dg/g77/strlen0.f95
1 files changed, 95 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/g77/strlen0.f b/gcc/testsuite/gfortran.dg/g77/strlen0.f
new file mode 100644
index 000000000..765c8b611
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/g77/strlen0.f
@@ -0,0 +1,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