re PR fortran/34594 (On error and END, no jump to ERR=<label>)

2007-12-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34594
	* runtime/error.c: If there was a previous error, don't
	mask it with another error mesage, EOF or EOR condition.

2007-12-27  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34594
	* gfortran.dg/direct_io_8.f90:  New test case.

From-SVN: r131199

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6f3fc359885e9ce7435fd865e776349dbb03f6f8..dd87ad99b7e6337b454378ba3268b877ced7f0ac 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34594
+       * gfortran.dg/direct_io_8.f90:  New test case.
+
 2007-12-27  Jakub Jelinek  <jakub@redhat.com>
 
        PR target/34281

diff --git a/gcc/testsuite/gfortran.dg/direct_io_8.f90 b/gcc/testsuite/gfortran.dg/direct_io_8.f90
new file mode 100644 (file)
index 0000000..5e384a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_8.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+! PR 34594 - this used to give runtime errors due to an
+! end condition.
+program main
+  implicit none
+  integer :: iou, i, ir, TEMP_CHANGES
+  i=44
+  ir = -42
+
+  open(11,file="foo.dat")
+  ! Try a direct access read on a formatted sequential rile
+  READ (11, REC = I, ERR = 99) TEMP_CHANGES
+  call abort
+99 continue
+  ! Variant 2: ir is ok, but does not jump to 99
+  READ (11, REC = I, IOSTAT = IR, ERR = 98) TEMP_CHANGES
+  call abort
+
+98 continue
+  if(ir == 0) then
+     call abort
+  end if
+  close(11,status="delete")
+end program main
+

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 495d536680c43157b8df74d3c63029d67807495b..f7d260dd7c6027b41e83c8093a71a870c3a7e70c 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34594
+       * runtime/error.c: If there was a previous error, don't
+       mask it with another error mesage, EOF or EOR condition.
+
 2007-12-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/34560

diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 279e26518ea611da26a280edc86ad172c44f0c3f..f0a4ff2291dc6476ba8f977de6bf75624de6f7ea 100644 (file)
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -410,6 +410,13 @@ translate_error (int code)
 void
 generate_error (st_parameter_common *cmp, int family, const char *message)
 {
+
+  /* If there was a previous error, don't mask it with another
+     error message, EOF or EOR condition.  */
+
+  if ((cmp->flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_ERROR)
+    return;
+
   /* Set the error status.  */
   if ((cmp->flags & IOPARM_HAS_IOSTAT))
     *cmp->iostat = (family == LIBERROR_OS) ? errno : family;