mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-14 03:29:41 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/36420 (Fortran 2008: g0 edit descriptor)

Browse Source 
2008-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/36420
	PR libfortran/36421
	PR libfortran/36422
	* io/io.h: Add prototype for write_real.
	* io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero,
	use write_real.
	* io/format.c: Add zero width error message. (parse_format_list): Use
	error message for FMT_A if followed by FMT_ZERO. Use zero width error
	message	for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0):
	Fix typo in comment.
	* io/write.c (write_a): Set wlen to len if FMT_G and length is zero.
	(write_l): Add wlen variable and use it if FMT_G and width is zero.
	(write_decimal): If FMT_G, set m to -1 to flag processor dependent
	formatting. (write_real): Remove static declaration.

From-SVN: r136545
This commit is contained in:
Jerry DeLisle 2008-06-07 23:59:53 +00:00
parent 8955a00563
commit 9355110f96
5 changed files with 55 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
libgfortran/ChangeLog
View File

@ -1,3 +1,20 @@
2008-06-07 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/36420
PR libfortran/36421
PR libfortran/36422
* io/io.h: Add prototype for write_real.
* io/transfer.c (formatted_transfer_scalar): For FMT_G and width zero,
use write_real.
* io/format.c: Add zero width error message. (parse_format_list): Use
error message for FMT_A if followed by FMT_ZERO. Use zero width error
message for FMT_G if mode is READ or if -std=f95 or f2003. (fmormat0):
Fix typo in comment.
* io/write.c(write_a): Set wlen to len if FMT_G and length is zero.
(write_l): Add wlen variable and use it if FMT_G and width is zero.
(write_decimal): If FMT_G, set m to -1 to flag processor dependent
formatting. (write_real): Remove static declaration.
2008-05-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/36319

23
libgfortran/io/format.c
View File

@ -71,8 +71,8 @@ static const char posint_required[] = "Positive width required in format",
unexpected_end[] = "Unexpected end of format string",
bad_string[] = "Unterminated character constant in format",
bad_hollerith[] = "Hollerith constant extends past the end of the format",
reversion_error[] = "Exhausted data descriptors in format";
reversion_error[] = "Exhausted data descriptors in format",
zero_width[] = "Zero width in format descriptor";
/* next_char()-- Return the next character in the format string.
* Returns -1 when the string is done. If the literal flag is set,
@ -698,6 +698,12 @@ parse_format_list (st_parameter_dt *dtp)
case FMT_A:
t = format_lex (fmt);
if (t == FMT_ZERO)
{
fmt->error = zero_width;
goto finished;
}
if (t != FMT_POSINT)
{
fmt->saved_token = t;
@ -719,6 +725,17 @@ parse_format_list (st_parameter_dt *dtp)
tail->repeat = repeat;
u = format_lex (fmt);
if (t == FMT_G && u == FMT_ZERO)
{
if (notification_std (GFC_STD_F2008) == ERROR
|| dtp->u.p.mode == READING)
{
fmt->error = zero_width;
goto finished;
}
tail->u.real.w = 0;
break;
}
if (t == FMT_F || dtp->u.p.mode == WRITING)
{
if (u != FMT_POSINT && u != FMT_ZERO)
@ -1079,7 +1096,7 @@ next_format0 (fnode * f)
/* next_format()-- Return the next format node. If the format list
* ends up being exhausted, we do reversion. Reversion is only
* allowed if the we've seen a data descriptor since the
* allowed if we've seen a data descriptor since the
* initialization or the last reversion. We return NULL if there
* are no more data descriptors to return (which is an error
* condition). */

3
libgfortran/io/io.h
View File

@ -931,6 +931,9 @@ internal_proto(write_l);
extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
internal_proto(write_o);
extern void write_real (st_parameter_dt *, const char *, int);
internal_proto(write_real);
extern void write_x (st_parameter_dt *, int, int);
internal_proto(write_x);

5
libgfortran/io/transfer.c
View File

@ -1175,7 +1175,10 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len,
write_a (dtp, f, p, len);
break;
case BT_REAL:
write_d (dtp, f, p, len);
if (f->u.real.w == 0)
write_real (dtp, p, len);
else
write_d (dtp, f, p, len);
break;
default:
bad_type:

18
libgfortran/io/write.c
View File

@ -46,7 +46,9 @@ write_a (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
int wlen;
char *p;
wlen = f->u.string.length < 0 ? len : f->u.string.length;
wlen = f->u.string.length < 0
|| (f->format == FMT_G && f->u.string.length == 0)
? len : f->u.string.length;
#ifdef HAVE_CRLF
/* If this is formatted STREAM IO convert any embedded line feed characters
@ -235,15 +237,18 @@ void
write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
{
char *p;
int wlen;
GFC_INTEGER_LARGEST n;
p = write_block (dtp, f->u.w);
wlen = (f->format == FMT_G && f->u.w == 0) ? 1 : f->u.w;
p = write_block (dtp, wlen);
if (p == NULL)
return;
memset (p, ' ', f->u.w - 1);
memset (p, ' ', wlen - 1);
n = extract_int (source, len);
p[f->u.w - 1] = (n) ? 'T' : 'F';
p[wlen - 1] = (n) ? 'T' : 'F';
}
@ -340,12 +345,11 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
char itoa_buf[GFC_BTOA_BUF_SIZE];
w = f->u.integer.w;
m = f->u.integer.m;
m = f->format == FMT_G ? -1 : f->u.integer.m;
n = extract_int (source, len);
/* Special case: */
if (m == 0 && n == 0)
{
if (w == 0)
@ -690,7 +694,7 @@ write_character (st_parameter_dt *dtp, const char *source, int length)
This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8),
1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */
static void
void
write_real (st_parameter_dt *dtp, const char *source, int length)
{
fnode f ;