mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-12-02 08:13:58 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Jerry DeLisle 2005-09-14 20:25:56 +00:00 committed by Jerry DeLisle
parent 109b0ac2a8
commit c5e04c908b
6 changed files with 119 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/testsuite/ChangeLog
View File

@ -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

31
gcc/testsuite/gfortran.dg/arrayio_1.f90 Normal file
View File

@ -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

28
gcc/testsuite/gfortran.dg/arrayio_2.f90 Normal file
View File

@ -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

16
gcc/testsuite/gfortran.dg/arrayio_3.f90 Normal file
View File

@ -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

23
gcc/testsuite/gfortran.dg/arrayio_4.f90 Normal file
View File

@ -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

12
gcc/testsuite/gfortran.dg/arrayio_5.f90 Normal file
View File

@ -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