7388.f: Copy from g77.dg
2004-07-09 David Billinghurst (David.Billinghurst@riotinto.com) * gfortran.dg/g77/7388.f: Copy from g77.dg * gfortran.dg/g77/f77-edit-i-out.f: Likewise * gfortran.dg/g77/f77-edit-apostrophe-out.f: Likewise * gfortran.dg/g77/f77-edit-slash-out.f: Likewise * gfortran.dg/g77/f77-edit-colon-out.f: Likewise * gfortran.dg/g77/f77-edit-t-out.f: Likewise * gfortran.dg/g77/f77-edit-h-out.f: Likewise * gfortran.dg/g77/strlen0.f: Likewise From-SVN: r84325
This commit is contained in:
David Billinghurst
David Billinghurst
parent
e726a6f679
commit
1555fc861a
|
|
@ -1,3 +1,14 @@
|
|||
2004-07-09 David Billinghurst (David.Billinghurst@riotinto.com)
|
||||
|
||||
* gfortran.dg/g77/7388.f: Copy from g77.dg
|
||||
* gfortran.dg/g77/f77-edit-i-out.f: Likewise
|
||||
* gfortran.dg/g77/f77-edit-apostrophe-out.f: Likewise
|
||||
* gfortran.dg/g77/f77-edit-slash-out.f: Likewise
|
||||
* gfortran.dg/g77/f77-edit-colon-out.f: Likewise
|
||||
* gfortran.dg/g77/f77-edit-t-out.f: Likewise
|
||||
* gfortran.dg/g77/f77-edit-h-out.f: Likewise
|
||||
* gfortran.dg/g77/strlen0.f: Likewise
|
||||
|
||||
2004-07-09 David Billinghurst (David.Billinghurst@riotinto.com)
|
||||
|
||||
* lib/gfortran-dg.exp: New file (adapted from lib/g77-dg.exp)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
C { dg-do run }
|
||||
C { dg-options "-fbounds-check" }
|
||||
character*25 buff(0:10)
|
||||
character*80 line
|
||||
integer i, m1, m2
|
||||
i = 1
|
||||
m1 = 1
|
||||
m2 = 7
|
||||
buff(i) = 'tcase0a'
|
||||
write(line,*) buff(i)(m1:m2)
|
||||
if (line .ne. ' tcase0a') call abort
|
||||
end
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
C Test Fortran 77 apostrophe edit descriptor
|
||||
C (ANSI X3.9-1978 Section 13.5.1)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C { dg-output "^" }
|
||||
10 format('abcde')
|
||||
20 format('and an apostrophe -''-')
|
||||
30 format('''a leading apostrophe')
|
||||
40 format('a trailing apostrophe''')
|
||||
50 format('''and all of the above -''-''')
|
||||
|
||||
write(*,10) ! { dg-output "abcde(\n|\r\n|\r)" }
|
||||
write(*,20) ! { dg-output "and an apostrophe -'-(\n|\r\n|\r)" }
|
||||
write(*,30) ! { dg-output "'a leading apostrophe(\n|\r\n|\r)" }
|
||||
write(*,40) ! { dg-output "a trailing apostrophe'(\n|\r\n|\r)" }
|
||||
write(*,50) ! { dg-output "'and all of the above -'-'(\n|\r\n|\r)" }
|
||||
|
||||
C { dg-output "\$" }
|
||||
end
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
C Test Fortran 77 colon edit descriptor
|
||||
C (ANSI X3.9-1978 Section 13.5.5)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C { dg-output "^123(\n|\r\n|\r)45(\n|\r\n|\r)\$" }
|
||||
write(*,'((3(I1:)))') (I,I=1,5)
|
||||
end
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
C Test Fortran 77 H edit descriptor
|
||||
C (ANSI X3.9-1978 Section 13.5.2)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C { dg-output "^" }
|
||||
10 format(1H1)
|
||||
20 format(6H 6)
|
||||
write(*,10) ! { dg-output "1(\n|\r\n|\r)" }
|
||||
write(*,20) ! { dg-output " 6(\n|\r\n|\r)" }
|
||||
write(*,'(16H''apostrophe'' fun)') ! { dg-output "'apostrophe' fun(\n|\r\n|\r)" }
|
||||
C { dg-output "\$" }
|
||||
end
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
C Test Fortran 77 I edit descriptor for output
|
||||
C (ANSI X3.9-1978 Section 13.5.9.1)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C { dg-output "^" }
|
||||
|
||||
write(*,'(I1)') 1 ! { dg-output "1(\n|\r\n|\r)" }
|
||||
write(*,'(I1)') -1 ! { dg-output "\\*(\n|\r\n|\r)" }
|
||||
write(*,'(I2)') 2 ! { dg-output " 2(\n|\r\n|\r)" }
|
||||
write(*,'(I2)') -2 ! { dg-output "-2(\n|\r\n|\r)" }
|
||||
write(*,'(I3)') 3 ! { dg-output " 3(\n|\r\n|\r)" }
|
||||
write(*,'(I3)') -3 ! { dg-output " -3(\n|\r\n|\r)" }
|
||||
|
||||
write(*,'(I2.0)') 0 ! { dg-output " (\n|\r\n|\r)" }
|
||||
write(*,'(I1.1)') 4 ! { dg-output "4(\n|\r\n|\r)" }
|
||||
write(*,'(I1.1)') -4 ! { dg-output "\\*(\n|\r\n|\r)" }
|
||||
write(*,'(I2.1)') 5 ! { dg-output " 5(\n|\r\n|\r)" }
|
||||
write(*,'(I2.1)') -5 ! { dg-output "-5(\n|\r\n|\r)" }
|
||||
write(*,'(I2.2)') 6 ! { dg-output "06(\n|\r\n|\r)" }
|
||||
write(*,'(I2.2)') -6 ! { dg-output "\\*\\*(\n|\r\n|\r)" }
|
||||
write(*,'(I3.2)') 7 ! { dg-output " 07(\n|\r\n|\r)" }
|
||||
write(*,'(I3.2)') -7 ! { dg-output "-07(\n|\r\n|\r)" }
|
||||
|
||||
end
|
||||
|
|
@ -0,0 +1,9 @@
|
|||
C Test Fortran 77 colon slash descriptor
|
||||
C (ANSI X3.9-1978 Section 13.5.4)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C { dg-output "^123(\n|\r\n|\r)45(\n|\r\n|\r)\$" }
|
||||
write(*,'(3(I1)/2(I1))') (I,I=1,5)
|
||||
end
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
C Test Fortran 77 T edit descriptor
|
||||
C (ANSI X3.9-1978 Section 13.5.3.2)
|
||||
C
|
||||
C Origin: David Billinghurst <David.Billinghurst@riotinto.com>
|
||||
C
|
||||
C { dg-do run }
|
||||
C ( dg-output "^" }
|
||||
write(*,'(I4,T8,I1)') 1234,8 ! { dg-output "1234 8(\n|\r\n|\r)" }
|
||||
write(*,'(I4,TR3,I1)') 1234,8 ! { dg-output "1234 8(\n|\r\n|\r)" }
|
||||
write(*,'(I4,5X,TL2,I1)') 1234,8 ! { dg-output "1234 8(\n|\r\n|\r)" }
|
||||
C ( dg-output "\$" }
|
||||
end
|
||||
|
|
@ -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
|
||||
Loading…
Reference in New Issue