OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2021-08-20 15:43:32 +02:00
parent 12f22906d3
commit 1b507b1e3c
3 changed files with 178 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

142
gcc/c-family/c-format.c
View File

@ -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 =

106
gcc/fortran/error.c
View File

@ -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;
}
}

11
gcc/fortran/simplify.c
View File

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