From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sat, 28 Mar 2015 14:25:29 +0000 (+0000)
Subject: re PR fortran/65596 (NAMELIST bug with f2003: reads too far)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=9ddb384381f34ef13cf665266a86687f63a9f29d;p=gcc.git

re PR fortran/65596 (NAMELIST bug with f2003: reads too far)

2015-03-28 Jerry DeLisle  <jvdelisle@gcc.gnu.org>

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

From-SVN: r221756
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f8d2d5a5eaa..8f489ee3354 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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-28  Andre Vehreschild  <vehre@gmx.de>
 
 	* gfortran.dg/unlimited_polymorphic_24.f03: Fixing copyright
diff --git a/gcc/testsuite/gfortran.dg/namelist_86.f90 b/gcc/testsuite/gfortran.dg/namelist_86.f90
new file mode 100644
index 00000000000..88d90d2cf9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/namelist_86.f90
@@ -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