[patch, fortran] PR 27318, warn if interfaces do not match

[patch, fortran] PR 27318, warn if interfaces do not match

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 1126 bytes --]

Hello world,

this patch solves an PR which just had its 14th birthday,
continuing the mission of alerting the user to mismatches where
possible.

Regression-tested (which led to a few of the extra checks for errors).
OK for trunk?

Regards

	Thomas

Test global identifiers against what is specified interfaces.

Apart from calling gfc_compare_interfaces to check interfaces against
global identifiers, this also sets and check a few sym->error flags
to avoid duplicate error messages.  I thought about issuing errors
on mismatched interfaces, but when the procedure is not invoked,
a warning should be enough to alert the user.

gcc/fortran/ChangeLog:

	PR fortran/27318
	* frontend-passes.c (check_against_globals): New function.
	(gfc_check_externals): Split; also invoke check_against_globals
	via gfc_traverse_ns.
	(gfc_check_externals0): Recursive part formerly in
	gfc_check_externals.
	* resolve.c (resolve_global_procedure): Set sym->error on
	interface mismatch.
	* symbol.c (ambiguous_symbol): Check for, and set sym->error.

gcc/testsuite/ChangeLog:

	PR fortran/27318
	* gfortran.dg/interface_47.f90: New test.


[-- Attachment #2: p3.diff --]
[-- Type: text/x-patch, Size: 4357 bytes --]

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index d5d71b5fda4..69f9ca64c97 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5493,26 +5493,75 @@ check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
   return check_externals_procedure (sym, loc, actual);
 }
 
-/* Called routine.  */
+/* Function to check if any interface clashes with a global
+   identifier, to be invoked via gfc_traverse_ns.  */
 
-void
-gfc_check_externals (gfc_namespace *ns)
+static void
+check_against_globals (gfc_symbol *sym)
 {
+  gfc_gsymbol *gsym;
+  gfc_symbol *def_sym = NULL;
+  const char *sym_name;
+  char buf  [200];
 
-  gfc_clear_error ();
+  if (sym->attr.if_source != IFSRC_IFBODY || sym->attr.flavor != FL_PROCEDURE
+      || sym->attr.generic || sym->error)
+    return;
 
-  /* Turn errors into warnings if the user indicated this.  */
+  if (sym->binding_label)
+    sym_name = sym->binding_label;
+  else
+    sym_name = sym->name;
 
-  if (!pedantic && flag_allow_argument_mismatch)
-    gfc_errors_to_warnings (true);
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym_name);
+  if (gsym && gsym->ns)
+    gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+  if (!def_sym || def_sym->error || def_sym->attr.generic)
+    return;
+
+  buf[0] = 0;
+  gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, buf, sizeof(buf),
+			  NULL, NULL, NULL);
+  if (buf[0] != 0)
+    {
+      gfc_warning (0, "%s between %L and %L", buf, &def_sym->declared_at,
+		   &sym->declared_at);
+      sym->error = 1;
+      def_sym->error = 1;
+    }
+
+}
+
+/* Do the code-walkling part for gfc_check_externals.  */
 
+static void
+gfc_check_externals0 (gfc_namespace *ns)
+{
   gfc_code_walker (&ns->code, check_externals_code, check_externals_expr, NULL);
 
   for (ns = ns->contained; ns; ns = ns->sibling)
     {
       if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
-	gfc_check_externals (ns);
+	gfc_check_externals0 (ns);
     }
 
+}
+
+/* Called routine.  */
+
+void gfc_check_externals (gfc_namespace *ns)
+{
+  gfc_clear_error ();
+
+  /* Turn errors into warnings if the user indicated this.  */
+
+  if (!pedantic && flag_allow_argument_mismatch)
+    gfc_errors_to_warnings (true);
+
+  gfc_check_externals0 (ns);
+  gfc_traverse_ns (ns, check_against_globals);
+
   gfc_errors_to_warnings (false);
 }
+
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index aaee5eb6b9b..82d831771f7 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2618,6 +2618,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
 
 	  gfc_error ("Interface mismatch in global procedure %qs at %L: %s",
 		     sym->name, &sym->declared_at, reason);
+	  sym->error = 1;
 	  gfc_errors_to_warnings (false);
 	  goto done;
 	}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index b96706138c9..34c2060d21c 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3143,18 +3143,24 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
 }
 
 
-/* Generate an error if a symbol is ambiguous.  */
+/* Generate an error if a symbol is ambiguous, and set the error flag
+   on it.  */
 
 static void
 ambiguous_symbol (const char *name, gfc_symtree *st)
 {
 
+  if (st->n.sym->error)
+    return;
+
   if (st->n.sym->module)
     gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
 	       "from module %qs", name, st->n.sym->name, st->n.sym->module);
   else
     gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
 	       "from current program unit", name, st->n.sym->name);
