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

re PR libfortran/40330 (incorrect IO) 

2009-07-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/40330
	PR libfortran/40662
	* io/io.h (st_parameter_dt): Define format_not_saved bit used to signal
	whether the parsed format data was previously saved. Used to determine
	if the current format data should be freed or not.
	* io/transfer.c (st_read_done): Use the format_not_saved bit.
	(st_write_done): Likewise.
	* io/format.c (parse_format_list): Add boolean pointer to arg list. This
	pointer is used to return status to the caller regarding whether it is
	safe to cache the parsed format data.  Currently, if a FMT_STRING token
	is encounetered, it is not safe to cache. Also, added a local boolean
	variable to hold this information as recursive calls to
	parse_format_list are made.  Remove previous save_format logic.
	(parse_format): Do not use the format caching facility if the current
	unit is an internal unit or if it is not safe to save parsed format
	data.

From-SVN: r149398
This commit is contained in:
Jerry DeLisle 2009-07-09 01:20:23 +00:00
parent 0eb8f20cf8
commit 2418d0e0e6
4 changed files with 54 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
libgfortran/ChangeLog
View File

@ -1,3 +1,22 @@
2009-07-08 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/40330
PR libfortran/40662
* io/io.h (st_parameter_dt): Define format_not_saved bit used to signal
whether the parsed format data was previously saved. Used to determine
if the current format data should be freed or not.
* io/transfer.c (st_read_done): Use the format_not_saved bit.
(st_write_done): Likewise.
* io/format.c (parse_format_list): Add boolean pointer to arg list. This
pointer is used to return status to the caller regarding whether it is
safe to cache the parsed format data. Currently, if a FMT_STRING token
is encounetered, it is not safe to cache. Also, added a local boolean
variable to hold this information as recursive calls to
parse_format_list are made. Remove previous save_format logic.
(parse_format): Do not use the format caching facility if the current
unit is an internal unit or if it is not safe to save parsed format
data.
2009-06-29 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/40576

56
libgfortran/io/format.c
View File

@ -578,16 +578,16 @@ format_lex (format_data *fmt)
* parenthesis node which contains the rest of the list. */
static fnode *
parse_format_list (st_parameter_dt *dtp)
parse_format_list (st_parameter_dt *dtp, bool *save_ok)
{
fnode *head, *tail;
format_token t, u, t2;
int repeat;
format_data *fmt = dtp->u.p.fmt;
bool save_format;
bool saveit;
head = tail = NULL;
save_format = !is_internal_unit (dtp);
saveit = *save_ok;
/* Get the next format item */
format_item:
@ -604,7 +604,7 @@ parse_format_list (st_parameter_dt *dtp)
case FMT_LPAREN:
get_fnode (fmt, &head, &tail, FMT_LPAREN);
tail->repeat = repeat;
tail->u.child = parse_format_list (dtp);
tail->u.child = parse_format_list (dtp, &saveit);
if (fmt->error != NULL)
goto finished;
@ -631,7 +631,7 @@ parse_format_list (st_parameter_dt *dtp)
case FMT_LPAREN:
get_fnode (fmt, &head, &tail, FMT_LPAREN);
tail->repeat = 1;
tail->u.child = parse_format_list (dtp);
tail->u.child = parse_format_list (dtp, &saveit);
if (fmt->error != NULL)
goto finished;
@ -687,8 +687,9 @@ parse_format_list (st_parameter_dt *dtp)
goto between_desc;
case FMT_STRING:
/* TODO: Find out why is is necessary to turn off format caching. */
saveit = false;
get_fnode (fmt, &head, &tail, FMT_STRING);
tail->u.string.p = fmt->string;
tail->u.string.length = fmt->value;
tail->repeat = 1;
@ -698,7 +699,6 @@ parse_format_list (st_parameter_dt *dtp)
case FMT_DP:
notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: DC or DP "
"descriptor not allowed");
save_format = true;
/* Fall through. */
case FMT_S:
case FMT_SS:
@ -724,10 +724,8 @@ parse_format_list (st_parameter_dt *dtp)
get_fnode (fmt, &head, &tail, FMT_DOLLAR);
tail->repeat = 1;
notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor");
save_format = false;
goto between_desc;
case FMT_T:
case FMT_TL:
case FMT_TR:
@ -759,7 +757,6 @@ parse_format_list (st_parameter_dt *dtp)
case FMT_H:
get_fnode (fmt, &head, &tail, FMT_STRING);
if (fmt->format_string_len < 1)
{
fmt->error = bad_hollerith;
@ -822,7 +819,6 @@ parse_format_list (st_parameter_dt *dtp)
fmt->saved_token = t;
fmt->value = 1; /* Default width */
notify_std (&dtp->common, GFC_STD_GNU, posint_required);
save_format = false;
}
}
@ -959,7 +955,6 @@ parse_format_list (st_parameter_dt *dtp)
}
get_fnode (fmt, &head, &tail, FMT_STRING);
tail->u.string.p = fmt->format_string;
tail->u.string.length = repeat;
tail->repeat = 1;
@ -1074,6 +1069,9 @@ parse_format_list (st_parameter_dt *dtp)
goto format_item;
finished:
*save_ok = saveit;
return head;
}
@ -1166,18 +1164,23 @@ void
parse_format (st_parameter_dt *dtp)
{
format_data *fmt;
bool format_cache_ok;
format_cache_ok = !is_internal_unit (dtp);
/* Lookup format string to see if it has already been parsed. */
dtp->u.p.fmt = find_parsed_format (dtp);
if (dtp->u.p.fmt != NULL)
if (format_cache_ok)
{
dtp->u.p.fmt->reversion_ok = 0;
dtp->u.p.fmt->saved_token = FMT_NONE;
dtp->u.p.fmt->saved_format = NULL;
reset_fnode_counters (dtp);
return;
dtp->u.p.fmt = find_parsed_format (dtp);
if (dtp->u.p.fmt != NULL)
{
dtp->u.p.fmt->reversion_ok = 0;
dtp->u.p.fmt->saved_token = FMT_NONE;
dtp->u.p.fmt->saved_format = NULL;
reset_fnode_counters (dtp);
return;
}
}
/* Not found so proceed as follows. */
@ -1191,12 +1194,12 @@ parse_format (st_parameter_dt *dtp)
fmt->error = NULL;
fmt->value = 0;
/* Initialize variables used during traversal of the tree */
/* Initialize variables used during traversal of the tree. */
fmt->reversion_ok = 0;
fmt->saved_format = NULL;
/* Allocate the first format node as the root of the tree */
/* Allocate the first format node as the root of the tree. */
fmt->last = &fmt->array;
fmt->last->next = NULL;
@ -1208,7 +1211,7 @@ parse_format (st_parameter_dt *dtp)
fmt->avail++;
if (format_lex (fmt) == FMT_LPAREN)
fmt->array.array[0].u.child = parse_format_list (dtp);
fmt->array.array[0].u.child = parse_format_list (dtp, &format_cache_ok);
else
fmt->error = "Missing initial left parenthesis in format";
@ -1219,9 +1222,10 @@ parse_format (st_parameter_dt *dtp)
return;
}
/* TODO: Interim fix for PR40508. Revise this for PR40330. */
if (!is_internal_unit(dtp))
if (format_cache_ok)
save_parsed_format (dtp);
else
dtp->u.p.format_not_saved = 1;
}

4
libgfortran/io/io.h
View File

@ -481,7 +481,9 @@ typedef struct st_parameter_dt
unsigned at_eof : 1;
/* Used for g0 floating point output. */
unsigned g0_no_blanks : 1;
/* 15 unused bits. */
/* Used to signal use of free_format_data. */
unsigned format_not_saved : 1;
/* 14 unused bits. */
char last_char;
char nml_delim;

4
libgfortran/io/transfer.c
View File

@ -3251,7 +3251,7 @@ void
st_read_done (st_parameter_dt *dtp)
{
finalize_transfer (dtp);
if (is_internal_unit (dtp))
if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
free_format_data (dtp->u.p.fmt);
free_ionml (dtp);
if (dtp->u.p.current_unit != NULL)
@ -3303,7 +3303,7 @@ st_write_done (st_parameter_dt *dtp)
break;
}
if (is_internal_unit (dtp))
if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
free_format_data (dtp->u.p.fmt);
free_ionml (dtp);
if (dtp->u.p.current_unit != NULL)