]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/65596 (NAMELIST bug with f2003: reads too far)
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 28 Mar 2015 14:22:53 +0000 (14:22 +0000)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 28 Mar 2015 14:22:53 +0000 (14:22 +0000)
2015-03-28 Jerry DeLisle  <jvdelisle@gcc.gnu.org>

PR libgfortran/65596
* gfortran.dg/namelist_86.f90: New test.

From-SVN: r221755

gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/namelist_86.f90 [new file with mode: 0644]

index c712a958ef04ae4419eda0f0b06ffe9f7ad44e9a..3f97d2dcb449c06a984ff350476244f21610c317 100644 (file)
@@ -1,3 +1,8 @@
+2015-03-28 Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/65596
+       * gfortran.dg/namelist_86.f90: New test.
+
 2015-03-27  Vladimir Makarov  <vmakarov@redhat.com>
 
        Backport from mainline
diff --git a/gcc/testsuite/gfortran.dg/namelist_86.f90 b/gcc/testsuite/gfortran.dg/namelist_86.f90
new file mode 100644 (file)
index 0000000..88d90d2
--- /dev/null
@@ -0,0 +1,49 @@
+! { dg-do run }
+! { dg-options "-std=f2003 -fall-intrinsics" }
+! PR65596 Namelist reads too far.
+integer ,parameter :: CL=80
+integer ,parameter :: AL=4
+
+character(CL) :: mode
+character(CL) :: cats(AL)
+character(CL) :: dogs(AL)
+character(CL) :: rslt(AL)
+integer       :: ierr, k
+
+namelist / theList / cats, dogs, mode
+
+open(27,status="scratch")
+
+write(27,'(A)')  "&theList"
+write(27,'(A)')  " mode      = 'on'"
+write(27,'(A)')  " dogs      = 'Rover',"
+write(27,'(A)')  "             'Spot'"
+write(27,'(A)')  " cats      = 'Fluffy',"
+write(27,'(A)')  "             'Hairball'"
+write(27,'(A)') "/"
+rewind(27)
+
+mode    = 'off'
+cats(:) = '________'
+dogs(:) = '________'
+
+read (27, nml=theList, iostat=ierr)
+
+if (ierr .ne. 0) call abort
+
+rslt = ['Rover   ','Spot    ','________','________']
+if (any(dogs.ne.rslt)) call abort
+
+rslt = ['Fluffy  ','Hairball','________','________']
+if (any(cats.ne.rslt)) call abort
+
+close(27)
+
+contains
+
+subroutine abort()
+  close(27)
+  stop 500
+end subroutine abort
+
+end