re PR fortran/44953 (FAIL: gfortran.dg/char4_iunit_1.f03 * execution test)

2010-07-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/44953
	* io/unix.c (mem_alloc_w4): Return gfc_char4_t instead of char type
	pointer. (mem_write4): Remove cast to gfc_char4_t.
	* io/transfer.c (write_block): Use a gfc_char4_t pointer.
	(memset4): New helper function. (next_record_w): Use new helper
	function rather than sset for internal units.  Don't attempt to pad
	with spaces if it is not needed.
	* io/unix.h: Update prototype for mem_alloc_w4.
	* io/write.c (memset4): Use gfc_char4_t pointer and chracter type.
	Don't use multiply by 4 to compute offset. (memcpy4): Likewise.
	(write_default_char4): Use a gfc_char4_t pointer and update memset4
	and memcpy calls. (write_a): Likewise. (write_l): Likewise.
	(write_boz): Likewise. (write_decimal): Likewise. (write_x): Likewise.
	(write_char): Add support for character(kind=4) internal units that
	was previously missed. (write_integer): Use a gfc_char4_t pointer and
	update memset4 and memcpy calls. (write_character): Likewise.
	(write_separator): Add support for character(kind=4) internal units
	that was previously missed.
	* write_float.def (output_float): Use a gfc_char4_t pointer and
	update memset4 and memcpy calls. (write_infnan): Likewise.
	(output_float_FMT_G_): Likewise.

From-SVN: r162304

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 3f8fddd862b5b09c89fc1815760d073923ca0d3e..9252a90f46dc4556ea86d0d5bcd9044599e0a73f 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,27 @@
+2010-07-19  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/44953
+       * io/unix.c (mem_alloc_w4): Return gfc_char4_t instead of char type
+       pointer. (mem_write4): Remove cast to gfc_char4_t.
+       * io/transfer.c (write_block): Use a gfc_char4_t pointer.
+       (memset4): New helper function. (next_record_w): Use new helper
+       function rather than sset for internal units.  Don't attempt to pad
+       with spaces if it is not needed.
+       * io/unix.h: Update prototype for mem_alloc_w4.
+       * io/write.c (memset4): Use gfc_char4_t pointer and chracter type.
+       Don't use multiply by 4 to compute offset. (memcpy4): Likewise.
+       (write_default_char4): Use a gfc_char4_t pointer and update memset4
+       and memcpy calls. (write_a): Likewise. (write_l): Likewise.
+       (write_boz): Likewise. (write_decimal): Likewise. (write_x): Likewise.
+       (write_char): Add support for character(kind=4) internal units that
+       was previously missed. (write_integer): Use a gfc_char4_t pointer and
+       update memset4 and memcpy calls. (write_character): Likewise.
+       (write_separator): Add support for character(kind=4) internal units
+       that was previously missed.
+       * write_float.def (output_float): Use a gfc_char4_t pointer and
+       update memset4 and memcpy calls. (write_infnan): Likewise.
+       (output_float_FMT_G_): Likewise.
+       
 2010-07-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/37077

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index bab1c932502df91bc6ec6dd0ee1b2d2cda3caec0..f750a568df46ecc5da453ea0466e8b65ca6cd171 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -696,7 +696,16 @@ write_block (st_parameter_dt *dtp, int length)
   if (is_internal_unit (dtp))
     {
       if (dtp->common.unit) /* char4 internel unit.  */
-       dest = mem_alloc_w4 (dtp->u.p.current_unit->s, &length);
+       {
+         gfc_char4_t *dest4;
+         dest4 = mem_alloc_w4 (dtp->u.p.current_unit->s, &length);
+         if (dest4 == NULL)
+         {
+            generate_error (&dtp->common, LIBERROR_END, NULL);
+            return NULL;
+         }
+         return dest4;
+       }
       else
        dest = mem_alloc_w (dtp->u.p.current_unit->s, &length);
 
@@ -3086,6 +3095,14 @@ sset (stream * s, int c, ssize_t nbyte)
   return nbyte - bytes_left;
 }
 
