diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b92928ce443..d47eeb05ffe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2016-11-02 Fritz O. Reese + + * lang.opt, invoke.texi: New argument -Wargument-mismatch. + * interface.c (compare_parameter, compare_actual_formal, + gfc_check_typebound_override, argument_rank_mismatch): Control argument + mismatch warnings with -Wargument-mismatch. + * resolve.c (resolve_structure_cons, resolve_global_procedure): Ditto. + 2016-11-02 Fritz Reese * gfortran.h (gfc_error): New declaration for gfc_error with 'opt'. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index b851d5a425b..4dd432ef23d 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -2139,17 +2139,17 @@ argument_rank_mismatch (const char *name, locus *where, } else if (rank1 == 0) { - gfc_error ("Rank mismatch in argument %qs at %L " + gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "(scalar and rank-%d)", name, where, rank2); } else if (rank2 == 0) { - gfc_error ("Rank mismatch in argument %qs at %L " + gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "(rank-%d and scalar)", name, where, rank1); } else { - gfc_error ("Rank mismatch in argument %qs at %L " + gfc_error (OPT_Wargument_mismatch, "Rank mismatch in argument %qs at %L " "(rank-%d and rank-%d)", name, where, rank1, rank2); } } @@ -2200,7 +2200,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, sizeof(err), NULL, NULL)) { if (where) - gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s", + gfc_error (OPT_Wargument_mismatch, + "Interface mismatch in dummy procedure %qs at %L: %s", formal->name, &actual->where, err); return 0; } @@ -2227,7 +2228,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, err, sizeof(err), NULL, NULL)) { if (where) - gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s", + gfc_error (OPT_Wargument_mismatch, + "Interface mismatch in dummy procedure %qs at %L: %s", formal->name, &actual->where, err); return 0; } @@ -2253,7 +2255,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, CLASS_DATA (actual)->ts.u.derived))) { if (where) - gfc_error ("Type mismatch in argument %qs at %L; passed %s to %s", + gfc_error (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)); return 0; @@ -2957,7 +2960,7 @@ 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 (0, + gfc_warning (OPT_Wargument_mismatch, "Character length mismatch (%ld/%ld) between actual " "argument and pointer or allocatable dummy argument " "%qs at %L", @@ -2965,7 +2968,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, mpz_get_si (f->sym->ts.u.cl->length->value.integer), f->sym->name, &a->expr->where); else if (where) - gfc_warning (0, + gfc_warning (OPT_Wargument_mismatch, "Character length mismatch (%ld/%ld) between actual " "argument and assumed-shape dummy argument %qs " "at %L", @@ -2997,12 +3000,14 @@ 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 (0, "Character length of actual argument shorter " + gfc_warning (OPT_Wargument_mismatch, + "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 (0, "Actual argument contains too few " + gfc_warning (OPT_Wargument_mismatch, + "Actual argument contains too few " "elements for dummy argument %qs (%lu/%lu) at %L", f->sym->name, actual_size, formal_size, &a->expr->where); @@ -4547,7 +4552,8 @@ 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 ("Argument mismatch for the overriding procedure " + gfc_error (OPT_Wargument_mismatch, + "Argument mismatch for the overriding procedure " "%qs at %L: %s", proc->name, &where, err); return false; } diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index ebf3aba8d4a..83fdf012f92 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -141,7 +141,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 -Warray-bounds +@gccoptlist{-Waliasing -Wall -Wampersand -Wargument-mismatch -Warray-bounds -Wc-binding-type -Wcharacter-truncation @gol -Wconversion -Wfunction-elimination -Wimplicit-interface @gol -Wimplicit-procedure -Wintrinsic-shadow -Wuse-without-only -Wintrinsics-std @gol @@ -821,6 +821,15 @@ given in a continued 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 diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 2e7640302ee..e39e555792f 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -209,6 +209,10 @@ Warray-temporaries 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. + Wc-binding-type Fortran Var(warn_c_binding_type) Warning LangEnabledBy(Fortran,Wall) Warn if the type of a variable might be not interoperable with C. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f9d11be5997..14685d274d2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1317,7 +1317,8 @@ 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 ("Interface mismatch for procedure-pointer component " + gfc_error (OPT_Wargument_mismatch, + "Interface mismatch for procedure-pointer component " "%qs in structure constructor at %L: %s", comp->name, &cons->expr->where, err); return false; @@ -2469,7 +2470,8 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, reason, sizeof(reason), NULL, NULL)) { - gfc_error ("Interface mismatch in global procedure %qs at %L: %s ", + gfc_error (OPT_Wargument_mismatch, + "Interface mismatch in global procedure %qs at %L: %s ", sym->name, &sym->declared_at, reason); goto done; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9de4572b13d..e475c0e2606 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-11-02 Fritz O. Reese + + * gfortran.dg/warn_argument_mismatch_1.f90: New test. + 2016-11-02 David Edelsohn * gcc.dg/debug/dwarf2/prod-options.c: XFAIL AIX. diff --git a/gcc/testsuite/gfortran.dg/warn_argument_mismatch_1.f90 b/gcc/testsuite/gfortran.dg/warn_argument_mismatch_1.f90 new file mode 100644 index 00000000000..6a663e66b5f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/warn_argument_mismatch_1.f90 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-Wno-argument-mismatch" } +! +! No warnings should be output here with -Wno-argument-mismatch. +! + +subroutine s1(x) + implicit none + integer, intent(in) :: x + print *, x +end subroutine + +subroutine s2(x) + implicit none + integer, intent(in) :: x(1) + print *, x +end subroutine + +subroutine s3(x) + implicit none + integer, intent(in) :: x(2) + print *, x +end subroutine + +implicit none +integer :: x, y(1) +real :: r + +call s1(r) +call s1(y) +call s2(x) +call s3(y) + +end