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

7 files changed, 104 insertions, 19 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 671afbf..e2dbe3b 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,11 @@
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	PR fortran/32860
+	* 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.
+
 2007-08-12  Sa Liu  <saliu@de.ibm.com>
 
 	* emit-rtl.c (try_split): Relink the insns with REG_LIBCALL note
diff --git a/gcc/c-format.c b/gcc/c-format.c
index 9994cf4..8a36dd4 100644
--- a/gcc/c-format.c
+++ b/gcc/c-format.c
@@ -342,6 +342,15 @@ static const format_length_info strfmon_length_specs[] =
   { NULL, 0, 0, NULL, 0, 0 }
 };
 
+
+/* For now, the Fortran front-end routines only use l as length modifier.  */
+static const format_length_info gcc_gfc_length_specs[] =
+{
+  { "l", FMT_LEN_l, STD_C89, NULL, 0, 0 },
+  { NULL, 0, 0, NULL, 0, 0 }
+};
+
+
 static const format_flag_spec printf_flag_specs[] =
 {
   { ' ',  0, 0, N_("' ' flag"),        N_("the ' ' printf flag"),              STD_C89 },
@@ -631,7 +640,8 @@ static const format_char_info gcc_cxxdiag_char_table[] =
 static const format_char_info gcc_gfc_char_table[] =
 {
   /* C89 conversion specifiers.  */
-  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "", "", NULL },
+  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "", "", NULL },
+  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "", "", NULL },
   { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "", "", NULL },
   { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "", "cR", NULL },
 
@@ -738,7 +748,7 @@ static const format_kind_info format_types_orig[] =
     0, 0, 'p', 0, 'L',
     NULL, &integer_type_node
   },
-  { "gcc_gfc", NULL, gcc_gfc_char_table, "", NULL,
+  { "gcc_gfc", gcc_gfc_length_specs, gcc_gfc_char_table, "", NULL,
     NULL, gcc_gfc_flag_pairs,
     FMT_FLAG_ARG_CONVERT,
     0, 0, 0, 0, 0,
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;
 	}
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 33fb738..106fe59 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	PR fortran/32860
+	* gcc.dg/format/gcc_gfc-1.c: Updated with new formats.
+
+2007-08-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/31629
 	* gcc/testsuite/gfortran.dg/module_private_1.f90: New test.
 
diff --git a/gcc/testsuite/gcc.dg/format/gcc_gfc-1.c b/gcc/testsuite/gcc.dg/format/gcc_gfc-1.c
index d23701d..7e079b7 100644
--- a/gcc/testsuite/gcc.dg/format/gcc_gfc-1.c
+++ b/gcc/testsuite/gcc.dg/format/gcc_gfc-1.c
@@ -11,11 +11,13 @@ typedef struct locus locus;
 extern int gfc_warn (const char *, ...) __attribute__ ((__format__ (__gcc_gfc__, 1, 2))) __attribute__ ((__nonnull__));
 
 void
-foo (int i, char *s, long int l, llong ll, locus *loc)
+foo (unsigned int u, int i, char *s, unsigned long int ul, long int l,
+     llong ll, locus *loc)
 {
   /* Acceptable C90 specifiers, flags and modifiers.  */
   gfc_warn ("%%");
-  gfc_warn ("%d%i%c%s%%", i, i, i, s);
+  gfc_warn ("%u%d%i%c%s%%", u, i, i, i, s);
+  gfc_warn ("%lu%ld%li%%", ul, l, l);
 
   /* Extensions provided in gfc_warn.  */
   gfc_warn ("%C");