diff options
| author | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-11-03 15:22:25 +0000 |
|---|---|---|
| committer | jvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4> | 2010-11-03 15:22:25 +0000 |
| commit | 6a06f1b6290e779615bb53c7ed9a890233b8d205 (patch) | |
| tree | d6041abde64a2fa3e650a14db834c717c03b2a4c /libgfortran | |
| parent | 91cf53d57229fde78340ed7c24e3d07cc5b524eb (diff) | |
| download | gcc-6a06f1b6290e779615bb53c7ed9a890233b8d205.tar.gz | |
2010-11-03 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/43899
* runtime/error.c (generate_warning): New function to generate a run
time warning message. Fix some whitespace.
* libgfortran.h: Add prototype for new function.
* io/list_read.c (nml_read_obj): Use new function to warn when a
character namelist object is truncated. Only warn if compiled
with -fbounds-check.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@166252 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 10 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 14 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 3 | ||||
| -rw-r--r-- | libgfortran/runtime/error.c | 15 |
4 files changed, 40 insertions, 2 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 4a67c8f2d1e..78589f5fd2c 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2010-11-03 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libgfortran/43899 + * runtime/error.c (generate_warning): New function to generate a run + time warning message. Fix some whitespace. + * libgfortran.h: Add prototype for new function. + * io/list_read.c (nml_read_obj): Use new function to warn when a + character namelist object is truncated. Only warn if compiled + with -fbounds-check. + 2010-11-02 Janne Blomqvist <jb@gcc.gnu.org> PR libfortran/45629 diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 34514ca0c54..5203bb76c50 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2586,7 +2586,19 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, break; case BT_CHARACTER: - m = (dlen < dtp->u.p.saved_used) ? dlen : dtp->u.p.saved_used; + if (dlen < dtp->u.p.saved_used) + { + if (compile_options.bounds_check) + { + snprintf (nml_err_msg, nml_err_msg_size, + "Namelist object '%s' truncated on read.", + nl->var_name); + generate_warning (&dtp->common, nml_err_msg); + } + m = dlen; + } + else + m = dtp->u.p.saved_used; pdata = (void*)( pdata + clow - 1 ); memcpy (pdata, dtp->u.p.saved_string, m); if (m < dlen) diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index cadd4367e4c..c5dd91a776a 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -733,6 +733,9 @@ internal_proto(translate_error); extern void generate_error (st_parameter_common *, int, const char *); iexport_proto(generate_error); +extern void generate_warning (st_parameter_common *, const char *); +internal_proto(generate_warning); + extern try notify_std (st_parameter_common *, int, const char *); internal_proto(notify_std); diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 65983ad4cb5..1baf9d35d1f 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -443,6 +443,20 @@ generate_error (st_parameter_common *cmp, int family, const char *message) } iexport(generate_error); + +/* generate_warning()-- Similar to generate_error but just give a warning. */ + +void +generate_warning (st_parameter_common *cmp, const char *message) +{ + if (message == NULL) + message = " "; + + show_locus (cmp); + st_printf ("Fortran runtime warning: %s\n", message); +} + + /* Whether, for a feature included in a given standard set (GFC_STD_*), we should issue an error or a warning, or be quiet. */ @@ -462,7 +476,6 @@ notification_std (int std) } - /* Possibly issue a warning/error about use of a nonstandard (or deleted) feature. An error/warning will be issued if the currently selected standard does not contain the requested bits. */ |