From 54f9e2781e026570ce63e3f0689bb7a7c1ab79a6 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sat, 18 Mar 2006 01:56:07 +0000
Subject: [PATCH] re PR fortran/26509 (incorrect behaviour of error-handler for
 direct access write)

2006-03-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/26509
	* libgfortran.h: Add ERROR_DIRECT_EOR.
	* runtime/error.c (translate_error): Add translation for new error.
	* io/transfer.c (write_buf): Add check for EOR when mode is
	direct access.

From-SVN: r112198
---
 libgfortran/ChangeLog       | 8 ++++++++
 libgfortran/io/transfer.c   | 5 ++++-
 libgfortran/libgfortran.h   | 1 +
 libgfortran/runtime/error.c | 4 ++++
 4 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c83a01fed84..1ea7ffa35e4 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,11 @@
+2006-03-17  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/26509
+	* libgfortran.h: Add ERROR_DIRECT_EOR.
+	* runtime/error.c (translate_error): Add translation for new error.
+	* io/transfer.c (write_buf): Add check for EOR when mode is 
+	direct access.
+
 2006-03-13  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25378
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 8c43efc26f6..4626d46b7ad 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -384,7 +384,10 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
 {
   if (dtp->u.p.current_unit->bytes_left < nbytes)
     {
-      generate_error (&dtp->common, ERROR_EOR, NULL);
+      if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
+	generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
+      else
+	generate_error (&dtp->common, ERROR_EOR, NULL);
       return FAILURE;
     }
 
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 5efc8ae2e0e..8316540416d 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -380,6 +380,7 @@ typedef enum
   ERROR_INTERNAL,
   ERROR_INTERNAL_UNIT,
   ERROR_ALLOCATION,
+  ERROR_DIRECT_EOR,
   ERROR_LAST			/* Not a real error, the last error # + 1.  */
 }
 error_codes;
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index e102449cec5..8ccb381a650 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -431,6 +431,10 @@ translate_error (int code)
       p = "Internal unit I/O error";
       break;
 
+    case ERROR_DIRECT_EOR:
+      p = "Write exceeds length of DIRECT access record";
+      break;
+
     default:
       p = "Unknown error code";
       break;