From patchwork Mon Jul 19 04:21:46 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 59177 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id A86FDB6EF7 for ; Mon, 19 Jul 2010 14:22:25 +1000 (EST) Received: (qmail 32579 invoked by alias); 19 Jul 2010 04:22:20 -0000 Received: (qmail 32553 invoked by uid 22791); 19 Jul 2010 04:22:18 -0000 X-SWARE-Spam-Status: No, hits=3.8 required=5.0 tests=AWL, BAYES_05, BOTNET, RCVD_IN_DNSWL_NONE, TW_CP, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from vms173009pub.verizon.net (HELO vms173009pub.verizon.net) (206.46.173.9) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 19 Jul 2010 04:22:06 +0000 Received: from [192.168.1.10] ([unknown] [64.234.92.14]) by vms173009.mailsrvcs.net (Sun Java(tm) System Messaging Server 7u2-7.02 32bit (built Apr 16 2009)) with ESMTPA id <0L5S004JOESBFUU0@vms173009.mailsrvcs.net>; Sun, 18 Jul 2010 23:21:54 -0500 (CDT) Message-id: <4C43D2DA.3070203@verizon.net> Date: Sun, 18 Jul 2010 21:21:46 -0700 From: Jerry DeLisle User-Agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.9.1.10) Gecko/20100527 Thunderbird/3.0.5 MIME-version: 1.0 To: gfortran Cc: gcc patches Subject: [patch, libgfortran] PR44953 FAIL: gfortran.dg/char4_iunit_1.f03 * execution test Content-type: multipart/mixed; boundary=------------000007090305050909070802 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi all, The failures were due to some sloppy pointer use and I missed a few of the functions in write.c during initial implementation. The attached patch cleans this all up. New test cases are not needed. Passed regression testing on IBM Power 5 running Linux and Dominique reports success with the original test cases. Also regression tested on x86-64-linux-gnu. OK for trunk? Regards, Jerry PS After this patch is committed, I plan to commit a separate patch to clean up a bunch of unrelated whitespace issues I have found in transfer.c. I did not want those fixes to make this patch here more difficult to review. 2010-07-18 Jerry DeLisle 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. Index: unix.c =================================================================== --- unix.c (revision 162282) +++ unix.c (working copy) @@ -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 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--) Index: transfer.c =================================================================== --- transfer.c (revision 162282) +++ transfer.c (working copy) @@ -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 (length > 0) + { + p = write_block (dtp, length); + if (p == NULL) + return; - if (sset (dtp->u.p.current_unit->s, ' ', length) != length) - { - generate_error (&dtp->common, LIBERROR_END, 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); } } } Index: unix.h =================================================================== --- unix.h (revision 162282) +++ unix.h (working copy) @@ -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 *); Index: write.c =================================================================== --- write.c (revision 162282) +++ write.c (working copy) @@ -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_cha 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, con 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, cha 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, c 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, c 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 * 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 * 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 * 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 nspace 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 nspace 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 *s 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 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); } Index: write_float.def =================================================================== --- write_float.def (revision 162282) +++ write_float.def (working copy) @@ -440,7 +440,8 @@ output_float (st_parameter_dt *dtp, const fnode *f { 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 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 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 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 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 #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 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 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 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 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, co 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);\ }\