[Patch] c-format.c/Fortran: Support %wd / host-wide integer in gfc_error (Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514)

Jakub Jelinek jakub@redhat.com
Fri Aug 20 11:56:34 GMT 2021


On Fri, Aug 20, 2021 at 01:50:00PM +0200, Tobias Burnus wrote:
> On 20.08.21 11:16, Jakub Jelinek wrote:
> 
> > Now, the non-Fortran FE diagnostic code actually has %wd for this (w
> > modifier like l modifier), which takes HOST_WIDE_INT/unsigned HOST_WIDE_INT
> > argument and prints it.
> > 
> > So, either you get through the hops to support that, unfortunately it isn't
> > just adding support for that in fortran/error.c (error_print) and some
> > helper functions, which wouldn't be that hard, just add 'w' next to 'l'
> > handling, TYPE_* for that and union member etc., but one needs to modify
> > c-family/c-format.c too to register the modifier so that gcc doesn't warn
> > about it and knows the proper argument type etc.
> 
> That's what the attached patch does.
> 
> Build on x86-64 GNU Linux; I tried to build it with -m32 (cf. my
> previous email) but as I did not run into the original issue, this does
> not proof much.
> 
> Comments? OK?

LGTM (except that the last hunk won't apply anymore).

> 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): Replace
> 	HOST_WIDE_INT_PRINT_DEC by '%wd'.
> 
> diff --git a/gcc/c-family/c-format.c b/gcc/c-family/c-format.c
> index 6fd0bb33d21..b4cb765a9d3 100644
> --- 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 529d97fff8a..5e6e87316a6 100644
> --- 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 492867e12cb..4cb73e836c7 100644
> --- a/gcc/fortran/simplify.c
> +++ b/gcc/fortran/simplify.c
> @@ -4554,8 +4554,7 @@ substring_has_constant_len (gfc_expr *e)
>      {
>        if (istart < 1)
>  	{
> -	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L below 1",
> +	  gfc_error ("Substring start index (%wd) at %L below 1",
>  		     istart, &ref->u.ss.start->where);
>  	  return false;
>  	}
> @@ -4567,8 +4566,7 @@ substring_has_constant_len (gfc_expr *e)
>  	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
>        if (iend > length)
>  	{
> -	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
> -		     ") at %L exceeds string length",
> +	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
>  		     iend, &ref->u.ss.end->where);
>  	  return false;
>  	}


	Jakub



More information about the Gcc-patches mailing list