Commit 2700d0e3 by Jakub Jelinek Committed by Jakub Jelinek

gfortran.h (gfc_error): Rename overload with OPT argument to...

	* gfortran.h (gfc_error): Rename overload with OPT argument to...
	(gfc_error_opt): ... this.
	* error.c (gfc_error): Rename overloads with OPT argument to...
	(gfc_error_opt): ... this.  Adjust callers.
	(gfc_notify_std, gfc_error): Adjust callers.
	* resolve.c (resolve_structure_cons, resolve_global_procedure): Use
	gfc_error_opt instead of gfc_error.
	* interface.c (argument_rank_mismatch, compare_parameter,
	gfc_check_typebound_override): Likewise.  Fix up formatting.

From-SVN: r243941
parent d9086677
2016-12-27 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (gfc_error): Rename overload with OPT argument to...
(gfc_error_opt): ... this.
* error.c (gfc_error): Rename overloads with OPT argument to...
(gfc_error_opt): ... this. Adjust callers.
(gfc_notify_std, gfc_error): Adjust callers.
* resolve.c (resolve_structure_cons, resolve_global_procedure): Use
gfc_error_opt instead of gfc_error.
* interface.c (argument_rank_mismatch, compare_parameter,
gfc_check_typebound_override): Likewise. Fix up formatting.
2016-12-23 Andre Vehreschild <vehre@gcc.gnu.org> 2016-12-23 Andre Vehreschild <vehre@gcc.gnu.org>
* trans-expr.c (trans_class_assignment): Allocate memory of _vptr->size * trans-expr.c (trans_class_assignment): Allocate memory of _vptr->size
......
...@@ -67,7 +67,7 @@ gfc_push_suppress_errors (void) ...@@ -67,7 +67,7 @@ gfc_push_suppress_errors (void)
} }
static void static void
gfc_error (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); gfc_error_opt (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
static bool static bool
gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0); gfc_warning (int opt, const char *gmsgid, va_list ap) ATTRIBUTE_GCC_GFC(2,0);
...@@ -902,7 +902,7 @@ gfc_notify_std (int std, const char *gmsgid, ...) ...@@ -902,7 +902,7 @@ gfc_notify_std (int std, const char *gmsgid, ...)
if (warning) if (warning)
gfc_warning (0, buffer, argp); gfc_warning (0, buffer, argp);
else else
gfc_error (0, buffer, argp); gfc_error_opt (0, buffer, argp);
va_end (argp); va_end (argp);
return (warning && !warnings_are_errors) ? true : false; return (warning && !warnings_are_errors) ? true : false;
...@@ -1252,7 +1252,7 @@ gfc_warning_check (void) ...@@ -1252,7 +1252,7 @@ gfc_warning_check (void)
/* Issue an error. */ /* Issue an error. */
static void static void
gfc_error (int opt, const char *gmsgid, va_list ap) gfc_error_opt (int opt, const char *gmsgid, va_list ap)
{ {
va_list argp; va_list argp;
va_copy (argp, ap); va_copy (argp, ap);
...@@ -1308,11 +1308,11 @@ gfc_error (int opt, const char *gmsgid, va_list ap) ...@@ -1308,11 +1308,11 @@ gfc_error (int opt, const char *gmsgid, va_list ap)
void void
gfc_error (int opt, const char *gmsgid, ...) gfc_error_opt (int opt, const char *gmsgid, ...)
{ {
va_list argp; va_list argp;
va_start (argp, gmsgid); va_start (argp, gmsgid);
gfc_error (opt, gmsgid, argp); gfc_error_opt (opt, gmsgid, argp);
va_end (argp); va_end (argp);
} }
...@@ -1322,7 +1322,7 @@ gfc_error (const char *gmsgid, ...) ...@@ -1322,7 +1322,7 @@ gfc_error (const char *gmsgid, ...)
{ {
va_list argp; va_list argp;
va_start (argp, gmsgid); va_start (argp, gmsgid);
gfc_error (0, gmsgid, argp); gfc_error_opt (0, gmsgid, argp);
va_end (argp); va_end (argp);
} }
......
...@@ -2793,7 +2793,7 @@ bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...) ...@@ -2793,7 +2793,7 @@ bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
void gfc_clear_warning (void); void gfc_clear_warning (void);
void gfc_warning_check (void); void gfc_warning_check (void);
void gfc_error (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3); void gfc_error_opt (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_error (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2); void gfc_error_now (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2); void gfc_fatal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC(1,2);
......
...@@ -2125,25 +2125,17 @@ argument_rank_mismatch (const char *name, locus *where, ...@@ -2125,25 +2125,17 @@ argument_rank_mismatch (const char *name, locus *where,
/* TS 29113, C407b. */ /* TS 29113, C407b. */
if (rank2 == -1) if (rank2 == -1)
{ gfc_error ("The assumed-rank array at %L requires that the dummy argument"
gfc_error ("The assumed-rank array at %L requires that the dummy argument" " %qs has assumed-rank", where, name);
" %qs has assumed-rank", where, name);
}
else if (rank1 == 0) else if (rank1 == 0)
{ gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "at %L (scalar and rank-%d)", name, where, rank2);
"(scalar and rank-%d)", name, where, rank2);
}
else if (rank2 == 0) else if (rank2 == 0)
{ gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "at %L (rank-%d and scalar)", name, where, rank1);
"(rank-%d and scalar)", name, where, rank1);
}
else else
{ gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "at %L (rank-%d and rank-%d)", name, where, rank1, rank2);
"(rank-%d and rank-%d)", name, where, rank1, rank2);
}
} }
...@@ -2192,9 +2184,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, ...@@ -2192,9 +2184,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
sizeof(err), NULL, NULL)) sizeof(err), NULL, NULL))
{ {
if (where) if (where)
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Interface mismatch in dummy procedure %qs at %L: %s", "Interface mismatch in dummy procedure %qs at %L:"
formal->name, &actual->where, err); " %s", formal->name, &actual->where, err);
return false; return false;
} }
...@@ -2220,9 +2212,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, ...@@ -2220,9 +2212,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
err, sizeof(err), NULL, NULL)) err, sizeof(err), NULL, NULL))
{ {
if (where) if (where)
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Interface mismatch in dummy procedure %qs at %L: %s", "Interface mismatch in dummy procedure %qs at %L:"
formal->name, &actual->where, err); " %s", formal->name, &actual->where, err);
return false; return false;
} }
} }
...@@ -2251,10 +2243,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, ...@@ -2251,10 +2243,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
CLASS_DATA (actual)->ts.u.derived))) CLASS_DATA (actual)->ts.u.derived)))
{ {
if (where) if (where)
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Type mismatch in argument %qs at %L; passed %s to %s", "Type mismatch in argument %qs at %L; passed %s to %s",
formal->name, where, gfc_typename (&actual->ts), formal->name, where, gfc_typename (&actual->ts),
gfc_typename (&formal->ts)); gfc_typename (&formal->ts));
return false; return false;
} }
...@@ -4551,9 +4543,9 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old) ...@@ -4551,9 +4543,9 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym, if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym,
check_type, err, sizeof(err))) check_type, err, sizeof(err)))
{ {
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Argument mismatch for the overriding procedure " "Argument mismatch for the overriding procedure "
"%qs at %L: %s", proc->name, &where, err); "%qs at %L: %s", proc->name, &where, err);
return false; return false;
} }
......
...@@ -1312,10 +1312,10 @@ resolve_structure_cons (gfc_expr *expr, int init) ...@@ -1312,10 +1312,10 @@ resolve_structure_cons (gfc_expr *expr, int init)
if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
err, sizeof (err), NULL, NULL)) err, sizeof (err), NULL, NULL))
{ {
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Interface mismatch for procedure-pointer component " "Interface mismatch for procedure-pointer "
"%qs in structure constructor at %L: %s", "component %qs in structure constructor at %L:"
comp->name, &cons->expr->where, err); " %s", comp->name, &cons->expr->where, err);
return false; return false;
} }
} }
...@@ -2466,9 +2466,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, ...@@ -2466,9 +2466,9 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
reason, sizeof(reason), NULL, NULL)) reason, sizeof(reason), NULL, NULL))
{ {
gfc_error (OPT_Wargument_mismatch, gfc_error_opt (OPT_Wargument_mismatch,
"Interface mismatch in global procedure %qs at %L: %s ", "Interface mismatch in global procedure %qs at %L:"
sym->name, &sym->declared_at, reason); " %s ", sym->name, &sym->declared_at, reason);
goto done; goto done;
} }
......
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