+static inline void
+memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
+{
+  int j;
+  for (j = 0; j < k; j++)
+    *p++ = c;
+}
+
 /* Position to the next record in write mode.  */
 
 static void
@@ -3136,6 +3153,7 @@ next_record_w (st_parameter_dt *dtp, int done)
 
       if (is_internal_unit (dtp))
        {
+         char *p;
          if (is_array_io (dtp))
            {
              int finished;
@@ -3160,11 +3178,17 @@ next_record_w (st_parameter_dt *dtp, int done)
                  length = (int) (dtp->u.p.current_unit->recl - max_pos);
                }
 
-             if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
-               {
-                 generate_error (&dtp->common, LIBERROR_END, NULL);
-                 return;
+             p = write_block (dtp, length);
+             if (p == NULL)
+               return;
+
+             if (unlikely (is_char4_unit (dtp)))
+               {
+                 gfc_char4_t *p4 = (gfc_char4_t *) p;
+                 memset4 (p4, ' ', length);
                }
+             else
+               memset (p, ' ', length);
 
              /* Now that the current record has been padded out,
                 determine where the next record in the array is. */
@@ -3209,11 +3233,19 @@ next_record_w (st_parameter_dt *dtp, int done)
                  else
                    length = (int) dtp->u.p.current_unit->bytes_left;
                }
-
-             if (sset (dtp->u.p.current_unit->s, ' ', length) != length)
+             if (length > 0)
                {
-                 generate_error (&dtp->common, LIBERROR_END, NULL);
-                 return;
+                 p = write_block (dtp, length);
+                 if (p == NULL)
+                   return;
+
+                 if (unlikely (is_char4_unit (dtp)))
+                   {
+                     gfc_char4_t *p4 = (gfc_char4_t *) p;
+                     memset4 (p4, (gfc_char4_t) ' ', length);
+                   }
+                 else
+                   memset (p, ' ', length);
                }
            }
        }

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 65decce1be36381c24ad49ef6d39304af9d15a9e..3a795aef53624d6c87c5aab1b1315cddbb841a9c 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -659,12 +659,13 @@ mem_alloc_w (stream * strm, int * len)
 }
 
 
-char *
+gfc_char4_t *
 mem_alloc_w4 (stream * strm, int * len)
 {
   unix_stream * s = (unix_stream *) strm;
   gfc_offset m;
   gfc_offset where = s->logical_offset;
+  gfc_char4_t *result = (gfc_char4_t *) s->buffer;
 
   m = where + *len;
 
@@ -675,7 +676,7 @@ mem_alloc_w4 (stream * strm, int * len)
     return NULL;
 
   s->logical_offset = m;
-  return s->buffer + (where - s->buffer_offset) * 4;
+  return &result[where - s->buffer_offset];
 }
 
 
@@ -744,7 +745,7 @@ mem_write4 (stream * s, const void * buf, ssize_t nwords)
   gfc_char4_t *p;
   int nw = nwords;
 
