re PR fortran/91557 (Bogus warning about unused dummy argument _formal_*)
2019-09-14 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/91557 PR fortran/91556 * frontend-passes.c (check_externals_procedure): Reformat argument list. Use gfc_compare_actual_formal instead of gfc_procedure_use. * gfortran.h (gfc_symbol): Add flag error. * interface.c (gfc_compare_interfaces): Reformat. (argument_rank_mismatch): Add where_formal argument. If it is present, note that the error is between different calls. (compare_parameter): Change warnings that previously dependended on -Wargument-mismatch to unconditional. Issue an error / warning on type mismatch only once. Pass where_formal to argument_rank_mismatch for artificial variables. (compare_actual_formal): Change warnings that previously dependeded on -Wargument-mismatch to unconditional. (gfc_check_typebound_override): Likewise. (gfc_get_formal_from_actual_arglist): Set declared_at for artificial symbol. * invoke.texi: Extend description of -fallow-argument-mismatch. Delete -Wargument-mismatch. * lang.opt: Change -Wargument-mismatch to do-nothing option. * resolve.c (resolve_structure_cons): Change warnings that previously depended on -Wargument-mismatch to unconditional. * trans-decl.c (generate_local_decl): Do not warn if the symbol is artificial. 2019-09-14 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/91557 PR fortran/91556 * gfortran.dg/argument_checking_20.f90: New test. * gfortran.dg/argument_checking_21.f90: New test. * gfortran.dg/argument_checking_22.f90: New test. * gfortran.dg/argument_checking_23.f90: New test. * gfortran.dg/warn_unused_dummy_argument_5.f90: New test. * gfortran.dg/bessel_3.f90: Add pattern for type mismatch. * gfortran.dg/g77/20010519-1.f: Adjust dg-warning messages to new handling. * gfortran.dg/pr24823.f: Likewise. * gfortran.dg/pr39937.f: Likewise. From-SVN: r275719
This commit is contained in:
parent
df19f4717d
commit
e0b9e5f9e3
@ -1,3 +1,30 @@
|
||||
2019-09-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/91557
|
||||
PR fortran/91556
|
||||
* frontend-passes.c (check_externals_procedure): Reformat argument
|
||||
list. Use gfc_compare_actual_formal instead of gfc_procedure_use.
|
||||
* gfortran.h (gfc_symbol): Add flag error.
|
||||
* interface.c (gfc_compare_interfaces): Reformat.
|
||||
(argument_rank_mismatch): Add where_formal argument. If it is
|
||||
present, note that the error is between different calls.
|
||||
(compare_parameter): Change warnings that previously dependended
|
||||
on -Wargument-mismatch to unconditional. Issue an error / warning
|
||||
on type mismatch only once. Pass where_formal to
|
||||
argument_rank_mismatch for artificial variables.
|
||||
(compare_actual_formal): Change warnings that previously
|
||||
dependeded on -Wargument-mismatch to unconditional.
|
||||
(gfc_check_typebound_override): Likewise.
|
||||
(gfc_get_formal_from_actual_arglist): Set declared_at for
|
||||
artificial symbol.
|
||||
* invoke.texi: Extend description of -fallow-argument-mismatch.
|
||||
Delete -Wargument-mismatch.
|
||||
* lang.opt: Change -Wargument-mismatch to do-nothing option.
|
||||
* resolve.c (resolve_structure_cons): Change warnings that
|
||||
previously depended on -Wargument-mismatch to unconditional.
|
||||
* trans-decl.c (generate_local_decl): Do not warn if the symbol is
|
||||
artificial.
|
||||
|
||||
2019-09-13 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
PR fortran/91566
|
||||
|
@ -5373,7 +5373,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
|
||||
/* Common tests for argument checking for both functions and subroutines. */
|
||||
|
||||
static int
|
||||
check_externals_procedure (gfc_symbol *sym, locus *loc, gfc_actual_arglist *actual)
|
||||
check_externals_procedure (gfc_symbol *sym, locus *loc,
|
||||
gfc_actual_arglist *actual)
|
||||
{
|
||||
gfc_gsymbol *gsym;
|
||||
gfc_symbol *def_sym = NULL;
|
||||
@ -5396,7 +5397,7 @@ check_externals_procedure (gfc_symbol *sym, locus *loc, gfc_actual_arglist *actu
|
||||
|
||||
if (def_sym)
|
||||
{
|
||||
gfc_procedure_use (def_sym, &actual, loc);
|
||||
gfc_compare_actual_formal (&actual, def_sym->formal, 0, 0, 0, loc);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
@ -1610,6 +1610,9 @@ typedef struct gfc_symbol
|
||||
/* Set if this is a module function or subroutine with the
|
||||
abreviated declaration in a submodule. */
|
||||
unsigned abr_modproc_decl:1;
|
||||
/* Set if a previous error or warning has occurred and no other
|
||||
should be reported. */
|
||||
unsigned error:1;
|
||||
|
||||
int refs;
|
||||
struct gfc_namespace *ns; /* namespace containing this symbol */
|
||||
|
@ -1807,9 +1807,9 @@ gfc_compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, const char *name2,
|
||||
if (!compare_rank (f2->sym, f1->sym))
|
||||
{
|
||||
if (errmsg != NULL)
|
||||
snprintf (errmsg, err_len, "Rank mismatch in argument '%s' "
|
||||
"(%i/%i)", f1->sym->name, symbol_rank (f1->sym),
|
||||
symbol_rank (f2->sym));
|
||||
snprintf (errmsg, err_len, "Rank mismatch in argument "
|
||||
"'%s' (%i/%i)", f1->sym->name,
|
||||
symbol_rank (f1->sym), symbol_rank (f2->sym));
|
||||
return false;
|
||||
}
|
||||
if ((gfc_option.allow_std & GFC_STD_F2008)
|
||||
@ -2189,22 +2189,42 @@ compare_pointer (gfc_symbol *formal, gfc_expr *actual)
|
||||
|
||||
static void
|
||||
argument_rank_mismatch (const char *name, locus *where,
|
||||
int rank1, int rank2)
|
||||
int rank1, int rank2, locus *where_formal)
|
||||
{
|
||||
|
||||
/* TS 29113, C407b. */
|
||||
if (rank2 == -1)
|
||||
gfc_error ("The assumed-rank array at %L requires that the dummy argument"
|
||||
" %qs has assumed-rank", where, name);
|
||||
else if (rank1 == 0)
|
||||
gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
|
||||
"at %L (scalar and rank-%d)", name, where, rank2);
|
||||
else if (rank2 == 0)
|
||||
gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
|
||||
"at %L (rank-%d and scalar)", name, where, rank1);
|
||||
if (where_formal == NULL)
|
||||
{
|
||||
if (rank2 == -1)
|
||||
gfc_error ("The assumed-rank array at %L requires that the dummy "
|
||||
"argument %qs has assumed-rank", where, name);
|
||||
else if (rank1 == 0)
|
||||
gfc_error_opt (0, "Rank mismatch in argument %qs "
|
||||
"at %L (scalar and rank-%d)", name, where, rank2);
|
||||
else if (rank2 == 0)
|
||||
gfc_error_opt (0, "Rank mismatch in argument %qs "
|
||||
"at %L (rank-%d and scalar)", name, where, rank1);
|
||||
else
|
||||
gfc_error_opt (0, "Rank mismatch in argument %qs "
|
||||
"at %L (rank-%d and rank-%d)", name, where, rank1,
|
||||
rank2);
|
||||
}
|
||||
else
|
||||
gfc_error_opt (OPT_Wargument_mismatch, "Rank mismatch in argument %qs "
|
||||
"at %L (rank-%d and rank-%d)", name, where, rank1, rank2);
|
||||
{
|
||||
gcc_assert (rank2 != -1);
|
||||
if (rank1 == 0)
|
||||
gfc_error_opt (0, "Rank mismatch between actual argument at %L "
|
||||
"and actual argument at %L (scalar and rank-%d)",
|
||||
where, where_formal, rank2);
|
||||
else if (rank2 == 0)
|
||||
gfc_error_opt (0, "Rank mismatch between actual argument at %L "
|
||||
"and actual argument at %L (rank-%d and scalar)",
|
||||
where, where_formal, rank1);
|
||||
else
|
||||
gfc_error_opt (0, "Rank mismatch between actual argument at %L "
|
||||
"and actual argument at %L (rank-%d and rank-%d", where,
|
||||
where_formal, rank1, rank2);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -2253,8 +2273,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
||||
sizeof(err), NULL, NULL))
|
||||
{
|
||||
if (where)
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Interface mismatch in dummy procedure %qs at %L:"
|
||||
gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
|
||||
" %s", formal->name, &actual->where, err);
|
||||
return false;
|
||||
}
|
||||
@ -2281,8 +2300,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
||||
err, sizeof(err), NULL, NULL))
|
||||
{
|
||||
if (where)
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Interface mismatch in dummy procedure %qs at %L:"
|
||||
gfc_error_opt (0, "Interface mismatch in dummy procedure %qs at %L:"
|
||||
" %s", formal->name, &actual->where, err);
|
||||
return false;
|
||||
}
|
||||
@ -2312,10 +2330,24 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
||||
CLASS_DATA (actual)->ts.u.derived)))
|
||||
{
|
||||
if (where)
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Type mismatch in argument %qs at %L; passed %s to %s",
|
||||
formal->name, where, gfc_typename (&actual->ts),
|
||||
gfc_typename (&formal->ts));
|
||||
{
|
||||
if (formal->attr.artificial)
|
||||
{
|
||||
if (!flag_allow_argument_mismatch || !formal->error)
|
||||
gfc_error_opt (0, "Type mismatch between actual argument at %L "
|
||||
"and actual argument at %L (%s/%s).",
|
||||
&actual->where,
|
||||
&formal->declared_at,
|
||||
gfc_typename (&actual->ts),
|
||||
gfc_typename (&formal->ts));
|
||||
|
||||
formal->error = 1;
|
||||
}
|
||||
else
|
||||
gfc_error_opt (0, "Type mismatch in argument %qs at %L; passed %s "
|
||||
"to %s", formal->name, where, gfc_typename (&actual->ts),
|
||||
gfc_typename (&formal->ts));
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
@ -2512,8 +2544,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
||||
&& gfc_is_coindexed (actual)))
|
||||
{
|
||||
if (where)
|
||||
argument_rank_mismatch (formal->name, &actual->where,
|
||||
symbol_rank (formal), actual->rank);
|
||||
{
|
||||
locus *where_formal;
|
||||
if (formal->attr.artificial)
|
||||
where_formal = &formal->declared_at;
|
||||
else
|
||||
where_formal = NULL;
|
||||
|
||||
argument_rank_mismatch (formal->name, &actual->where,
|
||||
symbol_rank (formal), actual->rank,
|
||||
where_formal);
|
||||
}
|
||||
return false;
|
||||
}
|
||||
else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
|
||||
@ -2584,8 +2625,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
||||
if (ref == NULL && actual->expr_type != EXPR_NULL)
|
||||
{
|
||||
if (where)
|
||||
argument_rank_mismatch (formal->name, &actual->where,
|
||||
symbol_rank (formal), actual->rank);
|
||||
{
|
||||
locus *where_formal;
|
||||
if (formal->attr.artificial)
|
||||
where_formal = &formal->declared_at;
|
||||
else
|
||||
where_formal = NULL;
|
||||
|
||||
argument_rank_mismatch (formal->name, &actual->where,
|
||||
symbol_rank (formal), actual->rank,
|
||||
where_formal);
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
@ -3062,16 +3112,14 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||
f->sym->ts.u.cl->length->value.integer) != 0))
|
||||
{
|
||||
if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
|
||||
gfc_warning (OPT_Wargument_mismatch,
|
||||
"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 (OPT_Wargument_mismatch,
|
||||
"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),
|
||||
@ -3102,8 +3150,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||
&& f->sym->attr.flavor != FL_PROCEDURE)
|
||||
{
|
||||
if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
|
||||
gfc_warning (OPT_Wargument_mismatch,
|
||||
"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);
|
||||
@ -3111,8 +3158,7 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
|
||||
{
|
||||
/* Emit a warning for -std=legacy and an error otherwise. */
|
||||
if (gfc_option.warn_std == 0)
|
||||
gfc_warning (OPT_Wargument_mismatch,
|
||||
"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);
|
||||
@ -4706,8 +4752,7 @@ gfc_check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
|
||||
if (!gfc_check_dummy_characteristics (proc_formal->sym, old_formal->sym,
|
||||
check_type, err, sizeof(err)))
|
||||
{
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Argument mismatch for the overriding procedure "
|
||||
gfc_error_opt (0, "Argument mismatch for the overriding procedure "
|
||||
"%qs at %L: %s", proc->name, &where, err);
|
||||
return false;
|
||||
}
|
||||
@ -5184,6 +5229,7 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
|
||||
}
|
||||
}
|
||||
s->attr.dummy = 1;
|
||||
s->declared_at = a->expr->where;
|
||||
s->attr.intent = INTENT_UNKNOWN;
|
||||
(*f)->sym = s;
|
||||
}
|
||||
|
@ -145,7 +145,7 @@ by type. Explanations are in the following sections.
|
||||
@item Error and Warning Options
|
||||
@xref{Error and Warning Options,,Options to request or suppress errors
|
||||
and warnings}.
|
||||
@gccoptlist{-Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds @gol
|
||||
@gccoptlist{-Waliasing -Wall -Wampersand -Warray-bounds @gol
|
||||
-Wc-binding-type -Wcharacter-truncation -Wconversion @gol
|
||||
-Wdo-subscript -Wfunction-elimination -Wimplicit-interface @gol
|
||||
-Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only @gol
|
||||
@ -236,8 +236,15 @@ intrinsic will be called except when it is explicitly declared @code{EXTERNAL}.
|
||||
Some code contains calls to external procedures whith mismatches
|
||||
between the calls and the procedure definition, or with mismatches
|
||||
between different calls. Such code is non-conforming, and will usually
|
||||
be flagged with an error. This options degrades the error to a
|
||||
warning. This option is implied by @option{-std=legacy}.
|
||||
be flagged wi1th an error. This options degrades the error to a
|
||||
warning, which can only be disabled by disabling all warnings vial
|
||||
@option{-w}. Only a single occurrence per argument is flagged by this
|
||||
warning. @option{-fallow-argument-mismatch} is implied by
|
||||
@option{-std=legacy}.
|
||||
|
||||
Using this option is @emph{strongly} discouraged. It is possible to
|
||||
provide standard-conforming code which allows different types of
|
||||
arguments by using an explicit interface and @code{TYPE(*)}.
|
||||
|
||||
@item -fallow-invalid-boz
|
||||
@opindex @code{allow-invalid-boz}
|
||||
@ -907,15 +914,6 @@ character constant, GNU Fortran assumes continuation at the first
|
||||
non-comment, non-whitespace character after the ampersand that
|
||||
initiated the continuation.
|
||||
|
||||
@item -Wargument-mismatch
|
||||
@opindex @code{Wargument-mismatch}
|
||||
@cindex warnings, argument mismatch
|
||||
@cindex warnings, parameter mismatch
|
||||
@cindex warnings, interface mismatch
|
||||
Warn about type, rank, and other mismatches between formal parameters and actual
|
||||
arguments to functions and subroutines. These warnings are recommended and
|
||||
thus enabled by default.
|
||||
|
||||
@item -Warray-temporaries
|
||||
@opindex @code{Warray-temporaries}
|
||||
@cindex warnings, array temporaries
|
||||
|
@ -210,8 +210,8 @@ Fortran Warning Var(warn_array_temporaries)
|
||||
Warn about creation of array temporaries.
|
||||
|
||||
Wargument-mismatch
|
||||
Fortran Warning Var(warn_argument_mismatch) Init(1)
|
||||
Warn about type and rank mismatches between arguments and parameters.
|
||||
Fortran WarnRemoved
|
||||
Does nothing. Preserved for backward compatibility.
|
||||
|
||||
Wc-binding-type
|
||||
Fortran Var(warn_c_binding_type) Warning LangEnabledBy(Fortran,Wall)
|
||||
|
@ -1429,8 +1429,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
|
||||
if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
|
||||
err, sizeof (err), NULL, NULL))
|
||||
{
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Interface mismatch for procedure-pointer "
|
||||
gfc_error_opt (0, "Interface mismatch for procedure-pointer "
|
||||
"component %qs in structure constructor at %L:"
|
||||
" %s", comp->name, &cons->expr->where, err);
|
||||
return false;
|
||||
@ -2609,8 +2608,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
|
||||
if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
|
||||
reason, sizeof(reason), NULL, NULL))
|
||||
{
|
||||
gfc_error_opt (OPT_Wargument_mismatch,
|
||||
"Interface mismatch in global procedure %qs at %L:"
|
||||
gfc_error_opt (0, "Interface mismatch in global procedure %qs at %L:"
|
||||
" %s", sym->name, &sym->declared_at, reason);
|
||||
goto done;
|
||||
}
|
||||
|
@ -5881,9 +5881,11 @@ generate_local_decl (gfc_symbol * sym)
|
||||
}
|
||||
else if (warn_unused_dummy_argument)
|
||||
{
|
||||
gfc_warning (OPT_Wunused_dummy_argument,
|
||||
"Unused dummy argument %qs at %L", sym->name,
|
||||
&sym->declared_at);
|
||||
if (!sym->attr.artificial)
|
||||
gfc_warning (OPT_Wunused_dummy_argument,
|
||||
"Unused dummy argument %qs at %L", sym->name,
|
||||
&sym->declared_at);
|
||||
|
||||
if (sym->backend_decl != NULL_TREE)
|
||||
TREE_NO_WARNING(sym->backend_decl) = 1;
|
||||
}
|
||||
|
@ -1,3 +1,18 @@
|
||||
2019-09-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/91557
|
||||
PR fortran/91556
|
||||
* gfortran.dg/argument_checking_20.f90: New test.
|
||||
* gfortran.dg/argument_checking_21.f90: New test.
|
||||
* gfortran.dg/argument_checking_22.f90: New test.
|
||||
* gfortran.dg/argument_checking_23.f90: New test.
|
||||
* gfortran.dg/warn_unused_dummy_argument_5.f90: New test.
|
||||
* gfortran.dg/bessel_3.f90: Add pattern for type mismatch.
|
||||
* gfortran.dg/g77/20010519-1.f: Adjust dg-warning messages to new
|
||||
handling.
|
||||
* gfortran.dg/pr24823.f: Likewise.
|
||||
* gfortran.dg/pr39937.f: Likewise.
|
||||
|
||||
2019-09-14 Sandra Loosemore <sandra@codesourcery.com>
|
||||
|
||||
PR testsuite/83889
|
||||
|
11
gcc/testsuite/gfortran.dg/argument_checking_20.f90
Normal file
11
gcc/testsuite/gfortran.dg/argument_checking_20.f90
Normal file
@ -0,0 +1,11 @@
|
||||
! { dg-do compile }
|
||||
program main
|
||||
real :: a(10), b(10,10)
|
||||
! This should be caugt
|
||||
call foo(1.0) ! { dg-error "Rank mismatch" }
|
||||
call foo(b) ! { dg-error "Rank mismatch" }
|
||||
! This is OK
|
||||
call bar(a)
|
||||
call bar(b)
|
||||
|
||||
end program main
|
12
gcc/testsuite/gfortran.dg/argument_checking_21.f90
Normal file
12
gcc/testsuite/gfortran.dg/argument_checking_21.f90
Normal file
@ -0,0 +1,12 @@
|
||||
! { dg-do compile }
|
||||
! { dg-options "-fallow-argument-mismatch" }
|
||||
program main
|
||||
real :: a(10), b(10,10)
|
||||
! This should be caugt
|
||||
call foo(1.0) ! { dg-warning "Rank mismatch" }
|
||||
call foo(b) ! { dg-warning "Rank mismatch" }
|
||||
! This is OK
|
||||
call bar(a)
|
||||
call bar(b)
|
||||
|
||||
end program main
|
15
gcc/testsuite/gfortran.dg/argument_checking_22.f90
Normal file
15
gcc/testsuite/gfortran.dg/argument_checking_22.f90
Normal file
@ -0,0 +1,15 @@
|
||||
! { dg-do compile }
|
||||
! PR 91556 - check that multiple errors are emitted for type mismatch
|
||||
! (and that the check is also done in contained procedures).
|
||||
|
||||
program main
|
||||
real :: a
|
||||
call foo(a) ! { dg-error "Type mismatch" }
|
||||
contains
|
||||
subroutine bar
|
||||
integer :: b
|
||||
complex :: c
|
||||
call foo(b) ! { dg-error "Type mismatch" }
|
||||
call foo(c) ! { dg-error "Type mismatch" }
|
||||
end subroutine bar
|
||||
end program main
|
16
gcc/testsuite/gfortran.dg/argument_checking_23.f90
Normal file
16
gcc/testsuite/gfortran.dg/argument_checking_23.f90
Normal file
@ -0,0 +1,16 @@
|
||||
! { dg-do compile }
|
||||
! { dg-options "-fallow-argument-mismatch" }
|
||||
! PR 91556 - check that only a single warning iw emitted for type
|
||||
! mismatch (and that the check is also done in contained procedures).
|
||||
|
||||
program main
|
||||
real :: a
|
||||
call foo(a) ! { dg-warning "Type mismatch" }
|
||||
contains
|
||||
subroutine bar
|
||||
integer :: b
|
||||
complex :: c
|
||||
call foo(b) ! { dg-warning "Type mismatch" }
|
||||
call foo(c)
|
||||
end subroutine bar
|
||||
end program main
|
@ -8,11 +8,11 @@ IMPLICIT NONE
|
||||
print *, SIN (1.0)
|
||||
print *, BESSEL_J0(1.0) ! { dg-error "has no IMPLICIT type" })
|
||||
print *, BESSEL_J1(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||
print *, BESSEL_JN(1,1.0) ! { dg-error "has no IMPLICIT type" }
|
||||
print *, BESSEL_JN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||
print *, BESSEL_JN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||
|
||||
print *, BESSEL_Y0(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||
print *, BESSEL_Y1(1.0) ! { dg-error "has no IMPLICIT type" }
|
||||
print *, BESSEL_YN(1,1.0) ! { dg-error "has no IMPLICIT type" }
|
||||
print *, BESSEL_YN(1,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||
print *, BESSEL_YN(1,2,1.0) ! { dg-error "has no IMPLICIT type|Type mismatch" }
|
||||
end
|
||||
|
@ -773,7 +773,7 @@ C
|
||||
NTR=6
|
||||
OLDPRN=PRNLEV
|
||||
PRNLEV=1
|
||||
CALL ORTHNM(1,6,NTR,HEAP(TRAROT),NAT3,.FALSE.,TOLER)
|
||||
CALL ORTHNM(1,6,NTR,HEAP(TRAROT),NAT3,.FALSE.,TOLER) ! { dg-warning "Type mismatch" }
|
||||
PRNLEV=OLDPRN
|
||||
IF(IUNRMD .LT. 0) THEN
|
||||
C
|
||||
@ -1126,7 +1126,7 @@ C
|
||||
NFCUT=NFRET
|
||||
OLDPRN=PRNLEV
|
||||
PRNLEV=1
|
||||
CALL ORTHNM(1,NFRET,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
|
||||
CALL ORTHNM(1,NFRET,NFCUT,DDV,NAT3,LPURG,TOLER)
|
||||
PRNLEV=OLDPRN
|
||||
NFRET=NFCUT
|
||||
IF(PRNLEV.GE.2) WRITE(OUTU,568) NFRET
|
||||
@ -1174,7 +1174,7 @@ C TO DO-THE-DIAGONALISATIONS
|
||||
NFSAV=NFCUT1
|
||||
OLDPRN=PRNLEV
|
||||
PRNLEV=1
|
||||
CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
|
||||
CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
|
||||
PRNLEV=OLDPRN
|
||||
CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
|
||||
NFRET=NDIM+NFCUT
|
||||
@ -1224,7 +1224,7 @@ C
|
||||
CALL ADZERD(DDV,1,NFCUT1,NAT3,IS1,IS2,IS3,IS4)
|
||||
OLDPRN=PRNLEV
|
||||
PRNLEV=1
|
||||
CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER) ! { dg-warning "Type mismatch" }
|
||||
CALL ORTHNM(1,NFCUT1,NFCUT,DDV,NAT3,LPURG,TOLER)
|
||||
PRNLEV=OLDPRN
|
||||
CALL CPARAY(HEAP(DDVBAS),DDV,NAT3,1,NFCUT,1)
|
||||
C
|
||||
|
@ -50,9 +50,9 @@
|
||||
IF( I.LT.1 ) THEN
|
||||
IF( ISYM.EQ.0 ) THEN
|
||||
A( J-I+1, I ) = DCONJG( ZLATM2( M, N, I, J, KL,
|
||||
$ DR, IPVTNG, IWORK, SPARSE ) )
|
||||
$ DR, IPVTNG, IWORK, SPARSE ) ) ! { dg-warning "Type mismatch" }
|
||||
ELSE
|
||||
A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
|
||||
A( J-I+1, I ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
|
||||
$ IPVTNG, IWORK, SPARSE )
|
||||
END IF
|
||||
END IF
|
||||
@ -61,7 +61,7 @@
|
||||
IF( ISYM.EQ.0 ) THEN
|
||||
END IF
|
||||
END IF
|
||||
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU, ! { dg-warning "Type mismatch" }
|
||||
A( I-J+KUU+1, J ) = ZLATM2( M, N, I, J, KL, KU,
|
||||
$ DR, IPVTNG, IWORK, SPARSE )
|
||||
END IF
|
||||
END IF
|
||||
|
@ -6,7 +6,7 @@ C { dg-options "-std=legacy" }
|
||||
$ WORK( * )
|
||||
DOUBLE PRECISION X( 2, 2 )
|
||||
CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
|
||||
$ ZERO, X, 2, SCALE, XNORM, IERR )
|
||||
$ ZERO, X, 2, SCALE, XNORM, IERR ) ! { dg-warning "Type mismatch" }
|
||||
CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
|
||||
DO 90 J = KI - 2, 1, -1
|
||||
IF( J.GT.JNXT )
|
||||
@ -19,8 +19,8 @@ C { dg-options "-std=legacy" }
|
||||
END IF
|
||||
END IF
|
||||
CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
|
||||
$ T( J-1, J-1 ), LDT, ONE, ONE,
|
||||
$ XNORM, IERR ) ! { dg-warning "Type mismatch" }
|
||||
$ T( J-1, J-1 ), LDT, ONE, ONE, ! { dg-warning "Type mismatch" }
|
||||
$ XNORM, IERR )
|
||||
CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
|
||||
$ WORK( 1+N ), 1 )
|
||||
CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
|
||||
|
16
gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_5.f90
Normal file
16
gcc/testsuite/gfortran.dg/warn_unused_dummy_argument_5.f90
Normal file
@ -0,0 +1,16 @@
|
||||
! { dg-do compile }
|
||||
! { dg-additional-options "-Wunused-dummy-argument" }
|
||||
! PR 91557 - this used to generate a bogus warning
|
||||
! Test case by Gerhard Steinmetz
|
||||
program p
|
||||
integer :: a, b
|
||||
a = 1
|
||||
call g
|
||||
contains
|
||||
subroutine g
|
||||
integer :: x, y
|
||||
call h (x, y)
|
||||
if ( a > 0 ) y = y - 1
|
||||
b = y - x + 1
|
||||
end
|
||||
end
|
Loading…
Reference in New Issue
Block a user