diff mbox

[libgfortran] PR77393 [7 Regression] Revision r237735 changed the behavior of F0.0

Message ID dea57bf0-3c91-0b32-7045-c7fef054e266@charter.net
State New
Headers show

Commit Message

Jerry DeLisle Aug. 31, 2016, 3:04 a.m. UTC
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  <jvdelisle@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.

Comments

Janne Blomqvist Aug. 31, 2016, 7:45 a.m. UTC | #1
On Wed, Aug 31, 2016 at 6:04 AM, Jerry DeLisle <jvdelisle@charter.net> wrote:
> 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?

Ok, thanks for the patch!
Andreas Schwab Sept. 1, 2016, 10:25 a.m. UTC | #2
On Aug 31 2016, Jerry DeLisle <jvdelisle@charter.net> wrote:

> ! { 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

FAIL: gfortran.dg/fmt_f0_2.f90   -O0  (test for excess errors)
Excess errors:
/daten/aranym/gcc/gcc-20160901/gcc/testsuite/gfortran.dg/fmt_f0_2.f90:12:36: Error: Invalid real kind 16 at (1)

Andreas.
Jerry DeLisle Sept. 1, 2016, 7:48 p.m. UTC | #3
On 09/01/2016 03:25 AM, Andreas Schwab wrote:
> On Aug 31 2016, Jerry DeLisle <jvdelisle@charter.net> wrote:
> 
>> ! { 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
> 
> FAIL: gfortran.dg/fmt_f0_2.f90   -O0  (test for excess errors)
> Excess errors:
> /daten/aranym/gcc/gcc-20160901/gcc/testsuite/gfortran.dg/fmt_f0_2.f90:12:36: Error: Invalid real kind 16 at (1)
> 
> Andreas.
> 

Oh dang, thats right.  I can fix that sometime today.

Thanks for report

Jerry
diff mbox

Patch

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);