+
+  st->n.sym->error = 1;
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/interface_47.f90 b/gcc/testsuite/gfortran.dg/interface_47.f90
new file mode 100644
index 00000000000..6f1d1a74ffc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_47.f90
@@ -0,0 +1,19 @@
+! PR fortran/27318
+! { dg-do compile }
+! This tests for mismatch between the interface for a global
+! procedure and the procedure itself.
+
+module test
+implicit none
+interface
+   subroutine hello(n) ! { dg-warning "INTENT mismatch" }
+     integer :: n
+   end subroutine hello
+end interface
+end module test
+
+subroutine hello(n)  ! { dg-warning "INTENT mismatch" }
+  integer, intent(in) :: n
+  integer :: i
+  do i = 1,n; print *, 'hello'; end do
+end subroutine hello

*ping* [patch, fortran] PR 27318, warn if interfaces do not match

[Thomas Koenig]

Am 14.06.20 um 12:10 schrieb Thomas Koenig:
> Hello world,
> 
> this patch solves an PR which just had its 14th birthday,
> continuing the mission of alerting the user to mismatches where
> possible.
> 
> Regression-tested (which led to a few of the extra checks for errors).
> OK for trunk?

Ping?

I'd like to get this committed in a few days.  (I am getting the feeling
that I am the only active reviewer for anything except OpenAcc and
OpenMP at the moment.  While I can do that, at least at the moment,
I think it's a bit unhealthy to have only one person do this, and it
also makes it hard to get my own patches in, unless I bend the rules
a bit and commit anyway after a previous announcement).

Regards

	Thomas

Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match

[Thomas Koenig]

Hi Paul and Dominique,

> The patch looks fine to me. If Dominique has nothing to report then it is
> OK for trunk.

committed. Thanks!

Regards

	Thomas

Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match

[Paul Richard Thomas]

Hi Thomas and Dominique,

The patch looks fine to me. If Dominique has nothing to report then it is
OK for trunk.

Thanks

Paul


On Thu, 2 Jul 2020 at 11:15, <dhumieres.dominique@free.fr> wrote:

> Le 2020-06-30 23:39, Thomas Koenig a écrit :
> > OK,
> >
> > so here is an updated version, which includes the updated test cases.
> >
> > Anything else?  OK for trunk?
> >
>
> Nothing to report!-)
>
> Thanks for the patch,
>
> Dominique
>


-- 
"If you can't explain it simply, you don't understand it well enough" -
Albert Einstein

Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match

[dhumieres.dominique]

Le 2020-06-30 23:39, Thomas Koenig a écrit :
> OK,
> 
> so here is an updated version, which includes the updated test cases.
> 
> Anything else?  OK for trunk?
> 

Nothing to report!-)

Thanks for the patch,

Dominique

Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 973 bytes --]

OK,

so here is an updated version, which includes the updated test cases.

Anything else?  OK for trunk?

(And will I "see" anybody at the Fortran Conference ? )

Best regards

	Thomas

Test global identifiers against what is specified interfaces.

Apart from calling gfc_compare_interfaces to check interfaces against
global identifiers, this also sets and check a few sym->error flags
to avoid duplicate error messages.  I thought about issuing errors
on mismatched interfaces, but when the procedure is not invoked,
a warning should be enough to alert the user.

gcc/fortran/ChangeLog:

	PR fortran/27318
	* frontend-passes.c (check_against_globals): New function.
	(gfc_check_externals): Split; also invoke check_against_globals
	via gfc_traverse_ns.
	(gfc_check_externals0): Recursive part formerly in
	gfc_check_externals.
	* resolve.c (resolve_global_procedure): Set sym->error on
	interface mismatch.
	* symbol.c (ambiguous_symbol): Check for, and set sym->error.

[-- Attachment #2: p4.diff --]
[-- Type: text/x-patch, Size: 5575 bytes --]

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index d5d71b5fda4..69f9ca64c97 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5493,26 +5493,75 @@ check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
   return check_externals_procedure (sym, loc, actual);
 }
 
-/* Called routine.  */
+/* Function to check if any interface clashes with a global
+   identifier, to be invoked via gfc_traverse_ns.  */
 
-void
-gfc_check_externals (gfc_namespace *ns)
+static void
+check_against_globals (gfc_symbol *sym)
 {
+  gfc_gsymbol *gsym;
+  gfc_symbol *def_sym = NULL;
+  const char *sym_name;
+  char buf  [200];
 
-  gfc_clear_error ();
+  if (sym->attr.if_source != IFSRC_IFBODY || sym->attr.flavor != FL_PROCEDURE
+      || sym->attr.generic || sym->error)
+    return;
 
-  /* Turn errors into warnings if the user indicated this.  */
+  if (sym->binding_label)
+    sym_name = sym->binding_label;
+  else
+    sym_name = sym->name;
 
-  if (!pedantic && flag_allow_argument_mismatch)
-    gfc_errors_to_warnings (true);
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym_name);
+  if (gsym && gsym->ns)
+    gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+  if (!def_sym || def_sym->error || def_sym->attr.generic)
+    return;
+
+  buf[0] = 0;
+  gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, buf, sizeof(buf),
+			  NULL, NULL, NULL);
+  if (buf[0] != 0)
+    {
+      gfc_warning (0, "%s between %L and %L", buf, &def_sym->declared_at,
+		   &sym->declared_at);
+      sym->error = 1;
+      def_sym->error = 1;
+    }
+
+}
+
+/* Do the code-walkling part for gfc_check_externals.  */
 
