2009-07-08 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libfortran/40330
	PR libfortran/40662
	* gfortran.dg/fmt_cache_1.f: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149399 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fa2998a..7258507 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-07-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/40330
+       PR libfortran/40662
+       * gfortran.dg/fmt_cache_1.f: New test.
+       
 2009-07-08  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/40675

diff --git a/gcc/testsuite/gfortran.dg/fmt_cache_1.f b/gcc/testsuite/gfortran.dg/fmt_cache_1.f
new file mode 100644 (file)
index 0000000..3390b72
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_cache_1.f
@@ -0,0 +1,33 @@
+! { dg-do run }
+! pr40662 segfaults when specific format is invoked twice.
+! pr40330  incorrect io.
+! test case derived from pr40662, <jvdelisle@gcc.gnu.org>
+      program astap
+      character(40) teststring
+      arlxca = 0.0
+      open(10)
+      write(10,40) arlxca
+      write(10,40) arlxca
+40    format(t4,"arlxca = ",1pg13.6,t27,"arlxcc = ",g13.6,t53,
+     .            "atmpca = ",g13.6,t79,"atmpcc = ",g13.6,t105,
+     .            "backup = ",g13.6,/,
+     .         t4,"csgfac = ",g13.6,t27,"csgmax = ",g13.6,t53,
+     .            "csgmin = ",g13.6,t79,"drlxca = ",g13.6,t105,
+     .            "drlxcc = ",g13.6,/,
+     .         t4,"dtimeh = ",g13.6,t27,"dtimei = ",g13.6,t53,
+     .            "dtimel = ",g13.6,t79,"dtimeu = ",g13.6,t105,
+     .            "dtmpca = ",g13.6,/,
+     .         t4,"dtmpcc = ",g13.6,t27,"ebalna = ",g13.6,t53,
+     .            "ebalnc = ",g13.6,t79,"ebalsa = ",g13.6,t105,
+     .            "ebalsc = ",g13.6)
+      rewind 10
+      rewind 10
+      teststring = ""
+      read(10,'(a)') teststring
+      if (teststring.ne."   arlxca =   0.00000     arlxcc = ")call abort
+      teststring = ""
+      read(10,'(a)') teststring
+      if (teststring.ne."   arlxca =   0.00000     arlxcc = ")call abort
+      end program astap
+
+