+2015-02-01 Joseph Myers <joseph@codesourcery.com>
+
+ * error.c (gfc_warning (const char *, ...), gfc_warning_now (const
+ char *, ...)): Remove functions.
+ * gfortran.h (gfc_warning (const char *, ...), gfc_warning_now
+ (const char *, ...)): Remove declarations.
+ * arith.c, check.c, data.c, decl.c, frontend-passes.c,
+ interface.c, intrinsic.c, io.c, matchexp.c, module.c, openmp.c,
+ options.c, parse.c, primary.c, resolve.c, scanner.c, symbol.c,
+ trans-common.c, trans-const.c, trans-stmt.c: All callers of
+ gfc_warning and gfc_warning_now changed to pass 0 or option number
+ as first argument.
+
2015-01-30 Joseph Myers <joseph@codesourcery.com>
* f95-lang.c, gfortranspec.c, trans-const.c, trans-expr.c: All
if (val == ARITH_ASYMMETRIC)
{
- gfc_warning (gfc_arith_error (val), &x->where);
+ gfc_warning (0, gfc_arith_error (val), &x->where);
val = ARITH_OK;
}
{
if (rc == ARITH_ASYMMETRIC)
{
- gfc_warning (gfc_arith_error (rc), &src->where);
+ gfc_warning (0, gfc_arith_error (rc), &src->where);
}
else
{
if (src_len > result_len)
{
- gfc_warning ("The Hollerith constant at %L is too long to convert to %qs",
+ gfc_warning (0,
+ "The Hollerith constant at %L is too long to convert to %qs",
&src->where, gfc_typename(&result->ts));
}
return true;
if (source_size < result_size)
- gfc_warning ("Intrinsic TRANSFER at %L has partly undefined result: "
+ gfc_warning (0, "Intrinsic TRANSFER at %L has partly undefined result: "
"source size %ld < result size %ld", &source->where,
(long) source_size, (long) result_size);
if (len > end - start)
{
- gfc_warning_now ("Initialization string starting at %L was "
+ gfc_warning_now (0, "Initialization string starting at %L was "
"truncated to fit the variable (%d/%d)",
&rvalue->where, end - start, len);
len = end - start;
if (ts->f90_type != BT_UNKNOWN && ts->f90_type != ts->type
&& !((ts->f90_type == BT_REAL && ts->type == BT_COMPLEX)
|| (ts->f90_type == BT_COMPLEX && ts->type == BT_REAL)))
- gfc_warning_now ("C kind type parameter is for type %s but type at %L "
+ gfc_warning_now (0, "C kind type parameter is for type %s but type at %L "
"is %s", gfc_basic_typename (ts->f90_type), &where,
gfc_basic_typename (ts->type));
if (gfc_find_symtree (gfc_current_ns->sym_root, name))
{
- gfc_warning ("%qs is already IMPORTed from host scoping unit "
+ gfc_warning (0, "%qs is already IMPORTed from host scoping unit "
"at %C", name);
goto next_item;
}
&& tmp_sym->binding_label)
/* Use gfc_warning_now because we won't say that the symbol fails
just because of this. */
- gfc_warning_now ("Symbol %qs at %L is marked PRIVATE but has been "
+ gfc_warning_now (0, "Symbol %qs at %L is marked PRIVATE but has been "
"given the binding label %qs", tmp_sym->name,
&(tmp_sym->declared_at), tmp_sym->binding_label);
return MATCH_ERROR;
}
else if (cptr->ts.kind < gfc_index_integer_kind)
- gfc_warning ("Cray pointer at %C has %d bytes of precision;"
+ gfc_warning (0, "Cray pointer at %C has %d bytes of precision;"
" memory addresses require %d bytes",
cptr->ts.kind, gfc_index_integer_kind);
return ret;
}
-bool
-gfc_warning (const char *gmsgid, ...)
-{
- va_list argp;
-
- va_start (argp, gmsgid);
- bool ret = gfc_warning (0, gmsgid, argp);
- va_end (argp);
- return ret;
-}
-
/* Whether, for a feature included in a given standard set (GFC_STD_*),
we should issue an error or a warning, or be quiet. */
return ret;
}
-/* Immediate warning (i.e. do not buffer the warning). */
-/* This function uses the common diagnostics, but does not support
- two locations; when being used in scanner.c, ensure that the location
- is properly setup. Otherwise, use gfc_warning_now_1. */
-
-bool
-gfc_warning_now (const char *gmsgid, ...)
-{
- va_list argp;
- diagnostic_info diagnostic;
- bool ret;
-
- va_start (argp, gmsgid);
- diagnostic_set_info (&diagnostic, gmsgid, &argp, UNKNOWN_LOCATION,
- DK_WARNING);
- ret = report_diagnostic (&diagnostic);
- va_end (argp);
- return ret;
-}
-
/* Immediate error (i.e. do not buffer). */
/* This function uses the common diagnostics, but does not support
if (e->expr_type != EXPR_FUNCTION)
return;
if (e->value.function.esym)
- gfc_warning ("Removing call to function %qs at %L",
+ gfc_warning (0, "Removing call to function %qs at %L",
e->value.function.esym->name, &(e->where));
else if (e->value.function.isym)
- gfc_warning ("Removing call to function %qs at %L",
+ gfc_warning (0, "Removing call to function %qs at %L",
e->value.function.isym->name, &(e->where));
}
/* Callback function for the code walker for doing common function
const char *gfc_print_wide_char (gfc_char_t);
void gfc_warning_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-bool gfc_warning (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
void gfc_warning_now_1 (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
-bool gfc_warning_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
void gfc_clear_warning (void);
case -2:
/* FIXME: Implement a warning for this case.
- gfc_warning ("Possible character length mismatch in argument %qs",
+ gfc_warning (0, "Possible character length mismatch in argument %qs",
s1->name);*/
break;
case -2:
/* FIXME: Implement a warning for this case.
- gfc_warning ("Possible shape mismatch in argument %qs",
+ gfc_warning (0, "Possible shape mismatch in argument %qs",
s1->name);*/
break;
case -2:
/* FIXME: Implement a warning for this case.
- gfc_warning ("Possible shape mismatch in return value");*/
+ gfc_warning (0, "Possible shape mismatch in return value");*/
break;
case 0:
p->sym->name, q->sym->name, interface_name,
&p->where);
else if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
- gfc_warning ("Ambiguous interfaces %qs and %qs in %s at %L",
+ gfc_warning (0, "Ambiguous interfaces %qs and %qs in %s at %L",
p->sym->name, q->sym->name, interface_name,
&p->where);
else
- gfc_warning ("Although not referenced, %qs has ambiguous "
+ gfc_warning (0, "Although not referenced, %qs has ambiguous "
"interfaces at %L", interface_name, &p->where);
return 1;
}
f->sym->ts.u.cl->length->value.integer) != 0))
{
if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
- gfc_warning ("Character length mismatch (%ld/%ld) between actual "
+ gfc_warning (0,
+ "Character length mismatch (%ld/%ld) between actual "
"argument and pointer or allocatable dummy argument "
"%qs at %L",
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
mpz_get_si (f->sym->ts.u.cl->length->value.integer),
f->sym->name, &a->expr->where);
else if (where)
- gfc_warning ("Character length mismatch (%ld/%ld) between actual "
+ gfc_warning (0,
+ "Character length mismatch (%ld/%ld) between actual "
"argument and assumed-shape dummy argument %qs "
"at %L",
mpz_get_si (a->expr->ts.u.cl->length->value.integer),
&& f->sym->attr.flavor != FL_PROCEDURE)
{
if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
- gfc_warning ("Character length of actual argument shorter "
+ gfc_warning (0, "Character length of actual argument shorter "
"than of dummy argument %qs (%lu/%lu) at %L",
f->sym->name, actual_size, formal_size,
&a->expr->where);
else if (where)
- gfc_warning ("Actual argument contains too few "
+ gfc_warning (0, "Actual argument contains too few "
"elements for dummy argument %qs (%lu/%lu) at %L",
f->sym->name, actual_size, formal_size,
&a->expr->where);
|| (f1_intent == INTENT_OUT && f2_intent == INTENT_IN)
|| (f1_intent == INTENT_OUT && f2_intent == INTENT_OUT))
{
- gfc_warning ("Same actual argument associated with INTENT(%s) "
+ gfc_warning (0, "Same actual argument associated with INTENT(%s) "
"argument %qs and INTENT(%s) argument %qs at %L",
gfc_intent_string (f1_intent), p[i].f->sym->name,
gfc_intent_string (f2_intent), p[j].f->sym->name,
{
/* Do only print a warning if not a GNU extension. */
if (!silent && isym->standard != GFC_STD_GNU)
- gfc_warning ("Intrinsic %qs (is %s) is used at %L",
+ gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
isym->name, _(symstd_msg), &where);
return true;
/* At this point, a conversion is necessary. A warning may be needed. */
if ((gfc_option.warn_std & sym->standard) != 0)
{
- gfc_warning_now ("Extension: Conversion from %s to %s at %L",
+ gfc_warning_now (0, "Extension: Conversion from %s to %s at %L",
gfc_typename (&from_ts), gfc_typename (ts),
&expr->where);
}
gfc_current_locus = old_locus;
if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
- gfc_warning ("Extension: backslash character at %C");
+ gfc_warning (0, "Extension: backslash character at %C");
}
if (mode == MODE_COPY)
if (c == '\t')
{
if (gfc_option.allow_std & GFC_STD_GNU)
- gfc_warning ("Extension: Tab character in format at %C");
+ gfc_warning (0, "Extension: Tab character in format at %C");
else
{
gfc_error ("Extension: Tab character in format at %C");
return false;
if (t != FMT_RPAREN || level > 0)
{
- gfc_warning ("$ should be the last specifier in format at %L",
+ gfc_warning (0, "$ should be the last specifier in format at %L",
&format_locus);
goto optional_comma_1;
}
case WARNING:
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
- gfc_warning ("Extension: Missing positive width after L "
+ gfc_warning (0, "Extension: Missing positive width after L "
"descriptor at %L", &format_locus);
saved_token = t;
break;
goto fail;
}
else
- gfc_warning ("Period required in format "
+ gfc_warning (0, "Period required in format "
"specifier %s at %L", token_to_string (t),
&format_locus);
/* If we go to finished, we need to unwind this
}
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
- gfc_warning ("Period required in format specifier at %L",
+ gfc_warning (0, "Period required in format specifier at %L",
&format_locus);
saved_token = t;
break;
{
if (mode != MODE_FORMAT)
format_locus.nextc += format_string_pos;
- gfc_warning ("The H format specifier at %L is"
+ gfc_warning (0, "The H format specifier at %L is"
" a Fortran 95 deleted feature", &format_locus);
}
if (mode == MODE_STRING)
if (e->value.character.string[i] != ' ')
{
format_locus.nextc += format_length + 1;
- gfc_warning ("Extraneous characters in format at %L", &format_locus);
+ gfc_warning (0,
+ "Extraneous characters in format at %L", &format_locus);
break;
}
return rv;
if (n == WARNING || (warn && n == ERROR))
{
- gfc_warning ("Fortran 2003: %s specifier in %s statement at %C "
+ gfc_warning (0, "Fortran 2003: %s specifier in %s statement at %C "
"has value %qs", specifier, statement,
allowed_f2003[i]);
return 1;
if (n == WARNING || (warn && n == ERROR))
{
- gfc_warning ("Extension: %s specifier in %s statement at %C "
+ gfc_warning (0, "Extension: %s specifier in %s statement at %C "
"has value %qs", specifier, statement,
allowed_gnu[i]);
return 1;
if (warn)
{
char *s = gfc_widechar_to_char (value, -1);
- gfc_warning ("%s specifier in %s statement at %C has invalid value %qs",
+ gfc_warning (0,
+ "%s specifier in %s statement at %C has invalid value %qs",
specifier, statement, s);
free (s);
return 1;
#define warn_or_error(...) \
{ \
if (warn) \
- gfc_warning (__VA_ARGS__); \
+ gfc_warning (0, __VA_ARGS__); \
else \
{ \
gfc_error (__VA_ARGS__); \
return MATCH_ERROR;
}
else
- gfc_warning ("Extension: Unary operator following "
+ gfc_warning (0, "Extension: Unary operator following "
"arithmetic operator (use parentheses) at %C");
m = match_ext_mult_operand (&e);
return MATCH_ERROR;
}
else
- gfc_warning ("Extension: Unary operator following "
+ gfc_warning (0, "Extension: Unary operator following "
"arithmetic operator (use parentheses) at %C");
m = match_ext_add_operand (&e);
if ((flag_default_integer || flag_default_real)
&& symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
- gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named "
+ gfc_warning_now (0, "Use of the NUMERIC_STORAGE_SIZE named "
"constant from intrinsic module "
"ISO_FORTRAN_ENV at %L is incompatible with "
"option %qs", &u->where,
if ((flag_default_integer || flag_default_real)
&& symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
- gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named constant "
+ gfc_warning_now (0,
+ "Use of the NUMERIC_STORAGE_SIZE named constant "
"from intrinsic module ISO_FORTRAN_ENV at %C is "
"incompatible with option %s",
flag_default_integer
resolve_oacc_scalar_int_expr (expr, clause);
if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
&& mpz_sgn(expr->value.integer) <= 0)
- gfc_warning ("INTEGER expression of %s clause at %L must be positive",
+ gfc_warning (0, "INTEGER expression of %s clause at %L must be positive",
clause, &expr->where);
}
if (gfc_current_form == FORM_UNKNOWN)
{
gfc_current_form = FORM_FREE;
- gfc_warning_now ("Reading file %qs as free form",
+ gfc_warning_now (0, "Reading file %qs as free form",
(filename[0] == '\0') ? "<stdin>" : filename);
}
}
if (gfc_current_form == FORM_FREE)
{
if (gfc_option.flag_d_lines == 0)
- gfc_warning_now ("%<-fd-lines-as-comments%> has no effect "
+ gfc_warning_now (0, "%<-fd-lines-as-comments%> has no effect "
"in free form");
else if (gfc_option.flag_d_lines == 1)
- gfc_warning_now ("%<-fd-lines-as-code%> has no effect in free form");
+ gfc_warning_now (0, "%<-fd-lines-as-code%> has no effect in free form");
if (warn_line_truncation == -1)
warn_line_truncation = 1;
if (!flag_automatic && flag_max_stack_var_size != -2
&& flag_max_stack_var_size != 0)
- gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
+ gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-fmax-stack-var-size=%d%>",
flag_max_stack_var_size);
else if (!flag_automatic && flag_recursive)
- gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%>");
+ gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%>");
else if (!flag_automatic && flag_openmp)
- gfc_warning_now ("Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
+ gfc_warning_now (0, "Flag %<-fno-automatic%> overwrites %<-frecursive%> implied by "
"%<-fopenmp%>");
else if (flag_max_stack_var_size != -2 && flag_recursive)
- gfc_warning_now ("Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
+ gfc_warning_now (0, "Flag %<-frecursive%> overwrites %<-fmax-stack-var-size=%d%>",
flag_max_stack_var_size);
else if (flag_max_stack_var_size != -2 && flag_openmp)
- gfc_warning_now ("Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
+ gfc_warning_now (0, "Flag %<-fmax-stack-var-size=%d%> overwrites %<-frecursive%> "
"implied by %<-fopenmp%>", flag_max_stack_var_size);
/* Implement -frecursive as -fmax-stack-var-size=-1. */
if (gfc_match_eos () == MATCH_YES)
{
- gfc_warning_now ("Ignoring statement label in empty statement "
+ gfc_warning_now (0, "Ignoring statement label in empty statement "
"at %L", &label_locus);
gfc_free_st_label (gfc_statement_label);
gfc_statement_label = NULL;
if (digit_flag)
{
if (label == 0)
- gfc_warning_now ("Zero is not a valid statement label at %C");
+ gfc_warning_now (0, "Zero is not a valid statement label at %C");
else
{
/* We've found a valid statement label. */
blank_line:
if (digit_flag)
- gfc_warning_now ("Ignoring statement label in empty statement at %L",
+ gfc_warning_now (0, "Ignoring statement label in empty statement at %L",
&label_locus);
gfc_current_locus.lb->truncated = 0;
}
if (gfc_current_block ()->attr.sequence)
- gfc_warning ("SEQUENCE attribute at %C already specified in "
+ gfc_warning (0, "SEQUENCE attribute at %C already specified in "
"TYPE statement");
if (seen_sequence)
st = next_statement ();
if (st == ST_OACC_END_LOOP)
- gfc_warning ("Redundant !$ACC END LOOP at %C");
+ gfc_warning (0, "Redundant !$ACC END LOOP at %C");
if ((acc_st == ST_OACC_PARALLEL_LOOP && st == ST_OACC_END_PARALLEL_LOOP) ||
(acc_st == ST_OACC_KERNELS_LOOP && st == ST_OACC_END_KERNELS_LOOP) ||
(acc_st == ST_OACC_LOOP && st == ST_OACC_END_LOOP))
gfc_current_locus = old_locus;
if (!(gfc_option.allow_std & GFC_STD_GNU) && !inhibit_warnings)
- gfc_warning ("Extension: backslash character at %C");
+ gfc_warning (0, "Extension: backslash character at %C");
}
if (c != delimiter)
/* A non-RECURSIVE procedure that is used as procedure expression within its
own body is in danger of being called recursively. */
if (is_illegal_recursion (sym, gfc_current_ns))
- gfc_warning ("Non-RECURSIVE procedure %qs at %L is possibly calling"
+ gfc_warning (0, "Non-RECURSIVE procedure %qs at %L is possibly calling"
" itself recursively. Declare it RECURSIVE or use"
" %<-frecursive%>", sym->name, &expr->where);
&& (set_by_optional || arg->expr->rank != rank)
&& !(isym && isym->id == GFC_ISYM_CONVERSION))
{
- gfc_warning ("%qs at %L is an array and OPTIONAL; IF IT IS "
+ gfc_warning (0, "%qs at %L is an array and OPTIONAL; IF IT IS "
"MISSING, it cannot be the actual argument of an "
"ELEMENTAL procedure unless there is a non-optional "
"argument with the same rank (12.4.1.5)",
else
msg = "Inequality comparison for %s at %L";
- gfc_warning (msg, gfc_typename (&op1->ts), &op1->where);
+ gfc_warning (0, msg, gfc_typename (&op1->ts), &op1->where);
}
}
if (compare_bound (ar->start[i], as->lower[i]) == CMP_LT)
{
if (i < as->rank)
- gfc_warning ("Array reference at %L is out of bounds "
+ gfc_warning (0, "Array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->lower[i]->value.integer), i+1);
else
- gfc_warning ("Array reference at %L is out of bounds "
+ gfc_warning (0, "Array reference at %L is out of bounds "
"(%ld < %ld) in codimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->lower[i]->value.integer),
if (compare_bound (ar->start[i], as->upper[i]) == CMP_GT)
{
if (i < as->rank)
- gfc_warning ("Array reference at %L is out of bounds "
+ gfc_warning (0, "Array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->upper[i]->value.integer), i+1);
else
- gfc_warning ("Array reference at %L is out of bounds "
+ gfc_warning (0, "Array reference at %L is out of bounds "
"(%ld > %ld) in codimension %d", &ar->c_where[i],
mpz_get_si (ar->start[i]->value.integer),
mpz_get_si (as->upper[i]->value.integer),
{
if (compare_bound (AR_START, as->lower[i]) == CMP_LT)
{
- gfc_warning ("Lower array reference at %L is out of bounds "
+ gfc_warning (0, "Lower array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (AR_START->value.integer),
mpz_get_si (as->lower[i]->value.integer), i+1);
}
if (compare_bound (AR_START, as->upper[i]) == CMP_GT)
{
- gfc_warning ("Lower array reference at %L is out of bounds "
+ gfc_warning (0, "Lower array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (AR_START->value.integer),
mpz_get_si (as->upper[i]->value.integer), i+1);
{
if (compare_bound_mpz_t (as->lower[i], last_value) == CMP_GT)
{
- gfc_warning ("Upper array reference at %L is out of bounds "
+ gfc_warning (0, "Upper array reference at %L is out of bounds "
"(%ld < %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (last_value),
mpz_get_si (as->lower[i]->value.integer), i+1);
}
if (compare_bound_mpz_t (as->upper[i], last_value) == CMP_LT)
{
- gfc_warning ("Upper array reference at %L is out of bounds "
+ gfc_warning (0, "Upper array reference at %L is out of bounds "
"(%ld > %ld) in dimension %d", &ar->c_where[i],
mpz_get_si (last_value),
mpz_get_si (as->upper[i]->value.integer), i+1);
if (errmsg)
{
if (!stat)
- gfc_warning ("ERRMSG at %L is useless without a STAT tag",
+ gfc_warning (0, "ERRMSG at %L is useless without a STAT tag",
&errmsg->where);
gfc_check_vardef_context (errmsg, false, false, false,
if (cp->low
&& gfc_check_integer_range (cp->low->value.integer,
case_expr->ts.kind) != ARITH_OK)
- gfc_warning ("Expression in CASE statement at %L is "
+ gfc_warning (0, "Expression in CASE statement at %L is "
"not in the range of %s", &cp->low->where,
gfc_typename (&case_expr->ts));
&& cp->low != cp->high
&& gfc_check_integer_range (cp->high->value.integer,
case_expr->ts.kind) != ARITH_OK)
- gfc_warning ("Expression in CASE statement at %L is "
+ gfc_warning (0, "Expression in CASE statement at %L is "
"not in the range of %s", &cp->high->where,
gfc_typename (&case_expr->ts));
}
if (code->here == label)
{
- gfc_warning ("Branch at %L may result in an infinite loop", &code->loc);
+ gfc_warning (0,
+ "Branch at %L may result in an infinite loop", &code->loc);
return;
}
assignment. Emit a warning rather than an error because the
mask could be resolving this problem. */
if (!find_forall_index (code->expr1, forall_index, 0))
- gfc_warning ("The FORALL with index %qs is not used on the "
+ gfc_warning (0, "The FORALL with index %qs is not used on the "
"left side of the assignment at %L and so might "
"cause multiple assignment to this object",
var_expr[n]->symtree->name, &code->expr1->where);
(*code)->expr1->rank ? 1 : 0);
if (depth > 1)
{
- gfc_warning ("TODO: type-bound defined assignment(s) at %L not "
+ gfc_warning (0, "TODO: type-bound defined assignment(s) at %L not "
"done because multiple part array references would "
"occur in intermediate expressions.", &(*code)->loc);
return;
switch (label->referenced)
{
case ST_LABEL_UNKNOWN:
- gfc_warning ("Label %d at %L defined but not used", label->value,
+ gfc_warning (0, "Label %d at %L defined but not used", label->value,
&label->where);
break;
case ST_LABEL_BAD_TARGET:
- gfc_warning ("Label %d at %L defined but cannot be used",
+ gfc_warning (0, "Label %d at %L defined but cannot be used",
label->value, &label->where);
break;
if (stat (q, &st))
{
if (errno != ENOENT)
- gfc_warning_now ("Include directory %qs: %s", path,
+ gfc_warning_now (0, "Include directory %qs: %s", path,
xstrerror(errno));
else if (warn)
gfc_warning_now (OPT_Wmissing_include_dirs,
}
else if (!S_ISDIR (st.st_mode))
{
- gfc_warning_now ("%qs is not a directory", path);
+ gfc_warning_now (0, "%qs is not a directory", path);
return;
}
}
else
{
- gfc_warning_now ("!$ACC at %C starts a commented "
+ gfc_warning_now (0, "!$ACC at %C starts a commented "
"line as it neither is followed "
"by a space nor is a "
"continuation line");
}
else
{
- gfc_warning_now ("!$OMP at %C starts a commented "
+ gfc_warning_now (0, "!$OMP at %C starts a commented "
"line as it neither is followed "
"by a space nor is a "
"continuation line");
if (++continue_count == gfc_option.max_continue_free)
{
if (gfc_notification_std (GFC_STD_GNU) || pedantic)
- gfc_warning ("Limit of %d continuations exceeded in "
+ gfc_warning (0, "Limit of %d continuations exceeded in "
"statement at %C", gfc_option.max_continue_free);
}
}
if (++continue_count == gfc_option.max_continue_fixed)
{
if (gfc_notification_std (GFC_STD_GNU) || pedantic)
- gfc_warning ("Limit of %d continuations exceeded in "
+ gfc_warning (0, "Limit of %d continuations exceeded in "
"statement at %C",
gfc_option.max_continue_fixed);
}
gfc_error_now ("%<&%> not allowed by itself in line %d",
current_line);
else
- gfc_warning_now ("%<&%> not allowed by itself in line %d",
+ gfc_warning_now (0, "%<&%> not allowed by itself in line %d",
current_line);
}
break;
*/
if (curr_comp == NULL)
{
- gfc_warning ("Derived type %qs with BIND(C) attribute at %L is empty, "
+ gfc_warning (0, "Derived type %qs with BIND(C) attribute at %L is empty, "
"and may be inaccessible by the C companion processor",
derived_sym->name, &(derived_sym->declared_at));
derived_sym->ts.is_c_interop = 1;
blank common blocks may be of different sizes. */
if (!tree_int_cst_equal (DECL_SIZE_UNIT (decl), size)
&& strcmp (com->name, BLANK_COMMON_NAME))
- gfc_warning ("Named COMMON block %qs at %L shall be of the "
+ gfc_warning (0, "Named COMMON block %qs at %L shall be of the "
"same size as elsewhere (%lu vs %lu bytes)", com->name,
&com->where,
(unsigned long) TREE_INT_CST_LOW (size),
if (warn_align_commons)
{
if (strcmp (common->name, BLANK_COMMON_NAME))
- gfc_warning ("Padding of %d bytes required before %qs in "
+ gfc_warning (0,
+ "Padding of %d bytes required before %qs in "
"COMMON %qs at %L; reorder elements or use "
"-fno-align-commons", (int)offset,
s->sym->name, common->name, &common->where);
else
- gfc_warning ("Padding of %d bytes required before %qs in "
+ gfc_warning (0,
+ "Padding of %d bytes required before %qs in "
"COMMON at %L; reorder elements or use "
"-fno-align-commons", (int)offset,
s->sym->name, &common->where);
gfc_build_string_const (expr->representation.length,
expr->representation.string));
if (!integer_zerop (tmp) && !integer_onep (tmp))
- gfc_warning ("Assigning value other than 0 or 1 to LOGICAL"
+ gfc_warning (0, "Assigning value other than 0 or 1 to LOGICAL"
" has undefined result at %L", &expr->where);
return fold_convert (gfc_get_logical_type (expr->ts.kind), tmp);
}
result = gfc_get_fake_result_decl (NULL, 0);
if (!result)
{
- gfc_warning ("An alternate return at %L without a * dummy argument",
+ gfc_warning (0,
+ "An alternate return at %L without a * dummy argument",
&code->expr1->where);
return gfc_generate_return ();
}
projects / gcc.git / commitdiff