PR fortran/21875 Internal Unit Array I/O, NIST

2005-09-14  Jerry DeLisle  <jvdelisle@verizon.net>

	PR fortran/21875 Internal Unit Array I/O, NIST
	* gfortran.dg/arrayio_1.f90: New test.
	* gfortran.dg/arrayio_1.f90: New test.
	* gfortran.dg/arrayio_1.f90: New test.
	* gfortran.dg/arrayio_1.f90: New test.
	* gfortran.dg/arrayio_1.f90: New test.

From-SVN: r104278

gcc/testsuite/ChangeLog

+2005-09-14  Jerry DeLisle  <jvdelisle@verizon.net>
+
+	PR fortran/21875 Internal Unit Array I/O, NIST
+	* gfortran.dg/arrayio_1.f90: New test.
+	* gfortran.dg/arrayio_1.f90: New test.
+	* gfortran.dg/arrayio_1.f90: New test.
+	* gfortran.dg/arrayio_1.f90: New test.
+	* gfortran.dg/arrayio_1.f90: New test.
+
 2005-09-14  Uros Bizjak  <uros@kss-loka.si>
 
 	PR middle-end/22480

gcc/testsuite/gfortran.dg/arrayio_1.f90

+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+      program arrayio_1
+      implicit none
+      integer         :: i(6),j,k
+      character(12)  :: r(12,2) = '0123456789AB'
+ 
+! Write to and read from a whole character array
+
+      i = (/(j,j=1,6)/)
+      write(r,'(3(2x,i4/)/3(3x,i6/))') i
+      i = 0
+      read(r,'(3(2x,i4/)/3(3x,i6/))') i
+      if (any(i.ne.(/(j,j=1,6)/))) call abort()
+      do j=1,12
+	do k=1,2
+	  if ((j.gt.8.and.k.eq.1).or.(k.eq.2)) then
+	    if (r(j,k).ne.'0123456789AB') call abort()
+	  end if
+	end do
+      end do
+
+ ! Write to a portion of a character array      
+      r = '0123456789AB'
+      write(r(3:9,1),'(6(i12/))') i
+      if (r(2,1).ne.'0123456789AB') call abort()
+      do j=3,8
+        if (iachar(trim(adjustl(r(j,1))))-46.ne.j) call abort()
+      end do
+      if (r(9,1).ne.'            ') call abort()
+      end program arrayio_1

gcc/testsuite/gfortran.dg/arrayio_2.f90

+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test ckecks proper positioning and padding with trailing blanks
+! after write operations
+     program arrayio_2
+     implicit none
+     integer :: i=2
+     character(len=12), dimension(4,2)  :: r = "0123456789ab"
+     character(len=80)                  :: f
+
+     f = '("hello"/"world")'
+
+     write(r(1:4,i-1), f)
+
+     f = '("hello",t1,"HELLO",1x,"!"/"world",tl12,"WORLD")'
+
+     write(r((i-1):(i+1),i), f)
+
+     if ( r(1,1).ne.'hello       ' .or. &
+	  r(2,1).ne.'world       ' .or. &
+	  r(3,1).ne.'0123456789ab' .or. &
+	  r(4,1).ne.'0123456789ab' .or. &
+	  r(1,2).ne.'HELLO !     ' .or. &
+	  r(2,2).ne.'WORLD       ' .or. &
+	  r(3,2).ne.'0123456789ab' .or. &
+	  r(4,2).ne.'0123456789ab') call abort()
+
+     end program arrayio_2 

gcc/testsuite/gfortran.dg/arrayio_3.f90

+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test deliberately exceeds the record length in a write and
+! verifies the error message.
+      program arrayio_3
+      implicit none
+      integer        :: i(6),j,ierr
+      character(12)  :: r(4,2) = '0123456789AB'
+ 
+! Write using a format string that defines a record greater than 
+! the length of an element in the character array.
+
+      i = (/(j,j=1,6)/)
+      write(r,'(3(2x,i4/)/3(4x,i9/))', iostat=ierr) i
+      if (ierr.ne.-2) call abort()
+      end program arrayio_3

gcc/testsuite/gfortran.dg/arrayio_4.f90

+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test checks the error checking for non-contiguous character
+! arrays which are not allowed by standard.  Error 13 is
+! ERROR_ARRAY_STRIDE in libgfortran.h
+program arrayio_4
+  implicit none
+  integer        :: ierr
+  character(12)  :: r(2,3,4) = '0123456789AB'
+   
+  write(r(::2,:,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.13) call abort()
+
+  write(r(:,:,::2),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.13) call abort()
+
+  write(r(::1,::2,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.13) call abort()
+
+  write(r(::1,::1,::1),'(i5)', iostat=ierr) 1,2,3,4,5
+  if (ierr.ne.0) call abort()
+end program arrayio_4
+

gcc/testsuite/gfortran.dg/arrayio_5.f90

+! { dg-do run }
+! PR 21875 : Test formatted input/output to/from character arrays.
+! This test checks the error checking for end of file condition.
+program arrayio_5
+  implicit none
+  integer        :: i,ierr
+  character(12)  :: r(10) = '0123456789AB'
+
+  write(r,'(i12)',iostat=ierr) 1,2,3,4,5,6,7,8,9,10,11
+  if (ierr.ne.-1) call abort()
+ end program arrayio_5
+