From: David Billinghurst Date: Thu, 8 Jul 2004 23:29:43 +0000 (+0000) Subject: 7388.f: Copy from g77.dg X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1555fc861a1ecde35099efb661c48d04ef5ef5ab;p=gcc.git 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 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 76f911a45c0..642e0be4efd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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) diff --git a/gcc/testsuite/gfortran.dg/g77/7388.f b/gcc/testsuite/gfortran.dg/g77/7388.f new file mode 100644 index 00000000000..0b8374646b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/7388.f @@ -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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f new file mode 100644 index 00000000000..aa51bc05c25 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f new file mode 100644 index 00000000000..4feef755f57 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f new file mode 100644 index 00000000000..78e6f017b7e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f new file mode 100644 index 00000000000..9887704c716 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f new file mode 100644 index 00000000000..6cc9a8842d6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f new file mode 100644 index 00000000000..8e411888f2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f @@ -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 +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 diff --git a/gcc/testsuite/gfortran.dg/g77/strlen0.f b/gcc/testsuite/gfortran.dg/g77/strlen0.f new file mode 100644 index 00000000000..765c8b61190 --- /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