-  p = (gfc_char4_t *) mem_alloc_w4 (s, &nw);
+  p = mem_alloc_w4 (s, &nw);
   if (p)
     {
       while (nw--)

diff --git a/libgfortran/io/unix.h b/libgfortran/io/unix.h
index c69e3574d8686b78603e45f6522e590ecb81d1a1..3229d502547f1e1a38555297082db3b5e03aa92b 100644 (file)
--- a/libgfortran/io/unix.h
+++ b/libgfortran/io/unix.h
@@ -103,7 +103,7 @@ internal_proto(mem_alloc_w);
 extern char * mem_alloc_r (stream *, int *);
 internal_proto(mem_alloc_r);
 
-extern char * mem_alloc_w4 (stream *, int *);
+extern gfc_char4_t * mem_alloc_w4 (stream *, int *);
 internal_proto(mem_alloc_w4);
 
 extern char * mem_alloc_r4 (stream *, int *);

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index fe6134798bfbf5bf648d379635a2032799eff715..775425d6d776af238fc5d5266aab6bffdc8c96f4 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -42,23 +42,21 @@ typedef unsigned char uchar;
    by write_float.def.  */
 
 static inline void
-memset4 (void *p,  int offs, uchar c, int k)
+memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
 {
   int j;
-  gfc_char4_t *q = (gfc_char4_t *) (p + offs * 4);
   for (j = 0; j < k; j++)
-    *q++ = c;
+    *p++ = c;
 }
 
 static inline void
-memcpy4 (void *dest,  int offs, const char *source, int k)
+memcpy4 (gfc_char4_t *dest, const char *source, int k)
 {
   int j;
   
   const char *p = source;
-  gfc_char4_t *q = (gfc_char4_t *) (dest + offs * 4);
   for (j = 0; j < k; j++)
-    *q++ = (gfc_char4_t) *p++;
+    *dest++ = (gfc_char4_t) *p++;
 }
 
 /* This include contains the heart and soul of formatted floating point.  */
@@ -83,7 +81,10 @@ write_default_char4 (st_parameter_dt *dtp, gfc_char4_t *source,
       if (p == NULL)
        return;
       if (is_char4_unit (dtp))
-       memset4 (p, 0, ' ', k);
+       {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
+         memset4 (p4, ' ', k);
+       }
       else
        memset (p, ' ', k);
     }
@@ -310,12 +311,13 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
 
       if (unlikely (is_char4_unit (dtp)))
        {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
          if (wlen < len)
-           memcpy4 (p, 0, source, wlen);
+           memcpy4 (p4, source, wlen);
          else
            {
-             memset4 (p, 0, ' ', wlen - len);
-             memcpy4 (p, wlen - len, source, len);
+             memset4 (p4, ' ', wlen - len);
+             memcpy4 (p4 + wlen - len, source, len);
            }
          return;
        }
@@ -545,7 +547,7 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
   if (unlikely (is_char4_unit (dtp)))
     {
       gfc_char4_t *p4 = (gfc_char4_t *) p;
-      memset4 (p, 0, ' ', wlen -1);
+      memset4 (p4, ' ', wlen -1);
       p4[wlen - 1] = (n) ? 'T' : 'F';
       return;
     }
@@ -575,7 +577,10 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
       if (p == NULL)
         return;
       if (unlikely (is_char4_unit (dtp)))
-       memset4 (p, 0, ' ', w);
+       {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
+         memset4 (p4, ' ', w);
+       }
       else
        memset (p, ' ', w);
       goto done;
@@ -606,25 +611,25 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
       gfc_char4_t *p4 = (gfc_char4_t *) p;
       if (nblank < 0)
        {
-         memset4 (p4, 0, '*', w);
+         memset4 (p4, '*', w);
          return;
        }
 
       if (!dtp->u.p.no_leading_blank)
        {
-         memset4 (p4, 0, ' ', nblank);
+         memset4 (p4, ' ', nblank);
          q += nblank;
-         memset4 (p4, 0, '0', nzero);
+         memset4 (p4, '0', nzero);
          q += nzero;
-         memcpy4 (p4, 0, q, digits);
+         memcpy4 (p4, q, digits);
        }
       else
        {
-         memset4 (p4, 0, '0', nzero);
+         memset4 (p4, '0', nzero);
          q += nzero;
-         memcpy4 (p4, 0, q, digits);
+         memcpy4 (p4, q, digits);
          q += digits;
-         memset4 (p4, 0, ' ', nblank);
+         memset4 (p4, ' ', nblank);
          dtp->u.p.no_leading_blank = 0;
        }
       return;
@@ -685,7 +690,10 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
       if (p == NULL)
         return;
       if (unlikely (is_char4_unit (dtp)))
-       memset4 (p, 0, ' ', w);
+       {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
+         memset4 (p4, ' ', w);
+       }
       else
        memset (p, ' ', w);
       goto done;
@@ -730,11 +738,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
       gfc_char4_t * p4 = (gfc_char4_t *) p;
       if (nblank < 0)
        {
-         memset4 (p4, 0, '*', w);
+         memset4 (p4, '*', w);
          goto done;
        }
 
-      memset4 (p4, 0, ' ', nblank);
+      memset4 (p4, ' ', nblank);
       p4 += nblank;
 
       switch (sign)
@@ -749,10 +757,10 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
          break;
        }
 
