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

gcc/testsuite/ChangeLog

+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)

gcc/testsuite/gfortran.dg/g77/7388.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-apostrophe-out.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-colon-out.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-h-out.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-i-out.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-slash-out.f

+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

gcc/testsuite/gfortran.dg/g77/f77-edit-t-out.f

+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

gcc/testsuite/gfortran.dg/g77/strlen0.f

+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