From 25292a1bf11f04826b61027db2808a735d26f62a Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sat, 20 May 2006 07:14:50 +0000
Subject: [PATCH] re PR libfortran/24459 ([4.1 Only] gfortran namelist problem)
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
---
libgfortran/ChangeLog | 8 +++++++
libgfortran/io/io.h | 4 +++-
libgfortran/io/list_read.c | 47 +++++++++++++++++++++++++++++++++-----
3 files changed, 52 insertions(+), 7 deletions(-)
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 774a2b8cbdc7..7f6010631014 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 e7581a6da0b9..2d3c185a0876 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 ab3965d5f580..0670efab86f3 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))
--
GitLab