-      memset4 (p4, 0, '0', nzero);
+      memset4 (p4, '0', nzero);
       p4 += nzero;
 
-      memcpy4 (p4, 0, q, digits);
+      memcpy4 (p4, q, digits);
       return;
     }
 
@@ -1192,7 +1200,10 @@ write_x (st_parameter_dt *dtp, int len, int nspaces)
   if (nspaces > 0 && len - nspaces >= 0)
     {
       if (unlikely (is_char4_unit (dtp)))
-       memset4 (p, len - nspaces, ' ', nspaces);
+       {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
+         memset4 (&p4[len - nspaces], ' ', nspaces);
+       }
       else
        memset (&p[len - nspaces], ' ', nspaces);
     }
@@ -1206,15 +1217,21 @@ write_x (st_parameter_dt *dtp, int len, int nspaces)
    something goes wrong.  */
 
 static int
-write_char (st_parameter_dt *dtp, char c)
+write_char (st_parameter_dt *dtp, int c)
 {
   char *p;
 
   p = write_block (dtp, 1);
   if (p == NULL)
     return 1;
+  if (unlikely (is_char4_unit (dtp)))
+    {
+      gfc_char4_t *p4 = (gfc_char4_t *) p;
+      *p4 = c;
+      return 0;
+    }
 
-  *p = c;
+  *p = (uchar) c;
 
   return 0;
 }
@@ -1275,15 +1292,16 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
 
   if (unlikely (is_char4_unit (dtp)))
     {
+      gfc_char4_t *p4 = (gfc_char4_t *) p;
       if (dtp->u.p.no_leading_blank)
        {
-         memcpy4 (p, 0, q, digits);
-         memset4 (p, digits, ' ', width - digits);
+         memcpy4 (p4, q, digits);
+         memset4 (p4 + digits, ' ', width - digits);
        }
       else
        {
-         memset4 (p, 0, ' ', width - digits);
-         memcpy4 (p, width - digits, q, digits);
+         memset4 (p4, ' ', width - digits);
+         memcpy4 (p4 + width - digits, q, digits);
        }
       return;
     }
@@ -1346,7 +1364,7 @@ write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
          gfc_char4_t *p4 = (gfc_char4_t *) p;
 
          if (d4 == ' ')
-           memcpy4 (p4, 0, source, length);
+           memcpy4 (p4, source, length);
          else
            {
              *p4++ = d4;
@@ -1495,8 +1513,13 @@ write_separator (st_parameter_dt *dtp)
   p = write_block (dtp, options.separator_len);
   if (p == NULL)
     return;
-
-  memcpy (p, options.separator, options.separator_len);
+  if (unlikely (is_char4_unit (dtp)))
+    {
+      gfc_char4_t *p4 = (gfc_char4_t *) p;
+      memcpy4 (p4, options.separator, options.separator_len);
+    }
+  else
+    memcpy (p, options.separator, options.separator_len);
 }
 
 

diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 02e1b8b9b13fcd5cb3db872d5234a3942778b873..776e59119931f07943af8787c1dd751bd60a7359 100644 (file)
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -440,7 +440,8 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
     {
       if (unlikely (is_char4_unit (dtp)))
        {
-         memset4 (out, 0, '*', w);
+         gfc_char4_t *out4 = (gfc_char4_t *) out;
+         memset4 (out4, '*', w);
          return;
        }
       star_fill (out, w);
@@ -466,7 +467,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
 
       if ( ( nblanks > 0 ) && !dtp->u.p.no_leading_blank)
        {
-         memset4 (out, 0, ' ', nblanks);
+         memset4 (out4, ' ', nblanks);
          out4 += nblanks;
        }
 
@@ -486,7 +487,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
          if (nbefore > ndigits)
            {
              i = ndigits;
-             memcpy4 (out4, 0, digits, i);
+             memcpy4 (out4, digits, i);
              ndigits = 0;
              while (i < nbefore)
                out4[i++] = '0';
@@ -494,7 +495,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
          else
            {
              i = nbefore;
-             memcpy4 (out4, 0, digits, i);
+             memcpy4 (out4, digits, i);
              ndigits -= i;
            }
 
@@ -521,7 +522,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
          else
            i = nafter;
 
-         memcpy4 (out4, 0, digits, i);
+         memcpy4 (out4, digits, i);
          while (i < nafter)
            out4[i++] = '0';
 
@@ -543,13 +544,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
 #else
          sprintf (buffer, "%+0*d", edigits, e);
 #endif
-         memcpy4 (out4, 0, buffer, edigits);
+         memcpy4 (out4, buffer, edigits);
        }
 
       if (dtp->u.p.no_leading_blank)
        {
          out4 += edigits;
-         memset4 (out4 , 0, ' ' , nblanks);
+         memset4 (out4, ' ' , nblanks);
          dtp->u.p.no_leading_blank = 0;
        }
       return;
@@ -673,14 +674,20 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
       if (nb < 3)
        {
          if (unlikely (is_char4_unit (dtp)))
-           memset4 (p, 0, '*', nb);
+           {
+             gfc_char4_t *p4 = (gfc_char4_t *) p;
+             memset4 (p4, '*', nb);
+           }
          else
            memset (p, '*', nb);
          return;
        }
 
       if (unlikely (is_char4_unit (dtp)))
-        memset4 (p, 0, ' ', nb);
+       {
+         gfc_char4_t *p4 = (gfc_char4_t *) p;
+         memset4 (p4, ' ', nb);
+       }
       else
        memset(p, ' ', nb);
 
@@ -693,7 +700,10 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
              if (nb == 3)
                {
                  if (unlikely (is_char4_unit (dtp)))
-                   memset4 (p, 0, '*', nb);
+                   {
+                     gfc_char4_t *p4 = (gfc_char4_t *) p;
+                     memset4 (p4, '*', nb);
+                   }
                  else
                    memset (p, '*', nb);
                  return;
@@ -711,11 +721,11 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
              gfc_char4_t *p4 = (gfc_char4_t *) p;
              if (nb > 8)
                /* We have room, so output 'Infinity' */
-               memcpy4 (p4, nb - 8, "Infinity", 8);
+               memcpy4 (p4 + nb - 8, "Infinity", 8);
              else
                /* For the case of width equals 8, there is not enough room
                   for the sign and 'Infinity' so we go with 'Inf' */
-               memcpy4 (p4, nb - 3, "Inf", 3);
+               memcpy4 (p4 + nb - 3, "Inf", 3);
 
              if (nb < 9 && nb > 3)
                /* Put the sign in front of Inf */
@@ -742,7 +752,10 @@ write_infnan (st_parameter_dt *dtp, const fnode *f, int isnan_flag, int sign_bit
       else
         {
          if (unlikely (is_char4_unit (dtp)))
-           memcpy4 (p, nb - 3, "NaN", 3);
+           {
+             gfc_char4_t *p4 = (gfc_char4_t *) p;
+             memcpy4 (p4 + nb - 3, "NaN", 3);
+           }
          else
            memcpy(p + nb - 3, "NaN", 3);
        }
@@ -886,12 +899,15 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
   free (newf);\
 \
   if (nb > 0 && !dtp->u.p.g0_no_blanks)\
-    { \
+    {\
       p = write_block (dtp, nb);\
       if (p == NULL)\
        return;\
       if (unlikely (is_char4_unit (dtp)))\
-       memset4 (p, 0, ' ', nb);\
+       {\
+         gfc_char4_t *p4 = (gfc_char4_t *) p;\
+         memset4 (p4, ' ', nb);\
+       }\
       else\
        memset (p, ' ', nb);\
     }\