mirror of git://gcc.gnu.org/git/gcc.git
re PR libfortran/47285 (G format outputs wrong number of characters when decimal supplied in literal)
2011-01-26 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/47285 * io/write_float.def (output_float): Return SUCCESS or FAILURE and use the result to set the padding. From-SVN: r169320
This commit is contained in:
parent
04af87889f
commit
434b897293
|
|
@ -1,3 +1,9 @@
|
||||||
|
2011-01-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR libgfortran/47285
|
||||||
|
* io/write_float.def (output_float): Return SUCCESS or FAILURE and use
|
||||||
|
the result to set the padding.
|
||||||
|
|
||||||
2011-01-26 Kai Tietz <kai.tietz@onevision.com>
|
2011-01-26 Kai Tietz <kai.tietz@onevision.com>
|
||||||
|
|
||||||
* intrinsics/getlog.c (getlog): Fix label/statement issue.
|
* intrinsics/getlog.c (getlog): Fix label/statement issue.
|
||||||
|
|
|
||||||
|
|
@ -61,7 +61,7 @@ calculate_sign (st_parameter_dt *dtp, int negative_flag)
|
||||||
|
|
||||||
/* Output a real number according to its format which is FMT_G free. */
|
/* Output a real number according to its format which is FMT_G free. */
|
||||||
|
|
||||||
static void
|
static try
|
||||||
output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
int sign_bit, bool zero_flag, int ndigits, int edigits)
|
int sign_bit, bool zero_flag, int ndigits, int edigits)
|
||||||
{
|
{
|
||||||
|
|
@ -126,17 +126,17 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
{
|
{
|
||||||
out = write_block (dtp, w);
|
out = write_block (dtp, w);
|
||||||
if (out == NULL)
|
if (out == NULL)
|
||||||
return;
|
return FAILURE;
|
||||||
|
|
||||||
if (unlikely (is_char4_unit (dtp)))
|
if (unlikely (is_char4_unit (dtp)))
|
||||||
{
|
{
|
||||||
gfc_char4_t *out4 = (gfc_char4_t *) out;
|
gfc_char4_t *out4 = (gfc_char4_t *) out;
|
||||||
*out4 = '0';
|
*out4 = '0';
|
||||||
return;
|
return SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
*out = '0';
|
*out = '0';
|
||||||
return;
|
return SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
@ -181,13 +181,13 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
{
|
{
|
||||||
generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
|
generate_error (&dtp->common, LIBERROR_FORMAT, "Precision not "
|
||||||
"greater than zero in format specifier 'E' or 'D'");
|
"greater than zero in format specifier 'E' or 'D'");
|
||||||
return;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
if (i <= -d || i >= d + 2)
|
if (i <= -d || i >= d + 2)
|
||||||
{
|
{
|
||||||
generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
|
generate_error (&dtp->common, LIBERROR_FORMAT, "Scale factor "
|
||||||
"out of range in format specifier 'E' or 'D'");
|
"out of range in format specifier 'E' or 'D'");
|
||||||
return;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!zero_flag)
|
if (!zero_flag)
|
||||||
|
|
@ -433,7 +433,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
/* Create the ouput buffer. */
|
/* Create the ouput buffer. */
|
||||||
out = write_block (dtp, w);
|
out = write_block (dtp, w);
|
||||||
if (out == NULL)
|
if (out == NULL)
|
||||||
return;
|
return FAILURE;
|
||||||
|
|
||||||
/* Check the value fits in the specified field width. */
|
/* Check the value fits in the specified field width. */
|
||||||
if (nblanks < 0 || edigits == -1)
|
if (nblanks < 0 || edigits == -1)
|
||||||
|
|
@ -442,10 +442,10 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
{
|
{
|
||||||
gfc_char4_t *out4 = (gfc_char4_t *) out;
|
gfc_char4_t *out4 = (gfc_char4_t *) out;
|
||||||
memset4 (out4, '*', w);
|
memset4 (out4, '*', w);
|
||||||
return;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
star_fill (out, w);
|
star_fill (out, w);
|
||||||
return;
|
return FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* See if we have space for a zero before the decimal point. */
|
/* See if we have space for a zero before the decimal point. */
|
||||||
|
|
@ -553,7 +553,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
memset4 (out4, ' ' , nblanks);
|
memset4 (out4, ' ' , nblanks);
|
||||||
dtp->u.p.no_leading_blank = 0;
|
dtp->u.p.no_leading_blank = 0;
|
||||||
}
|
}
|
||||||
return;
|
return SUCCESS;
|
||||||
} /* End of character(kind=4) internal unit code. */
|
} /* End of character(kind=4) internal unit code. */
|
||||||
|
|
||||||
/* Pad to full field width. */
|
/* Pad to full field width. */
|
||||||
|
|
@ -649,6 +649,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
|
||||||
#undef STR
|
#undef STR
|
||||||
#undef STR1
|
#undef STR1
|
||||||
#undef MIN_FIELD_WIDTH
|
#undef MIN_FIELD_WIDTH
|
||||||
|
return SUCCESS;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -821,8 +822,9 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
|
||||||
GFC_REAL_ ## x rexp_d;\
|
GFC_REAL_ ## x rexp_d;\
|
||||||
int low, high, mid;\
|
int low, high, mid;\
|
||||||
int ubound, lbound;\
|
int ubound, lbound;\
|
||||||
char *p;\
|
char *p, pad = ' ';\
|
||||||
int save_scale_factor, nb = 0;\
|
int save_scale_factor, nb = 0;\
|
||||||
|
try result;\
|
||||||
\
|
\
|
||||||
save_scale_factor = dtp->u.p.scale_factor;\
|
save_scale_factor = dtp->u.p.scale_factor;\
|
||||||
newf = (fnode *) get_mem (sizeof (fnode));\
|
newf = (fnode *) get_mem (sizeof (fnode));\
|
||||||
|
|
@ -876,11 +878,14 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
|
||||||
}\
|
}\
|
||||||
}\
|
}\
|
||||||
\
|
\
|
||||||
|
if (e > 4)\
|
||||||
|
e = 4;\
|
||||||
if (e < 0)\
|
if (e < 0)\
|
||||||
nb = 4;\
|
nb = 4;\
|
||||||
else\
|
else\
|
||||||
nb = e + 2;\
|
nb = e + 2;\
|
||||||
\
|
\
|
||||||
|
nb = nb >= w ? 0 : nb;\
|
||||||
newf->format = FMT_F;\
|
newf->format = FMT_F;\
|
||||||
newf->u.real.w = f->u.real.w - nb;\
|
newf->u.real.w = f->u.real.w - nb;\
|
||||||
\
|
\
|
||||||
|
|
@ -892,8 +897,8 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
|
||||||
dtp->u.p.scale_factor = 0;\
|
dtp->u.p.scale_factor = 0;\
|
||||||
\
|
\
|
||||||
finish:\
|
finish:\
|
||||||
output_float (dtp, newf, buffer, size, sign_bit, zero_flag, ndigits, \
|
result = output_float (dtp, newf, buffer, size, sign_bit, zero_flag, \
|
||||||
edigits);\
|
ndigits, edigits);\
|
||||||
dtp->u.p.scale_factor = save_scale_factor;\
|
dtp->u.p.scale_factor = save_scale_factor;\
|
||||||
\
|
\
|
||||||
free (newf);\
|
free (newf);\
|
||||||
|
|
@ -903,13 +908,15 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
|
||||||
p = write_block (dtp, nb);\
|
p = write_block (dtp, nb);\
|
||||||
if (p == NULL)\
|
if (p == NULL)\
|
||||||
return;\
|
return;\
|
||||||
|
if (result == FAILURE)\
|
||||||
|
pad = '*';\
|
||||||
if (unlikely (is_char4_unit (dtp)))\
|
if (unlikely (is_char4_unit (dtp)))\
|
||||||
{\
|
{\
|
||||||
gfc_char4_t *p4 = (gfc_char4_t *) p;\
|
gfc_char4_t *p4 = (gfc_char4_t *) p;\
|
||||||
memset4 (p4, ' ', nb);\
|
memset4 (p4, pad, nb);\
|
||||||
}\
|
}\
|
||||||
else\
|
else\
|
||||||
memset (p, ' ', nb);\
|
memset (p, pad, nb);\
|
||||||
}\
|
}\
|
||||||
}\
|
}\
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue