diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 774a2b8cbdc78b90cd6da52548836b17a7ad81e1..7f6010631014788c358fb553b7e98e4cc739d097 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -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 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index e7581a6da0b979993fe2d2e8eee26b042efad029..2d3c185a08769bb4e883ccccfef0721992da0f82 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 ab3965d5f5800c62842f9f8ebc0eb520901e55f5..0670efab86f34f24567f2ff8dc4a36bbdc447201 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))