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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 4a67c8f..78589f5 100644 (file)
--- 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 34514ca..5203bb7 100644 (file)
--- 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 cadd436..c5dd91a 100644 (file)
--- 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 65983ad..1baf9d3 100644 (file)
--- 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.  */