From: Thomas Koenig <tkoenig@netcologne.de>
To: dhumieres.dominique@free.fr, fortran@gcc.gnu.org,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: *ping* [patch, fortran] PR 27318, warn if interfaces do not match
Date: Tue, 30 Jun 2020 23:39:09 +0200 [thread overview]
Message-ID: <1a91a852-91f0-25da-32db-5fa18c7252fe@netcologne.de> (raw)
In-Reply-To: <3bf5d3084bdb3a1e6c8e7e519b7823de@free.fr>
[-- 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" }
next parent reply other threads:[~2020-06-30 21:39 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <3bf5d3084bdb3a1e6c8e7e519b7823de@free.fr>
2020-06-30 21:39 ` Thomas Koenig [this message]
2020-07-02 10:15 ` dhumieres.dominique
2020-07-02 12:40 ` Paul Richard Thomas
2020-07-05 18:15 ` Thomas Koenig
2020-06-14 10:10 Thomas Koenig
2020-06-21 10:20 ` *ping* " Thomas Koenig
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1a91a852-91f0-25da-32db-5fa18c7252fe@netcologne.de \
--to=tkoenig@netcologne.de \
--cc=dhumieres.dominique@free.fr \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).