+static void
+gfc_check_externals0 (gfc_namespace *ns)
+{
   gfc_code_walker (&ns->code, check_externals_code, check_externals_expr, NULL);
 
   for (ns = ns->contained; ns; ns = ns->sibling)
     {
       if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
-	gfc_check_externals (ns);
+	gfc_check_externals0 (ns);
     }
 
+}
+
+/* Called routine.  */
+
+void gfc_check_externals (gfc_namespace *ns)
+{
+  gfc_clear_error ();
+
+  /* Turn errors into warnings if the user indicated this.  */
+
+  if (!pedantic && flag_allow_argument_mismatch)
+    gfc_errors_to_warnings (true);
+
+  gfc_check_externals0 (ns);
+  gfc_traverse_ns (ns, check_against_globals);
+
   gfc_errors_to_warnings (false);
 }
+
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f3e8ffc204c..570a41b3ac8 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2618,6 +2618,7 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
 
 	  gfc_error ("Interface mismatch in global procedure %qs at %L: %s",
 		     sym->name, &sym->declared_at, reason);
+	  sym->error = 1;
 	  gfc_errors_to_warnings (false);
 	  goto done;
 	}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 96e4cee3040..abd3b5ccfd0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3145,18 +3145,24 @@ gfc_new_symbol (const char *name, gfc_namespace *ns)
 }
 
 
-/* Generate an error if a symbol is ambiguous.  */
+/* Generate an error if a symbol is ambiguous, and set the error flag
+   on it.  */
 
 static void
 ambiguous_symbol (const char *name, gfc_symtree *st)
 {
 
+  if (st->n.sym->error)
+    return;
+
   if (st->n.sym->module)
     gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
 	       "from module %qs", name, st->n.sym->name, st->n.sym->module);
   else
     gfc_error ("Name %qs at %C is an ambiguous reference to %qs "
 	       "from current program unit", name, st->n.sym->name);
+
+  st->n.sym->error = 1;
 }
 
 
diff --git a/gcc/testsuite/gfortran.dg/error_recovery_1.f90 b/gcc/testsuite/gfortran.dg/error_recovery_1.f90
index 7f19ab51e50..9e2540c0787 100644
--- a/gcc/testsuite/gfortran.dg/error_recovery_1.f90
+++ b/gcc/testsuite/gfortran.dg/error_recovery_1.f90
@@ -2,14 +2,14 @@
 ! PR fortran/24549 (and duplicate PR fortran/27487)
 module gfcbug29_import
   interface
-     subroutine foo (x)
+     subroutine foo (x) ! { dg-warning "wrong number of arguments" }
        something :: dp ! { dg-error "Unclassifiable statement" }
        real (kind=dp) :: x ! { dg-error "has not been declared or is a variable, which does not reduce to a constant expression" }
      end subroutine foo
   end interface
 end module gfcbug29_import
 
-subroutine FOO
+subroutine FOO ! { dg-warning "wrong number of arguments" }
     X :: I
     equivalence (I,I)
 end
diff --git a/gcc/testsuite/gfortran.dg/interface_47.f90 b/gcc/testsuite/gfortran.dg/interface_47.f90
new file mode 100644
index 00000000000..6f1d1a74ffc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_47.f90
@@ -0,0 +1,19 @@
+! PR fortran/27318
+! { dg-do compile }
+! This tests for mismatch between the interface for a global
+! procedure and the procedure itself.
+
+module test
+implicit none
+interface
+   subroutine hello(n) ! { dg-warning "INTENT mismatch" }
+     integer :: n
+   end subroutine hello
+end interface
+end module test
+
+subroutine hello(n)  ! { dg-warning "INTENT mismatch" }
+  integer, intent(in) :: n
+  integer :: i
+  do i = 1,n; print *, 'hello'; end do
+end subroutine hello
diff --git a/gcc/testsuite/gfortran.dg/use_15.f90 b/gcc/testsuite/gfortran.dg/use_15.f90
index eb5aa87cc8b..9722db4ddb3 100644
--- a/gcc/testsuite/gfortran.dg/use_15.f90
+++ b/gcc/testsuite/gfortran.dg/use_15.f90
@@ -34,4 +34,4 @@ subroutine my_sub3 (a)              ! { dg-error "\(1\)" }
   print *, a
 end subroutine
 
-END
+END ! { dg-error "is an ambiguous reference" }