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

re PR libfortran/24459 ([4.1 Only] gfortran namelist problem)

Browse Source 
2006-05-20  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/24459
	* io/list_read.c (nml_parse_qualifier): Leave loop spec end value
	at default value unless -std=f95 or if an array section
	is specified in namelist input.  Warn if -pedantic.
	* io/io.h (st_parameter_dt): Add expanded_read flag.

From-SVN: r113924
This commit is contained in:
Jerry DeLisle 2006-05-20 07:14:50 +00:00
parent 8bf6519618
commit 25292a1bf1
3 changed files with 52 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
libgfortran/ChangeLog
View File

@ -1,3 +1,11 @@
2006-05-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/24459
* io/list_read.c (nml_parse_qualifier): Leave loop spec end value
at default value unless -std=f95 or if an array section
is specified in namelist input. Warn if -pedantic.
* io/io.h (st_parameter_dt): Add expanded_read flag.
2006-05-19 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/22423

4
libgfortran/io/io.h
View File

@ -432,7 +432,9 @@ typedef struct st_parameter_dt
struct format_data *fmt;
jmp_buf *eof_jump;
namelist_info *ionml;
/* A flag used to identify when a non-standard expanded namelist read
has occurred. */
int expanded_read;
/* Storage area for values except for strings. Must be large
enough to hold a complex value (two reals) of the largest
kind. */

47
libgfortran/io/list_read.c
View File

@ -1660,8 +1660,12 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
int indx;
int neg;
int null_flag;
int is_array_section;
char c;
is_array_section = 0;
dtp->u.p.expanded_read = 0;
/* The next character in the stream should be the '('. */
c = next_char (dtp);
@ -1700,6 +1704,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
switch (c)
{
case ':':
is_array_section = 1;
break;
case ',': case ')':
@ -1775,7 +1780,14 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
if (indx == 0)
{
memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
ls[dim].end = ls[dim].start;
/* If -std=f95/2003 or an array section is specified,
do not allow excess data to be processed. */
if (is_array_section == 1
|| compile_options.allow_std < GFC_STD_GNU)
ls[dim].end = ls[dim].start;
else
dtp->u.p.expanded_read = 1;
}
break;
}
@ -2112,6 +2124,10 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
strcpy (obj_name, nl->var_name);
strcat (obj_name, "%");
/* If reading a derived type, disable the expanded read warning
since a single object can have multiple reads. */
dtp->u.p.expanded_read = 0;
/* Now loop over the components. Update the component pointer
with the return value from nml_write_obj. This loop jumps
past nested derived types by testing if the potential
@ -2157,11 +2173,16 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
*pprev_nl = nl;
if (dtp->u.p.nml_read_error)
return SUCCESS;
{
dtp->u.p.expanded_read = 0;
return SUCCESS;
}
if (dtp->u.p.saved_type == GFC_DTYPE_UNKNOWN)
goto incr_idx;
{
dtp->u.p.expanded_read = 0;
goto incr_idx;
}
/* Note the switch from GFC_DTYPE_type to BT_type at this point.
This comes about because the read functions return BT_types. */
@ -2182,14 +2203,27 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
memcpy (pdata, dtp->u.p.saved_string, m);
if (m < dlen)
memset ((void*)( pdata + m ), ' ', dlen - m);
break;
break;
default:
break;
}
/* Break out of loop if scalar. */
/* Warn if a non-standard expanded read occurs. A single read of a
single object is acceptable. If a second read occurs, issue a warning
and set the flag to zero to prevent further warnings. */
if (dtp->u.p.expanded_read == 2)
{
notify_std (GFC_STD_GNU, "Non-standard expanded namelist read.");
dtp->u.p.expanded_read = 0;
}
/* If the expanded read warning flag is set, increment it,
indicating that a single read has occured. */
if (dtp->u.p.expanded_read >= 1)
dtp->u.p.expanded_read++;
/* Break out of loop if scalar. */
if (!nl->var_rank)
break;
@ -2500,6 +2534,7 @@ namelist_read (st_parameter_dt *dtp)
dtp->u.p.namelist_mode = 1;
dtp->u.p.input_complete = 0;
dtp->u.p.expanded_read = 0;
dtp->u.p.eof_jump = &eof_jump;
if (setjmp (eof_jump))