2009-04-05 Daniel Kraft <d@domob.eu>

[pf3gnuchains/gcc-fork.git] / libgfortran / io / list_read.c

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 6b22d34..1637957 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -33,6 +33,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include "io.h"
 #include <string.h>
+#include <stdlib.h>
 #include <ctype.h>
 
 
@@ -79,9 +80,8 @@ push_char (st_parameter_dt *dtp, char c)
 
   if (dtp->u.p.saved_string == NULL)
     {
-      if (dtp->u.p.scratch == NULL)
-       dtp->u.p.scratch = get_mem (SCRATCH_SIZE);
-      dtp->u.p.saved_string = dtp->u.p.scratch;
+      dtp->u.p.saved_string = get_mem (SCRATCH_SIZE);
+      // memset below should be commented out.
       memset (dtp->u.p.saved_string, 0, SCRATCH_SIZE);
       dtp->u.p.saved_length = SCRATCH_SIZE;
       dtp->u.p.saved_used = 0;
@@ -90,15 +90,15 @@ push_char (st_parameter_dt *dtp, char c)
   if (dtp->u.p.saved_used >= dtp->u.p.saved_length)
     {
       dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
-      new = get_mem (2 * dtp->u.p.saved_length);
-
-      memset (new, 0, 2 * dtp->u.p.saved_length);
-
-      memcpy (new, dtp->u.p.saved_string, dtp->u.p.saved_used);
-      if (dtp->u.p.saved_string != dtp->u.p.scratch)
-       free_mem (dtp->u.p.saved_string);
-
+      new = realloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
+      if (new == NULL)
+       generate_error (&dtp->common, LIBERROR_OS, NULL);
       dtp->u.p.saved_string = new;
+      
+      // Also this should not be necessary.
+      memset (new + dtp->u.p.saved_used, 0, 
+             dtp->u.p.saved_length - dtp->u.p.saved_used);
+
     }
 
   dtp->u.p.saved_string[dtp->u.p.saved_used++] = c;
@@ -113,8 +113,7 @@ free_saved (st_parameter_dt *dtp)
   if (dtp->u.p.saved_string == NULL)
     return;
 
-  if (dtp->u.p.saved_string != dtp->u.p.scratch)
-    free_mem (dtp->u.p.saved_string);
+  free_mem (dtp->u.p.saved_string);
 
   dtp->u.p.saved_string = NULL;
   dtp->u.p.saved_used = 0;
@@ -140,9 +139,10 @@ free_line (st_parameter_dt *dtp)
 static char
 next_char (st_parameter_dt *dtp)
 {
-  size_t length;
+  ssize_t length;
   gfc_offset record;
   char c;
+  int cc;
 
   if (dtp->u.p.last_char != '\0')
     {
@@ -194,7 +194,7 @@ next_char (st_parameter_dt *dtp)
            }
 
          record *= dtp->u.p.current_unit->recl;
-         if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
+         if (sseek (dtp->u.p.current_unit->s, record, SEEK_SET) < 0)
            longjmp (*dtp->u.p.eof_jump, 1);
 
          dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
@@ -204,19 +204,15 @@ next_char (st_parameter_dt *dtp)
 
   /* Get the next character and handle end-of-record conditions.  */
 
-  length = 1;
-
-  if (sread (dtp->u.p.current_unit->s, &c, &length) != 0)
-    {
-       generate_error (&dtp->common, LIBERROR_OS, NULL);
-       return '\0';
-    }
-  
-  if (is_stream_io (dtp) && length == 1)
-    dtp->u.p.current_unit->strm_pos++;
-
   if (is_internal_unit (dtp))
     {
+      length = sread (dtp->u.p.current_unit->s, &c, 1);
+      if (length < 0)
+       {
+         generate_error (&dtp->common, LIBERROR_OS, NULL);
+         return '\0';
+       }
+  
       if (is_array_io (dtp))
        {
          /* Check whether we hit EOF.  */ 
@@ -240,13 +236,20 @@ next_char (st_parameter_dt *dtp)
     }
   else
     {
-      if (length == 0)
+      cc = fbuf_getc (dtp->u.p.current_unit);
+
+      if (cc == EOF)
        {
          if (dtp->u.p.current_unit->endfile == AT_ENDFILE)
            longjmp (*dtp->u.p.eof_jump, 1);
          dtp->u.p.current_unit->endfile = AT_ENDFILE;
          c = '\n';
        }
+      else
+       c = (char) cc;
+      if (is_stream_io (dtp) && cc != EOF)
+       dtp->u.p.current_unit->strm_pos++;
+
     }
 done:
   dtp->u.p.at_eol = (c == '\n' || c == '\r');
@@ -1698,7 +1701,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
       dtp->u.p.input_complete = 0;
       dtp->u.p.repeat_count = 1;
       dtp->u.p.at_eol = 0;
-
+      
       c = eat_spaces (dtp);
       if (is_separator (c))
        {
@@ -1726,6 +1729,9 @@ list_formatted_read_scalar (st_parameter_dt *dtp, volatile bt type, void *p,
            return;
          goto set_value;
        }
+       
+      if (dtp->u.p.input_complete)
+       goto cleanup;
 
       if (dtp->u.p.input_complete)
        goto cleanup;
@@ -1853,6 +1859,8 @@ finish_list_read (st_parameter_dt *dtp)
 
   free_saved (dtp);
 
+  fbuf_flush (dtp->u.p.current_unit, dtp->u.p.mode);
+
   if (dtp->u.p.at_eol)
     {
       dtp->u.p.at_eol = 0;
@@ -2261,8 +2269,8 @@ nml_query (st_parameter_dt *dtp, char c)
 
       /* Flush the stream to force immediate output.  */
 
-      fbuf_flush (dtp->u.p.current_unit, 1);
-      flush (dtp->u.p.current_unit->s);
+      fbuf_flush (dtp->u.p.current_unit, WRITING);
+      sflush (dtp->u.p.current_unit->s);
       unlock_unit (dtp->u.p.current_unit);
     }
 
@@ -2903,7 +2911,7 @@ find_nml_name:
          st_printf ("%s\n", nml_err_msg);
          if (u != NULL)
            {
-             flush (u->s);
+             sflush (u->s);
              unlock_unit (u);
            }
         }