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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 271f36842c54df3201233c006402250e1b64bb17..94ae3be0914225c6d7343a9575b816b384d4f3c0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/arrayio_1.f90 b/gcc/testsuite/gfortran.dg/arrayio_1.f90
new file mode 100644 (file)
index 0000000..1941b45
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_1.f90
@@ -0,0 +1,31 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/arrayio_2.f90 b/gcc/testsuite/gfortran.dg/arrayio_2.f90
new file mode 100644 (file)
index 0000000..934f65c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_2.f90
@@ -0,0 +1,28 @@
+! { 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 

diff --git a/gcc/testsuite/gfortran.dg/arrayio_3.f90 b/gcc/testsuite/gfortran.dg/arrayio_3.f90
new file mode 100644 (file)
index 0000000..a3164ac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_3.f90
@@ -0,0 +1,16 @@
+! { 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

diff --git a/gcc/testsuite/gfortran.dg/arrayio_4.f90 b/gcc/testsuite/gfortran.dg/arrayio_4.f90
new file mode 100644 (file)
index 0000000..3b4e535
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_4.f90
@@ -0,0 +1,23 @@
+! { 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
+

diff --git a/gcc/testsuite/gfortran.dg/arrayio_5.f90 b/gcc/testsuite/gfortran.dg/arrayio_5.f90
new file mode 100644 (file)
index 0000000..edaa915
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_5.f90
@@ -0,0 +1,12 @@
+! { 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
+