c-format.c/Fortran: Support %wd / host-wide integer in gfc_error

This patch adds support for the 'll' (long double)
and 'w' (HOST_WIDE_INT) length modifiers to the
Fortran FE diagnostic function (gfc_error, gfc_warning, ...)

gcc/c-family/ChangeLog:

	* c-format.c (gcc_gfc_length_specs): Add 'll' and 'w'.
	(gcc_gfc_char_table): Add T9L_LL and T9L_ULL to
	"di" and "u", respecitively; fill with BADLEN to match
	size of 'types'.
	(get_init_dynamic_hwi): Split off from ...
	(init_dynamic_diag_info): ... here. Call it.
	(init_dynamic_gfc_info): Call it.

gcc/fortran/ChangeLog:

	* error.c
	(error_uinteger): Take 'long long unsigned' instead
	of 'long unsigned' as argumpent.
	(error_integer): Take 'long long' instead of 'long'.
	(error_hwuint, error_hwint): New.
	(error_print): Update to handle 'll' and 'w'
	length modifiers.
	* simplify.c (substring_has_constant_len): Use '%wd'
	in gfc_error.

diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
index 6fd0bb3..b4cb765 100644 (file)
--- a/gcc/c-family/c-format.c
+++ b/gcc/c-family/c-format.c
@@ -546,10 +546,11 @@ static const format_length_info strfmon_length_specs[] =
 };
 
 
-/* For now, the Fortran front-end routines only use l as length modifier.  */
+/* Length modifiers used by the fortran/error.c routines.  */
 static const format_length_info gcc_gfc_length_specs[] =
 {
-  { "l", FMT_LEN_l, STD_C89, NO_FMT, 0 },
+  { "l", FMT_LEN_l, STD_C89, "ll", FMT_LEN_ll, STD_C89, 0 },
+  { "w", FMT_LEN_w, STD_C89, NO_FMT, 0 },
   { NO_FMT, NO_FMT, 0 }
 };
 
@@ -821,10 +822,10 @@ 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,  T89_L,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "", NULL },
-  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN  }, "q", "cR", NULL },
+  { "di",  0, STD_C89, { T89_I,   BADLEN,  BADLEN,  T89_L,   T9L_LL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "u",   0, STD_C89, { T89_UI,  BADLEN,  BADLEN,  T89_UL,  T9L_ULL,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN  }, "q", "", NULL },
+  { "c",   0, STD_C89, { T89_I,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "", NULL },
+  { "s",   1, STD_C89, { T89_C,   BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN,  BADLEN, BADLEN, BADLEN, BADLEN }, "q", "cR", NULL },
 
   /* gfc conversion specifiers.  */
 
@@ -4843,12 +4844,73 @@ init_dynamic_asm_fprintf_info (void)
     }
 }
 
