OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/38398 (g0.w edit descriptor: Update for F2008 Tokyo meeting changes)

Browse Source 
2008-12-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/38398
	* io/io.h (st_parameter_dt): Add new bit to keep track of when to
	suppress blanks for g0 formatting.
	* io/transfer.c (formatted_transfer_scalar): Always call write_real_g0
	for g0 formatting.
	* io.c (write.c): Do not use ES formatting and use new bit to suppress
	blanks.
	* io/write_float.def (output_float): Adjust the location of setting the
	width so that it can be adjusted when suppressing blanks.  Set number of
	blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code
	clean-up and add some white space for readability.

From-SVN: r142871
This commit is contained in:
Jerry DeLisle 2008-12-21 21:23:52 +00:00
parent c8129db104
commit 50220190d2
5 changed files with 42 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
libgfortran/ChangeLog
View File

@ -1,3 +1,17 @@
2008-12-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/38398
* io/io.h (st_parameter_dt): Add new bit to keep track of when to
suppress blanks for g0 formatting.
* io/transfer.c (formatted_transfer_scalar): Always call write_real_g0
for g0 formatting.
* io.c (write.c): Do not use ES formatting and use new bit to suppress
blanks.
* io/write_float.def (output_float): Adjust the location of setting the
width so that it can be adjusted when suppressing blanks. Set number of
blanks to zero when dtp->u.p.g0_no_blanks is set. Do some minor code
clean-up and add some white space for readability.
2008-12-18 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* configure: Regenerate.

4
libgfortran/io/io.h
View File

@ -444,7 +444,9 @@ typedef struct st_parameter_dt
/* An internal unit specific flag to signify an EOF condition for list
directed read. */
unsigned at_eof : 1;
/* 16 unused bits. */
/* Used for g0 floating point output. */
unsigned g0_no_blanks : 1;
/* 15 unused bits. */
char last_char;
char nml_delim;

7
libgfortran/io/transfer.c
View File

@ -1221,12 +1221,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
break;
case BT_REAL:
if (f->u.real.w == 0)
{
if (f->u.real.d == 0)
write_real (dtp, p, kind);
else
write_real_g0 (dtp, p, kind, f->u.real.d);
}
write_real_g0 (dtp, p, kind, f->u.real.d);
else
write_d (dtp, f, p, kind);
break;

9
libgfortran/io/write.c
View File

@ -1010,13 +1010,12 @@ void
write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
{
fnode f ;
int org_scale = dtp->u.p.scale_factor;
dtp->u.p.scale_factor = 1;
set_fnode_default (dtp, &f, length);
f.format = FMT_ES;
f.u.real.d = d;
if (d > 0)
f.u.real.d = d;
dtp->u.p.g0_no_blanks = 1;
write_float (dtp, &f, source , length);
dtp->u.p.scale_factor = org_scale;
dtp->u.p.g0_no_blanks = 0;
}

31
libgfortran/io/write_float.def
View File

@ -333,15 +333,6 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
else
edigits = 0;
/* Pick a field size if none was specified. */
if (w <= 0)
w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
/* Create the ouput buffer. */
out = write_block (dtp, w);
if (out == NULL)
return;
/* Zero values always output as positive, even if the value was negative
before rounding. */
for (i = 0; i < ndigits; i++)
@ -359,11 +350,26 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
sign = calculate_sign (dtp, 0);
}
/* Pick a field size if none was specified. */
if (w <= 0)
w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
/* Work out how much padding is needed. */
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
if (sign != S_NONE)
nblanks--;
if (dtp->u.p.g0_no_blanks)
{
w -= nblanks;
nblanks = 0;
}
/* Create the ouput buffer. */
out = write_block (dtp, w);
if (out == NULL)
return;
/* Check the value fits in the specified field width. */
if (nblanks < 0 || edigits == -1)
{
@ -419,6 +425,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
digits += i;
out += nbefore;
}
/* Output the decimal point. */
*(out++) = dtp->u.p.current_unit->decimal_status == DECIMAL_POINT ? '.' : ',';
@ -461,12 +468,14 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size,
#endif
memcpy (out, buffer, edigits);
}
if (dtp->u.p.no_leading_blank)
{
out += edigits;
memset( out , ' ' , nblanks );
dtp->u.p.no_leading_blank = 0;
}
#undef STR
#undef STR1
#undef MIN_FIELD_WIDTH
@ -606,7 +615,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
int save_scale_factor, nb = 0;\
\
save_scale_factor = dtp->u.p.scale_factor;\
newf = get_mem (sizeof (fnode));\
newf = (fnode *) get_mem (sizeof (fnode));\
\
exp_d = calculate_exp_ ## x (d);\
if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||\
@ -680,7 +689,7 @@ output_float_FMT_G_ ## x (st_parameter_dt *dtp, const fnode *f, \
\
free_mem(newf);\
\
if (nb > 0)\
if (nb > 0 && !dtp->u.p.g0_no_blanks)\
{ \
p = write_block (dtp, nb);\
if (p == NULL)\