Hi all,
The attached patch fixes the problem by adding a new helper function to
determine the buffer size needed for F0 editing depending on the kind. In this
new function there are some constants presented which document the limits needed
for each kind type.
As can be seen, the required buffers are fixed on stack at 256 bytes which will
handle almost all cases unless a user is doing something with unusually wide
formats. The buffer is malloc'ed if a larger size is needed.
I have not changed the buffering mechanism, only the method of determining the
needed size.
Regression tested on x86-linux. New test case provided.
OK for trunk?
Regards,
Jerry
2016-08-31 Jerry DeLisle <jvdeli...@gcc.gnu.org>
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.
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index db27f2d..0e4ce0b 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,9 +1452,9 @@ 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);
+ 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, 0, buffer,
precision, buf_size, result, &res_len);
@@ -1527,10 +1570,10 @@ 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);
+ result = select_string (dtp, &f, str_buf, &res_len, kind);
- /* scratch buffer to hold final result. */
- buffer = select_buffer (precision, buf_stack, &buf_size);
+ /* 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);
@@ -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);
! { dg-do run }
! PR77393
program testbigf0 ! Can enormous numbers be printed with F0.0 format?
implicit none
character(10000) :: str
write(str, "(f0.0)") -huge(1.0)
if (len(trim(str)).lt.41) error stop "FAILED AT 9"
write(str, "(f0.0)") -huge(1.0_8)
if (len(trim(str)).lt.311) error stop "FAILED AT 9"
write(str, "(f0.0)") -huge(1.0_10)
if (len(trim(str)).lt.4935) error stop "FAILED AT 9"
write(str, "(f0.10)") -huge(1.0_16)
if (len(trim(str)).lt.4945) error stop "FAILED AT 11"
end program testbigf0
