Part 1 of PR 25561.

2008-05-15  Janne Blomqvist  <jb@gcc.gnu.org>

	PR libfortran/25561
	* Makefile.am: Add fbuf.c to gfor_io_src.
	* Makefile.in: Regenerate.
	* io/io.h (read_block): Remove.
	(struct stream): Remove alloc_r_at function pointer.
	(salloc_r): Remove.
	(salloc_r_at): Remove.
	(salloc_w_at): Remove.
	(salloc_w): Remove offset argument.
	(struct fbuf): New struct for format buffer.
	(struct gfc_unit): Add fbuf.
	(read_block_form): New prototype.
	(fbuf_init): Likewise.
	(fbuf_destroy): Likewise.
	(fbuf_reset): Likewise.
	(fbuf_alloc): Likewise.
	(fbuf_flush): Likewise.
	(fbuf_seek): Likewise.
	* io/file_pos.c (formatted_backspace): Change to use sread.
	(unformatted_backspace): Likewise.
	(st_backspace): Flush format buffer.
	(st_rewind): Likewise.
	* io/list_read.c (next_char): Likewise.
	(nml_query): Tidying, flush format buffer.
	* io/open.c (new_unit): Init format buffer.
	* io/read.c (read_l): Change to use read_block_form.
	(read_a): Likewise.
	(read_decimal): Likewise.
	(read_radix): Likewise.
	(read_f): Likewise.
	(read_x): Empty reads also for stream I/O.
	* io/transfer.c (read_sf): Change to use sread.
	(read_block): Rename to read_block_form, change prototype, use sread.
	(read_block_direct): Don't seek stream files.
	(write_block): Change to use fbuf if external file, don't seek stream
	files.
	(write_buf): Don't seek stream files.
	(formatted_transfer_scalar): Use fbuf for external files.
	(us_read): Change to use sread.
	(pre_position): Do nothing for stream I/O.
	(data_transfer_init): Flush fbuf when switching from write to read, if
	POS is specified, seek stream file to correct offset.
	(skip_record): Change to use sread.
	(min_off): New function.
	(next_record_r): Change to use sread.
	(next_record_w): Change to use sset/sseek, flush fbuf.
	(finalize_transfer): Flush fbuf.
	* io/unit.c (init_units): Init fbuf for stdout, stderr.
	(close_unit_1): Destroy fbuf.
	(finish_last_advance_record): Flush fbuf, no need to seek.
	* io/unix.c (fd_alloc_r_at): Remove unused where argument.
	(fd_alloc_w_at): Likewise.
	(fd_read): Remove third argument to fd_alloc_r_at.
	(fd_write): Remove third argument to fd_alloc_w_at.
	(fd_sset): Likewise.
	(fd_open): Don't set alloc_r_at.
	(mem_alloc_r_at): Remove unused where argument.
	(mem_alloc_w_at): Likewise.
	(mem_read): Don't incorrectly return previous errno, remove unused
	third argument to alloc function.
	(mem_write): Likewise.
	(mem_set): Likewise.
	(open_internal): Don't set alloc_r_at pointer.
	* io/fbuf.c: New file.

From-SVN: r135373

1 files changed, 60 insertions, 41 deletions

diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index ce86ec0..a09d663 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -36,6 +36,7 @@ Boston, MA 02110-1301, USA.  */
 
 /* read.c -- Deal with formatted reads */
 
+
 /* set_integer()-- All of the integer assignments come here to
  * actually place the value into memory.  */
 
@@ -192,11 +193,13 @@ void
 read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
   char *p;
-  int w;
+  size_t w;
 
   w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+
+  p = gfc_alloca (w);
+
+  if (read_block_form (dtp, p, &w) == FAILURE)
     return;
 
   while (*p == ' ')
@@ -238,24 +241,29 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 void
 read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length)
 {
-  char *source;
-  int w, m, n;
+  char *s;
+  int m, n, wi, status;
+  size_t w;
 
-  w = f->u.w;
-  if (w == -1) /* '(A)' edit descriptor  */
-    w = length;
+  wi = f->u.w;
+  if (wi == -1) /* '(A)' edit descriptor  */
+    wi = length;
+
+  w = wi;
+
+  s = gfc_alloca (w);
 
   dtp->u.p.sf_read_comma = 0;
-  source = read_block (dtp, &w);
+  status = read_block_form (dtp, s, &w);
   dtp->u.p.sf_read_comma =
     dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
-  if (source == NULL)
+  if (status == FAILURE)
     return;
-  if (w > length)
-     source += (w - length);
+  if (w > (size_t) length)
+     s += (w - length);
 
-  m = (w > length) ? length : w;
-  memcpy (p, source, m);
+  m = ((int) w > length) ? length : (int) w;
+  memcpy (p, s, m);
 
   n = length - w;
   if (n > 0)
@@ -323,14 +331,19 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
   GFC_UINTEGER_LARGEST value, maxv, maxv_10;
   GFC_INTEGER_LARGEST v;
-  int w, negative;
+  int w, negative; 
+  size_t wu;
   char c, *p;
 
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -406,7 +419,7 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
 		  "Value overflowed during integer read");
   next_record (dtp, 1);
-  return;
+
 }
 
 
@@ -423,12 +436,17 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
   GFC_INTEGER_LARGEST v;
   int w, negative;
   char c, *p;
+  size_t wu;
 
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     {
@@ -552,7 +570,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
   generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
 		  "Value overflowed during integer read");
   next_record (dtp, 1);
-  return;
+
 }
 
 
@@ -565,6 +583,7 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
 void
 read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 {
+  size_t wu;
   int w, seen_dp, exponent;
   int exponent_sign, val_sign;
   int ndigits;
@@ -576,11 +595,15 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 
   val_sign = 1;
   seen_dp = 0;
-  w = f->u.w;
-  p = read_block (dtp, &w);
-  if (p == NULL)
+  wu = f->u.w;
+
+  p = gfc_alloca (wu);
+
+  if (read_block_form (dtp, p, &wu) == FAILURE)
     return;
 
+  w = wu;
+
   p = eat_leading_spaces (&w, p);
   if (w == 0)
     goto zero;
@@ -842,7 +865,6 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
   if (buffer != scratch)
      free_mem (buffer);
 
-  return;
 }
 
 
@@ -850,19 +872,16 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
  * and never look at it. */
 
 void
-read_x (st_parameter_dt *dtp, int n)
+read_x (st_parameter_dt * dtp, int n)
 {
-  if (!is_stream_io (dtp))
-    {
-      if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
-	  && dtp->u.p.current_unit->bytes_left < n)
-	n = dtp->u.p.current_unit->bytes_left;
-
-      dtp->u.p.sf_read_comma = 0;
-      if (n > 0)
-	read_sf (dtp, &n, 1);
-      dtp->u.p.sf_read_comma = 1;
-    }
-  else
-    dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
+  if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
+      && dtp->u.p.current_unit->bytes_left < n)
+    n = dtp->u.p.current_unit->bytes_left;
+
+  dtp->u.p.sf_read_comma = 0;
+  if (n > 0)
+    read_sf (dtp, &n, 1);
+  dtp->u.p.sf_read_comma = 1;
+  dtp->u.p.current_unit->strm_pos += (gfc_offset) n;
 }
+