From 8ad4c89538959cda77bcf90164c79b4b74f9f602 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Thu, 22 Dec 2005 02:32:29 +0000
Subject: [PATCH] re PR libfortran/25307 (internal read with end=label aborts)

2005-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/25307
	* io/list_read.c (next_char): Handle end-of-file conditions for
	internal units and add support for internal character array units.

From-SVN: r108938
---
 libgfortran/ChangeLog      |  6 ++++
 libgfortran/io/list_read.c | 65 ++++++++++++++++++++++++++++++--------
 2 files changed, 58 insertions(+), 13 deletions(-)

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 1d57faa270e..02d38d95331 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+2005-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/25307
+	* io/list_read.c (next_char): Handle end-of-file conditions for
+	internal units and add support for internal character array units.
+
 2005-12-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/25463
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 3988e3f00d8..9784403a39c 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -121,6 +121,7 @@ static char
 next_char (st_parameter_dt *dtp)
 {
   int length;
+  gfc_offset record;
   char c, *p;
 
   if (dtp->u.p.last_char != '\0')
@@ -133,26 +134,64 @@ next_char (st_parameter_dt *dtp)
 
   length = 1;
 
-  p = salloc_r (dtp->u.p.current_unit->s, &length);
-  if (p == NULL)
+  /* Handle the end-of-record condition for internal array unit */
+  if (is_array_io(dtp) && dtp->u.p.current_unit->bytes_left == 0)
     {
-      generate_error (&dtp->common, ERROR_OS, NULL);
-      return '\0';
+      c = '\n';
+      record = next_array_record (dtp, dtp->u.p.current_unit->ls);
+
+      /* Check for "end-of-file" condition */      
+      if (record == 0)
+	longjmp (*dtp->u.p.eof_jump, 1);
+
+      record *= dtp->u.p.current_unit->recl;
+      
+      if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
+	longjmp (*dtp->u.p.eof_jump, 1);
+
+      dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+      goto done;
     }
 
-  if (length == 0)
+  /* Get the next character and handle end-of-record conditions */
+  p = salloc_r (dtp->u.p.current_unit->s, &length);
+
+  if (is_internal_unit(dtp))
     {
-      /* For internal files return a newline instead of signalling EOF.  */
-      /* ??? This isn't quite right, but we don't handle internal files
-	 with multiple records.  */
-      if (is_internal_unit (dtp))
-	c = '\n';
+      if (is_array_io(dtp))
+	{
+	  /* End of record is handled in the next pass through, above.  The
+	     check for NULL here is cautionary. */
+	  if (p == NULL)
+	    {
+	      generate_error (&dtp->common, ERROR_OS, NULL);
+	      return '\0';
+	    }
+
+	  dtp->u.p.current_unit->bytes_left--;
+	  c = *p;
+	}
       else
-	longjmp (*dtp->u.p.eof_jump, 1);
+	{
+	  if (p == NULL)
+	    longjmp (*dtp->u.p.eof_jump, 1);
+	  if (length == 0)
+	    c = '\n';
+	  else
+	    c = *p;
+	}
     }
   else
-    c = *p;
-
+    {
+      if (p == NULL)
+	{
+	  generate_error (&dtp->common, ERROR_OS, NULL);
+	  return '\0';
+	}
+      if (length == 0)
+	longjmp (*dtp->u.p.eof_jump, 1);
+      c = *p;
+    }
 done:
   dtp->u.p.at_eol = (c == '\n' || c == '\r');
   return c;