From 6a78072d36ae9f17efded1ff6f8f85f610ffe715 Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Sun, 12 Aug 2007 20:39:18 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127382 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ChangeLog | 8 ++++ gcc/c-format.c | 14 ++++++- gcc/fortran/ChangeLog | 8 ++++ gcc/fortran/error.c | 70 ++++++++++++++++++++++++++++----- gcc/fortran/interface.c | 12 +++--- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gcc.dg/format/gcc_gfc-1.c | 6 ++- 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 + + 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 * 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 + 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 + 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 + PR fortran/32860 + * gcc.dg/format/gcc_gfc-1.c: Updated with new formats. + +2007-08-12 Francois-Xavier Coudert + 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"); -- 2.7.4