Skip to content

R
riscv-gcc-1
Commit 096f0d9d by Francois-Xavier Coudert Committed by François-Xavier Coudert
Options

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
parent 654b6073
Showing with 104 additions and 19 deletions
gcc/ChangeLog
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
......
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,
......
gcc/fortran/ChangeLog
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.
......
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;
}
}
......
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;
}
......
gcc/testsuite/ChangeLog
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.
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");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment