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.

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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c83a01f..1ea7ffa 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 8c43efc..4626d46 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 5efc8ae..8316540 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 e102449..8ccb381 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;