+static const format_length_info*
+get_init_dynamic_hwi (void)
+{
+  static tree hwi;
+  static format_length_info *diag_ls;
+
+  if (!hwi)
+    {
+      unsigned int i;
+
+      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
+        length modifier to work, one must have issued: "typedef
+        HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
+        prior to using that modifier.  */
+      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
+       {
+         hwi = identifier_global_value (hwi);
+         if (hwi)
+           {
+             if (TREE_CODE (hwi) != TYPE_DECL)
+               {
+                 error ("%<__gcc_host_wide_int__%> is not defined as a type");
+                 hwi = 0;
+               }
+             else
+               {
+                 hwi = DECL_ORIGINAL_TYPE (hwi);
+                 gcc_assert (hwi);
+                 if (hwi != long_integer_type_node
+                     && hwi != long_long_integer_type_node)
+                   {
+                     error ("%<__gcc_host_wide_int__%> is not defined"
+                            " as %<long%> or %<long long%>");
+                     hwi = 0;
+                   }
+               }
+           }
+       }
+      if (!diag_ls)
+       diag_ls = (format_length_info *)
+                 xmemdup (gcc_diag_length_specs,
+                          sizeof (gcc_diag_length_specs),
+                          sizeof (gcc_diag_length_specs));
+      if (hwi)
+       {
+         /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
+         i = find_length_info_modifier_index (diag_ls, 'w');
+         if (hwi == long_integer_type_node)
+           diag_ls[i].index = FMT_LEN_l;
+         else if (hwi == long_long_integer_type_node)
+           diag_ls[i].index = FMT_LEN_ll;
+         else
+           gcc_unreachable ();
+       }
+    }
+  return diag_ls;
+}
+
 /* Determine the type of a "locus" in the code being compiled for use
    in GCC's __gcc_gfc__ custom format attribute.  You must have set
    dynamic_format_types before calling this function.  */
 static void
 init_dynamic_gfc_info (void)
 {
+  dynamic_format_types[gcc_gfc_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
+
   if (!locus)
     {
       static format_char_info *gfc_fci;
@@ -4985,67 +5047,13 @@ init_dynamic_diag_info (void)
       || local_event_ptr_node == void_type_node)
     local_event_ptr_node = get_named_type ("diagnostic_event_id_t");
 
-  static tree hwi;
-
-  if (!hwi)
-    {
-      static format_length_info *diag_ls;
-      unsigned int i;
-
-      /* Find the underlying type for HOST_WIDE_INT.  For the 'w'
-        length modifier to work, one must have issued: "typedef
-        HOST_WIDE_INT __gcc_host_wide_int__;" in one's source code
-        prior to using that modifier.  */
-      if ((hwi = maybe_get_identifier ("__gcc_host_wide_int__")))
-       {
-         hwi = identifier_global_value (hwi);
-         if (hwi)
-           {
-             if (TREE_CODE (hwi) != TYPE_DECL)
-               {
-                 error ("%<__gcc_host_wide_int__%> is not defined as a type");
-                 hwi = 0;
-               }
-             else
-               {
-                 hwi = DECL_ORIGINAL_TYPE (hwi);
-                 gcc_assert (hwi);
-                 if (hwi != long_integer_type_node
-                     && hwi != long_long_integer_type_node)
-                   {
-                     error ("%<__gcc_host_wide_int__%> is not defined"
-                            " as %<long%> or %<long long%>");
-                     hwi = 0;
-                   }
-               }
-           }
-       }
-
-      /* Assign the new data for use.  */
-
-      /* All the GCC diag formats use the same length specs.  */
-      if (!diag_ls)
-       dynamic_format_types[gcc_diag_format_type].length_char_specs =
-         dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
-         dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
-         dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
-         dynamic_format_types[gcc_dump_printf_format_type].length_char_specs =
-         diag_ls = (format_length_info *)
-                   xmemdup (gcc_diag_length_specs,
-                            sizeof (gcc_diag_length_specs),
-                            sizeof (gcc_diag_length_specs));
-      if (hwi)
-       {
-         /* HOST_WIDE_INT must be one of 'long' or 'long long'.  */
-         i = find_length_info_modifier_index (diag_ls, 'w');
-         if (hwi == long_integer_type_node)
-           diag_ls[i].index = FMT_LEN_l;
-         else if (hwi == long_long_integer_type_node)
-           diag_ls[i].index = FMT_LEN_ll;
-         else
-           gcc_unreachable ();
-       }
-    }
+  /* All the GCC diag formats use the same length specs.  */
+  dynamic_format_types[gcc_diag_format_type].length_char_specs =
+    dynamic_format_types[gcc_tdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_cxxdiag_format_type].length_char_specs =
+    dynamic_format_types[gcc_dump_printf_format_type].length_char_specs
+    = get_init_dynamic_hwi ();
 
   /* It's safe to "re-initialize these to the same values.  */
   dynamic_format_types[gcc_diag_format_type].conversion_specs =

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 529d97f..5e6e873 100644 (file)
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -136,7 +136,7 @@ error_string (const char *p)
 #define IBUF_LEN 60
 
 static void
-error_uinteger (unsigned long int i)
+error_uinteger (unsigned long long int i)
 {
   char *p, int_buf[IBUF_LEN];
 
@@ -156,13 +156,50 @@ error_uinteger (unsigned long int i)
 }
 
 static void
-error_integer (long int i)
+error_integer (long long int i)
 {
-  unsigned long int u;
+  unsigned long long int u;
 
   if (i < 0)
     {
-      u = (unsigned long int) -i;
+      u = (unsigned long long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+static void
+error_hwuint (unsigned HOST_WIDE_INT i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_hwint (HOST_WIDE_INT i)
+{
+  unsigned HOST_WIDE_INT u;
+
+  if (i < 0)
+    {
+      u = (unsigned HOST_WIDE_INT) -i;
       error_char ('-');
     }
   else
@@ -482,8 +519,8 @@ 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_UINTEGER,
-         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
-        NOTYPE };
+        TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
+        TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, NOTYPE };
   struct
   {
     int type;
@@ -494,6 +531,10 @@ error_print (const char *type, const char *format0, va_list argp)
       unsigned int uintval;
       long int longintval;
       unsigned long int ulongintval;
+      long long int llongintval;
+      unsigned long long int ullongintval;
+      HOST_WIDE_INT hwintval;
+      unsigned HOST_WIDE_INT hwuintval;
       char charval;
       const char * stringval;
     } u;
@@ -577,7 +618,17 @@ error_print (const char *type, const char *format0, va_list argp)
 
          case 'l':
            c = *format++;
-           if (c == 'u')
+           if (c == 'l')
+             {
+               c = *format++;
+               if (c == 'u')
+                 arg[pos].type = TYPE_ULLONGINT;
+               else if (c == 'i' || c == 'd')
+                 arg[pos].type = TYPE_LLONGINT;
+               else
+                 gcc_unreachable ();
+             }
+           else if (c == 'u')
              arg[pos].type = TYPE_ULONGINT;
            else if (c == 'i' || c == 'd')
              arg[pos].type = TYPE_LONGINT;
@@ -585,6 +636,16 @@ error_print (const char *type, const char *format0, va_list argp)
              gcc_unreachable ();
            break;
 
+         case 'w':
+           c = *format++;
+           if (c == 'u')
+             arg[pos].type = TYPE_HWUINT;
+           else if (c == 'i' || c == 'd')
+             arg[pos].type = TYPE_HWINT;
+           else
+             gcc_unreachable ();
+           break;
+
          case 'c':
            arg[pos].type = TYPE_CHAR;
            break;
@@ -649,6 +710,22 @@ error_print (const char *type, const char *format0, va_list argp)
            arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
            break;
 
+         case TYPE_LLONGINT:
+           arg[pos].u.llongintval = va_arg (argp, long long int);
+           break;
+
+         case TYPE_ULLONGINT:
+           arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
+           break;
+
+         case TYPE_HWINT:
+           arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
+           break;
+
+         case TYPE_HWUINT:
+           arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
+           break;
+
          case TYPE_CHAR:
            arg[pos].u.charval = (char) va_arg (argp, int);
            break;
@@ -725,12 +802,27 @@ error_print (const char *type, const char *format0, va_list argp)
 
        case 'l':
          format++;
+         if (*format == 'l')
+           {
+             format++;
+             if (*format == 'u')
+               error_uinteger (spec[n++].u.ullongintval);
+             else
+               error_integer (spec[n++].u.llongintval);
+           }
          if (*format == 'u')
            error_uinteger (spec[n++].u.ulongintval);
          else
            error_integer (spec[n++].u.longintval);
          break;
 
+       case 'w':
+         format++;
+         if (*format == 'u')
+           error_hwuint (spec[n++].u.hwintval);
+         else
+           error_hwint (spec[n++].u.hwuintval);
+         break;
        }
     }
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index eaabbff..4cb73e8 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,12 +4552,10 @@ substring_has_constant_len (gfc_expr *e)
 
   if (istart <= iend)
     {
-      char buffer[21];
       if (istart < 1)
        {
-         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
-         gfc_error ("Substring start index (%s) at %L below 1",
-                    buffer, &ref->u.ss.start->where);
+         gfc_error ("Substring start index (%wd) at %L below 1",
+                    istart, &ref->u.ss.start->where);
          return false;
        }
 
@@ -4568,9 +4566,8 @@ substring_has_constant_len (gfc_expr *e)
        length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
        {
-         sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
-         gfc_error ("Substring end index (%s) at %L exceeds string length",
-                    buffer, &ref->u.ss.end->where);
+         gfc_error ("Substring end index (%wd) at %L exceeds string length",
+                    iend, &ref->u.ss.end->where);
          return false;
        }
       length = iend - istart + 1;