New warning -Wargument-mismatch for function argument mismatches.
authorFritz O. Reese <fritzoreese@gmail.com>
Wed, 2 Nov 2016 14:56:41 +0000 (14:56 +0000)
committerFritz Reese <foreese@gcc.gnu.org>
Wed, 2 Nov 2016 14:56:41 +0000 (14:56 +0000)
gcc/fortran/
* 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.

gcc/testsuite/gfortran.dg/
* warn_argument_mismatch_1.f90: New test.

From-SVN: r241795

gcc/fortran/ChangeLog
gcc/fortran/interface.c
gcc/fortran/invoke.texi
gcc/fortran/lang.opt
gcc/fortran/resolve.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/warn_argument_mismatch_1.f90 [new file with mode: 0644]

index b92928ce443343a3f747b0d1d4d646e3eb8c0429..d47eeb05ffe879d948681144f061c810945d6acd 100644 (file)
@@ -1,3 +1,11 @@
+2016-11-02  Fritz O. Reese <fritzoreese@gmail.com>
+
+       * 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 <fritzoreese@gmail.com>
 
        * gfortran.h (gfc_error): New declaration for gfc_error with 'opt'.
index b851d5a425bdb4ad10ffb95843e767a8e929f0a3..4dd432ef23d21fc145432ab0cb581ab4eadbc54b 100644 (file)
@@ -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;
        }
index ebf3aba8d4a134dd4299f6edb8e3259a1c185c03..83fdf012f92eac0865e6974883cb85ae12fc5cc6 100644 (file)
@@ -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
index 2e7640302ee6f11106e923ebeef65ff55b86f965..e39e555792f46d2de8481a285161fef3d6e372f8 100644 (file)
@@ -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.
index f9d11be59979d1cbef59bbf731e6c244eeae9ec2..14685d274d24b997038d51072927d8f5934cc2fc 100644 (file)
@@ -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;
        }
index 9de4572b13d51cf0def15225317d266f94a6c40f..e475c0e2606bda81a1d314ff0aa7ad20a5cb34f4 100644 (file)
@@ -1,3 +1,7 @@
+2016-11-02  Fritz O. Reese <fritzoreese@gmail.com>
+
+       * gfortran.dg/warn_argument_mismatch_1.f90: New test.
+
 2016-11-02  David Edelsohn  <dje.gcc@gmail.com>
 
        * 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 (file)
index 0000000..6a663e6
--- /dev/null
@@ -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