re PR fortran/32860 (Support %ld (for "long") for gfc_warning)

	PR fortran/32860

	* error.c (error_uinteger): New function.
	(error_integer): Call error_uinteger.
	(error_print): Handle %u, %lu, %li and %ld format specifiers.
	* interface.c (compare_actual_formal): Use the new %lu specifier.

	* c-format.c (gcc_gfc_length_specs): New array.
	(gcc_gfc_char_table): Add unsigned specifier, and references to
	the l length modifier.
	(format_types_orig): Use the new gcc_gfc_length_specs.

	* gcc.dg/format/gcc_gfc-1.c: Updated with new formats.

From-SVN: r127382

3 files changed, 75 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9e82b0f..a6e5c9e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	PR fortran/32860
+	* error.c (error_uinteger): New function.
+	(error_integer): Call error_uinteger.
+	(error_print): Handle %u, %lu, %li and %ld format specifiers.
+	* interface.c (compare_actual_formal): Use the new %lu specifier.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/31629
 	* lang.opt (-fmodule-private): New option.
 	* gfortran.h (gfc_option_t): Add flag_module_private member.
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 24e54af..add23ce 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -113,19 +113,13 @@ error_string (const char *p)
 
 /* Print a formatted integer to the error buffer or output.  */
 
-#define IBUF_LEN 30
+#define IBUF_LEN 60
 
 static void
-error_integer (int i)
+error_uinteger (unsigned long int i)
 {
   char *p, int_buf[IBUF_LEN];
 
-  if (i < 0)
-    {
-      i = -i;
-      error_char ('-');
-    }
-
   p = int_buf + IBUF_LEN - 1;
   *p-- = '\0';
 
@@ -141,6 +135,22 @@ error_integer (int i)
   error_string (p + 1);
 }
 
+static void
+error_integer (long int i)
+{
+  unsigned long int u;
+
+  if (i < 0)
+    {
+      u = (unsigned long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
 
 /* Show the file, where it was included, and the source line, give a
    locus.  Calls error_printf() recursively, but the recursion is at
@@ -368,7 +378,8 @@ show_loci (locus *l1, locus *l2)
 static void ATTRIBUTE_GCC_GFC(2,0)
 error_print (const char *type, const char *format0, va_list argp)
 {
-  enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_CHAR, TYPE_STRING,
+  enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
+         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
 	 NOTYPE };
   struct
   {
@@ -377,6 +388,9 @@ error_print (const char *type, const char *format0, va_list argp)
     union
     {
       int intval;
+      unsigned int uintval;
+      long int longintval;
+      unsigned long int ulongintval;
       char charval;
       const char * stringval;
     } u;
@@ -453,6 +467,19 @@ error_print (const char *type, const char *format0, va_list argp)
 	    arg[pos].type = TYPE_INTEGER;
 	    break;
 
+	  case 'u':
+	    arg[pos].type = TYPE_UINTEGER;
+
+	  case 'l':
+	    c = *format++;
+	    if (c == 'u')
+	      arg[pos].type = TYPE_ULONGINT;
+	    else if (c == 'i' || c == 'd')
+	      arg[pos].type = TYPE_LONGINT;
+	    else
+	      gcc_unreachable ();
+	    break;
+
 	  case 'c':
 	    arg[pos].type = TYPE_CHAR;
 	    break;
@@ -499,6 +526,18 @@ error_print (const char *type, const char *format0, va_list argp)
 	    arg[pos].u.intval = va_arg (argp, int);
 	    break;
 
+	  case TYPE_UINTEGER:
+	    arg[pos].u.uintval = va_arg (argp, unsigned int);
+	    break;
+
+	  case TYPE_LONGINT:
+	    arg[pos].u.longintval = va_arg (argp, long int);
+	    break;
+
+	  case TYPE_ULONGINT:
+	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
+	    break;
+
 	  case TYPE_CHAR:
 	    arg[pos].u.charval = (char) va_arg (argp, int);
 	    break;
@@ -568,6 +607,19 @@ error_print (const char *type, const char *format0, va_list argp)
 	case 'i':
 	  error_integer (spec[n++].u.intval);
 	  break;
+
+	case 'u':
+	  error_uinteger (spec[n++].u.uintval);
+	  break;
+
+	case 'l':
+	  format++;
+	  if (*format == 'u')
+	    error_uinteger (spec[n++].u.ulongintval);
+	  else
+	    error_integer (spec[n++].u.longintval);
+	  break;
+
 	}
     }
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 293a54a..dbd7538 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1680,14 +1680,14 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	{
 	  if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
 	    gfc_warning ("Character length of actual argument shorter "
-			"than of dummy argument '%s' (%d/%d) at %L",
-			f->sym->name, (int) actual_size,
-			(int) formal_size, &a->expr->where);
+			"than of dummy argument '%s' (%lu/%lu) at %L",
+			f->sym->name, actual_size, formal_size,
+			&a->expr->where);
           else if (where)
 	    gfc_warning ("Actual argument contains too few "
-			"elements for dummy argument '%s' (%d/%d) at %L",
-			f->sym->name, (int) actual_size,
-			(int) formal_size, &a->expr->where);
+			"elements for dummy argument '%s' (%lu/%lu) at %L",
+			f->sym->name, actual_size, formal_size,
+			&a->expr->where);
 	  return  0;
 	}