re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$…

re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

gcc/fortran/ChangeLog:

2014-11-23  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* decl.c (gfc_verify_c_interop_param): Use gfc_error_now_2.
	(gfc_set_constant_character_len): Use gfc_warning_now_2.
	* resolve.c (resolve_ordinary_assign): Likewise.
	* gfortran.h (warn_character_truncation): Do not declare here.
	* error.c (gfc_format_decoder): Handle %L.
	* lang.opt (Wcharacter-truncation): Add Var and LangEnabledBy.
	* options.c (gfc_init_options): Do not handle
	warn_character_truncation explicitly.
	(set_Wall): Likewise.
	(gfc_handle_option): Likewise.

From-SVN: r217992
parent 875d4ba7
2014-11-23 Manuel López-Ibáñez <manu@gcc.gnu.org>
PR fortran/44054
* decl.c (gfc_verify_c_interop_param): Use gfc_error_now_2.
(gfc_set_constant_character_len): Use gfc_warning_now_2.
* resolve.c (resolve_ordinary_assign): Likewise.
* gfortran.h (warn_character_truncation): Do not declare here.
* error.c (gfc_format_decoder): Handle %L.
* lang.opt (Wcharacter-truncation): Add Var and LangEnabledBy.
* options.c (gfc_init_options): Do not handle
warn_character_truncation explicitly.
(set_Wall): Likewise.
(gfc_handle_option): Likewise.
2014-11-23 Tobias Burnus <burnus@net-b.de> 2014-11-23 Tobias Burnus <burnus@net-b.de>
* invoke.texi (-Wtabs): Swap -Wtabs/-Wno-tabs now that * invoke.texi (-Wtabs): Swap -Wtabs/-Wno-tabs now that
......
...@@ -990,10 +990,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym) ...@@ -990,10 +990,9 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
{ {
if (sym->attr.is_bind_c == 0) if (sym->attr.is_bind_c == 0)
{ {
gfc_error_now ("Procedure '%s' at %L must have the BIND(C) " gfc_error_now_2 ("Procedure %qs at %L must have the BIND(C) "
"attribute to be C interoperable", sym->name, "attribute to be C interoperable", sym->name,
&(sym->declared_at)); &(sym->declared_at));
return false; return false;
} }
else else
...@@ -1224,9 +1223,10 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len) ...@@ -1224,9 +1223,10 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, int check_len)
if (len > slen) if (len > slen)
gfc_wide_memset (&s[slen], ' ', len - slen); gfc_wide_memset (&s[slen], ' ', len - slen);
if (gfc_option.warn_character_truncation && slen > len) if (warn_character_truncation && slen > len)
gfc_warning_now ("CHARACTER expression at %L is being truncated " gfc_warning_now_2 (OPT_Wcharacter_truncation,
"(%d/%d)", &expr->where, slen, len); "CHARACTER expression at %L is being truncated "
"(%d/%d)", &expr->where, slen, len);
/* Apply the standard by 'hand' otherwise it gets cleared for /* Apply the standard by 'hand' otherwise it gets cleared for
initializers. */ initializers. */
......
...@@ -964,6 +964,7 @@ gfc_warning_now (const char *gmsgid, ...) ...@@ -964,6 +964,7 @@ gfc_warning_now (const char *gmsgid, ...)
to handle Fortran specific format specifiers with the following meanings: to handle Fortran specific format specifiers with the following meanings:
%C Current locus (no argument) %C Current locus (no argument)
%L Takes locus argument
*/ */
static bool static bool
gfc_format_decoder (pretty_printer *pp, gfc_format_decoder (pretty_printer *pp,
...@@ -974,15 +975,21 @@ gfc_format_decoder (pretty_printer *pp, ...@@ -974,15 +975,21 @@ gfc_format_decoder (pretty_printer *pp,
switch (*spec) switch (*spec)
{ {
case 'C': case 'C':
case 'L':
{ {
static const char *result = "(1)"; static const char *result = "(1)";
gcc_assert (gfc_current_locus.nextc - gfc_current_locus.lb->line >= 0); locus *loc;
unsigned int c1 = gfc_current_locus.nextc - gfc_current_locus.lb->line; if (*spec == 'C')
loc = &gfc_current_locus;
else
loc = va_arg (*text->args_ptr, locus *);
gcc_assert (loc->nextc - loc->lb->line >= 0);
unsigned int offset = loc->nextc - loc->lb->line;
gcc_assert (text->locus); gcc_assert (text->locus);
*text->locus *text->locus
= linemap_position_for_loc_and_offset (line_table, = linemap_position_for_loc_and_offset (line_table,
gfc_current_locus.lb->location, loc->lb->location,
c1); offset);
global_dc->caret_char = '1'; global_dc->caret_char = '1';
pp_string (pp, result); pp_string (pp, result);
return true; return true;
......
...@@ -2455,7 +2455,6 @@ typedef struct ...@@ -2455,7 +2455,6 @@ typedef struct
int warn_underflow; int warn_underflow;
int warn_intrinsic_shadow; int warn_intrinsic_shadow;
int warn_intrinsics_std; int warn_intrinsics_std;
int warn_character_truncation;
int warn_array_temp; int warn_array_temp;
int warn_align_commons; int warn_align_commons;
int warn_real_q_constant; int warn_real_q_constant;
......
...@@ -218,7 +218,7 @@ Fortran ...@@ -218,7 +218,7 @@ Fortran
; Documented in C ; Documented in C
Wcharacter-truncation Wcharacter-truncation
Fortran Warning Fortran Var(warn_character_truncation) Warning LangEnabledBy(Fortran,Wall)
Warn about truncated character expressions Warn about truncated character expressions
Wcompare-reals Wcompare-reals
......
...@@ -95,7 +95,6 @@ gfc_init_options (unsigned int decoded_options_count, ...@@ -95,7 +95,6 @@ gfc_init_options (unsigned int decoded_options_count,
gfc_option.warn_aliasing = 0; gfc_option.warn_aliasing = 0;
gfc_option.warn_ampersand = 0; gfc_option.warn_ampersand = 0;
gfc_option.warn_character_truncation = 0;
gfc_option.warn_array_temp = 0; gfc_option.warn_array_temp = 0;
gfc_option.warn_c_binding_type = 0; gfc_option.warn_c_binding_type = 0;
gfc_option.gfc_warn_conversion = 0; gfc_option.gfc_warn_conversion = 0;
...@@ -460,7 +459,6 @@ set_Wall (int setting) ...@@ -460,7 +459,6 @@ set_Wall (int setting)
gfc_option.warn_underflow = setting; gfc_option.warn_underflow = setting;
gfc_option.warn_intrinsic_shadow = setting; gfc_option.warn_intrinsic_shadow = setting;
gfc_option.warn_intrinsics_std = setting; gfc_option.warn_intrinsics_std = setting;
gfc_option.warn_character_truncation = setting;
gfc_option.warn_real_q_constant = setting; gfc_option.warn_real_q_constant = setting;
gfc_option.warn_unused_dummy_argument = setting; gfc_option.warn_unused_dummy_argument = setting;
gfc_option.warn_target_lifetime = setting; gfc_option.warn_target_lifetime = setting;
...@@ -663,10 +661,6 @@ gfc_handle_option (size_t scode, const char *arg, int value, ...@@ -663,10 +661,6 @@ gfc_handle_option (size_t scode, const char *arg, int value,
gfc_option.warn_c_binding_type = value; gfc_option.warn_c_binding_type = value;
break; break;
case OPT_Wcharacter_truncation:
gfc_option.warn_character_truncation = value;
break;
case OPT_Wcompare_reals: case OPT_Wcompare_reals:
gfc_option.warn_compare_reals = value; gfc_option.warn_compare_reals = value;
break; break;
......
...@@ -9208,7 +9208,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) ...@@ -9208,7 +9208,7 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
} }
if (lhs->ts.type == BT_CHARACTER if (lhs->ts.type == BT_CHARACTER
&& gfc_option.warn_character_truncation) && warn_character_truncation)
{ {
if (lhs->ts.u.cl != NULL if (lhs->ts.u.cl != NULL
&& lhs->ts.u.cl->length != NULL && lhs->ts.u.cl->length != NULL
...@@ -9224,9 +9224,10 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns) ...@@ -9224,9 +9224,10 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer); rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
if (rlen && llen && rlen > llen) if (rlen && llen && rlen > llen)
gfc_warning_now ("CHARACTER expression will be truncated " gfc_warning_now_2 (OPT_Wcharacter_truncation,
"in assignment (%d/%d) at %L", "CHARACTER expression will be truncated "
llen, rlen, &code->loc); "in assignment (%d/%d) at %L",
llen, rlen, &code->loc);
} }
/* Ensure that a vector index expression for the lvalue is evaluated /* Ensure that a vector index expression for the lvalue is evaluated
......
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