From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Thu, 27 Dec 2007 12:33:52 +0000 (+0000)
Subject: re PR fortran/34594 (On error and END, no jump to ERR=<label>)
X-Git-Tag: releases/gcc-4.3.0~806
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ceac3d59adc0d45bbb067ac86c493930cb1839ee;p=thirdparty%2Fgcc.git

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 6f3fc359885e..dd87ad99b7e6 100644
--- 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
index 000000000000..5e384a1cfa32
--- /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 495d536680c4..f7d260dd7c60 100644
--- 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 279e26518ea6..f0a4ff2291dc 100644
--- 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;