diff options
author | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-05-20 07:14:50 +0000 |
---|---|---|
committer | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2006-05-20 07:14:50 +0000 |
commit | 887d008639e4cfaf6d358bdf56a877aaa6f5e7a8 (patch) | |
tree | 72d7a6767678cfbc49746dd70c1193e00863af45 /libgfortran/io | |
parent | 0c520ffbcf46916294cbdb02ec1b758853086351 (diff) | |
download | gcc-887d008639e4cfaf6d358bdf56a877aaa6f5e7a8.tar.gz |
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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@113924 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran/io')
-rw-r--r-- | libgfortran/io/io.h | 4 | ||||
-rw-r--r-- | libgfortran/io/list_read.c | 47 |
2 files changed, 44 insertions, 7 deletions
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e7581a6da0b..2d3c185a087 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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. */ diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index ab3965d5f58..0670efab86f 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -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)) |