Exactly what the subject says. I'm not sure if this is appropriate for
stage3, I'll leave that to the Fortran maintainers.
Bootstrapped & regression tested on x86_64-linux-gnu.
Cheers,
Manuel.
gcc/fortran/ChangeLog:
2014-11-23 Manuel López-Ibáñez <m...@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.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 217971)
+++ gcc/fortran/decl.c (working copy)
@@ -988,14 +988,13 @@ gfc_verify_c_interop_param (gfc_symbol *
interoperable. */
if (sym->attr.flavor == FL_PROCEDURE)
{
if (sym->attr.is_bind_c == 0)
{
- gfc_error_now ("Procedure '%s' at %L must have the BIND(C) "
- "attribute to be C interoperable", sym->name,
- &(sym->declared_at));
-
+ gfc_error_now_2 ("Procedure %qs at %L must have the BIND(C) "
+ "attribute to be C interoperable", sym->name,
+ &(sym->declared_at));
return false;
}
else
{
if (sym->attr.is_c_interop == 1)
@@ -1222,13 +1221,14 @@ gfc_set_constant_character_len (int len,
memcpy (s, expr->value.character.string,
MIN (len, slen) * sizeof (gfc_char_t));
if (len > slen)
gfc_wide_memset (&s[slen], ' ', len - slen);
- if (gfc_option.warn_character_truncation && slen > len)
- gfc_warning_now ("CHARACTER expression at %L is being truncated "
- "(%d/%d)", &expr->where, slen, len);
+ if (warn_character_truncation && slen > len)
+ gfc_warning_now_2 (OPT_Wcharacter_truncation,
+ "CHARACTER expression at %L is being truncated "
+ "(%d/%d)", &expr->where, slen, len);
/* Apply the standard by 'hand' otherwise it gets cleared for
initializers. */
if (check_len != -1 && slen != check_len
&& !(gfc_option.allow_std & GFC_STD_GNU))
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 217971)
+++ gcc/fortran/gfortran.h (working copy)
@@ -2454,11 +2454,10 @@ typedef struct
int warn_surprising;
int warn_tabs;
int warn_underflow;
int warn_intrinsic_shadow;
int warn_intrinsics_std;
- int warn_character_truncation;
int warn_array_temp;
int warn_align_commons;
int warn_real_q_constant;
int warn_unused_dummy_argument;
int warn_zerotrip;
Index: gcc/fortran/error.c
===================================================================
--- gcc/fortran/error.c (revision 217971)
+++ gcc/fortran/error.c (working copy)
@@ -962,29 +962,36 @@ gfc_warning_now (const char *gmsgid, ...
/* Called from output_format -- during diagnostic message processing
to handle Fortran specific format specifiers with the following meanings:
%C Current locus (no argument)
+ %L Takes locus argument
*/
static bool
gfc_format_decoder (pretty_printer *pp,
text_info *text, const char *spec,
int precision ATTRIBUTE_UNUSED, bool wide ATTRIBUTE_UNUSED,
bool plus ATTRIBUTE_UNUSED, bool hash ATTRIBUTE_UNUSED)
{
switch (*spec)
{
case 'C':
+ case 'L':
{
static const char *result = "(1)";
- gcc_assert (gfc_current_locus.nextc - gfc_current_locus.lb->line >= 0);
- unsigned int c1 = gfc_current_locus.nextc - gfc_current_locus.lb->line;
+ locus *loc;
+ 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);
*text->locus
= linemap_position_for_loc_and_offset (line_table,
- gfc_current_locus.lb->location,
- c1);
+ loc->lb->location,
+ offset);
global_dc->caret_char = '1';
pp_string (pp, result);
return true;
}
default:
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt (revision 217971)
+++ gcc/fortran/lang.opt (working copy)
@@ -216,11 +216,11 @@ Warn if the type of a variable might be
Wdate-time
Fortran
; Documented in C
Wcharacter-truncation
-Fortran Warning
+Fortran Var(warn_character_truncation) Warning LangEnabledBy(Fortran,Wall)
Warn about truncated character expressions
Wcompare-reals
Fortran Warning
Warn about equality comparisons involving REAL or COMPLEX expressions
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 217971)
+++ gcc/fortran/resolve.c (working copy)
@@ -9206,11 +9206,11 @@ resolve_ordinary_assign (gfc_code *code,
return false;
}
}
if (lhs->ts.type == BT_CHARACTER
- && gfc_option.warn_character_truncation)
+ && warn_character_truncation)
{
if (lhs->ts.u.cl != NULL
&& lhs->ts.u.cl->length != NULL
&& lhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
llen = mpz_get_si (lhs->ts.u.cl->length->value.integer);
@@ -9222,13 +9222,14 @@ resolve_ordinary_assign (gfc_code *code,
&& rhs->ts.u.cl->length != NULL
&& rhs->ts.u.cl->length->expr_type == EXPR_CONSTANT)
rlen = mpz_get_si (rhs->ts.u.cl->length->value.integer);
if (rlen && llen && rlen > llen)
- gfc_warning_now ("CHARACTER expression will be truncated "
- "in assignment (%d/%d) at %L",
- llen, rlen, &code->loc);
+ gfc_warning_now_2 (OPT_Wcharacter_truncation,
+ "CHARACTER expression will be truncated "
+ "in assignment (%d/%d) at %L",
+ llen, rlen, &code->loc);
}
/* Ensure that a vector index expression for the lvalue is evaluated
to a temporary if the lvalue symbol is referenced in it. */
if (lhs->rank)
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c (revision 217971)
+++ gcc/fortran/options.c (working copy)
@@ -93,11 +93,10 @@ gfc_init_options (unsigned int decoded_o
gfc_option.dump_fortran_original = 0;
gfc_option.dump_fortran_optimized = 0;
gfc_option.warn_aliasing = 0;
gfc_option.warn_ampersand = 0;
- gfc_option.warn_character_truncation = 0;
gfc_option.warn_array_temp = 0;
gfc_option.warn_c_binding_type = 0;
gfc_option.gfc_warn_conversion = 0;
gfc_option.warn_conversion_extra = 0;
gfc_option.warn_function_elimination = 0;
@@ -463,11 +462,10 @@ set_Wall (int setting)
gfc_option.warn_surprising = setting;
gfc_option.warn_tabs = !setting;
gfc_option.warn_underflow = setting;
gfc_option.warn_intrinsic_shadow = setting;
gfc_option.warn_intrinsics_std = setting;
- gfc_option.warn_character_truncation = setting;
gfc_option.warn_real_q_constant = setting;
gfc_option.warn_unused_dummy_argument = setting;
gfc_option.warn_target_lifetime = setting;
gfc_option.warn_zerotrip = setting;
@@ -666,14 +664,10 @@ gfc_handle_option (size_t scode, const c
case OPT_Wc_binding_type:
gfc_option.warn_c_binding_type = value;
break;
- case OPT_Wcharacter_truncation:
- gfc_option.warn_character_truncation = value;
- break;
-
case OPT_Wcompare_reals:
gfc_option.warn_compare_reals = value;
break;
case OPT_Wconversion:
