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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c83a01fed84948c678ffd42ae6d804c49096563b..1ea7ffa35e48c892de71f29a61fb327861ad53ff 100644 (file)
--- 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 8c43efc26f6a6223e3cf086e26f146af815e25a9..4626d46b7ad2679ed591602291a7d12a9b77f8f8 100644 (file)
--- 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 5efc8ae2e0ef0bf30b4792b49ce68f35e95c58a0..8316540416d3687de443cecffb6ab386c494bf09 100644 (file)
--- 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 e102449cec512bc502ed2b6162735a732f8b13ab..8ccb381a650de022724e44b53c99ea66e2a0c120 100644 (file)
--- 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;