From d775696046f9efc67465257db2fc23c627626f23 Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Wed, 31 Aug 2016 17:45:26 +0000 Subject: [PATCH] re PR libfortran/77393 (Revision r237735 changed the behavior of F0.0) 2016-08-31 Jerry DeLisle PR libgfortran/77393 * io/write.c (kind_from_size): New function to calculate required buffer size based on kind type. (select_buffer, select_string): Use new function. (write_float_0, write_real, write_real_g0, write_complex): Adjust calls to pass parameters needed by new function. From-SVN: r239900 --- libgfortran/ChangeLog | 8 +++++ libgfortran/io/write.c | 77 ++++++++++++++++++++++++++++++++---------- 2 files changed, 68 insertions(+), 17 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 394f7d35e7b..256805a3db6 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,11 @@ +2016-08-31 Jerry DeLisle + + PR libgfortran/77393 + * io/write.c (kind_from_size): New function to calculate required buffer + size based on kind type. (select_buffer, select_string): Use new + function. (write_float_0, write_real, write_real_g0, write_complex): + Adjust calls to pass parameters needed by new function. + 2016-08-31 Jerry DeLisle Paul Thomas diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 15f7158dbb7..d4b1bc895ed 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1357,11 +1357,52 @@ get_precision (st_parameter_dt *dtp, const fnode *f, const char *source, int kin return determine_en_precision (dtp, f, source, kind); } +/* 4932 is the maximum exponent of long double and quad precision, 3 + extra characters for the sign, the decimal point, and the + trailing null. Extra digits are added by the calling functions for + requested precision. Likewise for float and double. F0 editing produces + full precision output. */ +static int +size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind) +{ + int size; + + if (f->format == FMT_F && f->u.real.w == 0) + { + switch (kind) + { + case 4: + size = 38 + 3; /* These constants shown for clarity. */ + break; + case 8: + size = 308 + 3; + break; + case 10: + size = 4932 + 3; + break; + case 16: + size = 4932 + 3; + break; + default: + internal_error (&dtp->common, "bad real kind"); + break; + } + } + else + size = f->u.real.w + 1; /* One byte for a NULL character. */ + + return size; +} + static char * -select_buffer (int precision, char *buf, size_t *size) +select_buffer (st_parameter_dt *dtp, const fnode *f, int precision, + char *buf, size_t *size, int kind) { char *result; - *size = BUF_STACK_SZ / 2 + precision; + + /* The buffer needs at least one more byte to allow room for normalizing. */ + *size = size_from_kind (dtp, f, kind) + precision + 1; + if (*size > BUF_STACK_SZ) result = xmalloc (*size); else @@ -1370,10 +1411,11 @@ select_buffer (int precision, char *buf, size_t *size) } static char * -select_string (const fnode *f, char *buf, size_t *size) +select_string (st_parameter_dt *dtp, const fnode *f, char *buf, size_t *size, + int kind) { char *result; - *size = f->u.real.w + 1; + *size = size_from_kind (dtp, f, kind) + f->u.real.d; if (*size > BUF_STACK_SZ) result = xmalloc (*size); else @@ -1397,6 +1439,7 @@ write_float_string (st_parameter_dt *dtp, char *fstr, size_t len) memcpy (p, fstr, len); } + static void write_float_0 (st_parameter_dt *dtp, const fnode *f, const char *source, int kind) { @@ -1409,10 +1452,10 @@ write_float_0 (st_parameter_dt *dtp, const fnode *f, const char *source, int kin int precision = get_precision (dtp, f, source, kind); /* String buffer to hold final result. */ - result = select_string (f, str_buf, &res_len); - - buffer = select_buffer (precision, buf_stack, &buf_size); - + result = select_string (dtp, f, str_buf, &res_len, kind); + + buffer = select_buffer (dtp, f, precision, buf_stack, &buf_size, kind); + get_float_string (dtp, f, source , kind, 0, buffer, precision, buf_size, result, &res_len); write_float_string (dtp, result, res_len); @@ -1527,11 +1570,11 @@ write_real (st_parameter_dt *dtp, const char *source, int kind) int precision = get_precision (dtp, &f, source, kind); /* String buffer to hold final result. */ - result = select_string (&f, str_buf, &res_len); - - /* scratch buffer to hold final result. */ - buffer = select_buffer (precision, buf_stack, &buf_size); + result = select_string (dtp, &f, str_buf, &res_len, kind); + /* Scratch buffer to hold final result. */ + buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind); + get_float_string (dtp, &f, source , kind, 1, buffer, precision, buf_size, result, &res_len); write_float_string (dtp, result, res_len); @@ -1572,9 +1615,9 @@ write_real_g0 (st_parameter_dt *dtp, const char *source, int kind, int d) int precision = get_precision (dtp, &f, source, kind); /* String buffer to hold final result. */ - result = select_string (&f, str_buf, &res_len); + result = select_string (dtp, &f, str_buf, &res_len, kind); - buffer = select_buffer (precision, buf_stack, &buf_size); + buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind); get_float_string (dtp, &f, source , kind, comp_d, buffer, precision, buf_size, result, &res_len); @@ -1620,10 +1663,10 @@ write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size) int precision = get_precision (dtp, &f, source, kind); /* String buffers to hold final result. */ - result1 = select_string (&f, str1_buf, &res_len1); - result2 = select_string (&f, str2_buf, &res_len2); + result1 = select_string (dtp, &f, str1_buf, &res_len1, kind); + result2 = select_string (dtp, &f, str2_buf, &res_len2, kind); - buffer = select_buffer (precision, buf_stack, &buf_size); + buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind); get_float_string (dtp, &f, source , kind, 0, buffer, precision, buf_size, result1, &res_len1); -- 2.30.2