re PR fortran/43899 (Wrong unused-variable warning with NAMELISTs)

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.

From-SVN: r166252

libgfortran/ChangeLog

+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

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)

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);
 

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.  */