From patchwork Sun Jun 14 10:10:07 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1308928 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gcc.gnu.org Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.a=rsa-sha256 header.s=default header.b=xaauqwFh; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 49l9FT12Phz9sRK for ; Sun, 14 Jun 2020 20:10:19 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 3F27B388A810; Sun, 14 Jun 2020 10:10:15 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 3F27B388A810 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1592129415; bh=vDBLo1kx+1RHfabdfbTR6SlHTyVJ+IE6Zv8zY6KGYms=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=xaauqwFhu+Etw7xogDjIA8BulqVzwWtDx+vXCnv5RIPrC6DUm3RD9iy+Jnr5I0KvE z9YqeC3vrrsdjTiLXGiFn2rX6SIdc9vbNfRVcMFSTm0lICFkkhFFr857Ia0vWpm86l 57HeHiX/PrsZGLB9aZLbIoY5jt4mbWifBZh0rJhU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from cc-smtpout3.netcologne.de (cc-smtpout3.netcologne.de [89.1.8.213]) by sourceware.org (Postfix) with ESMTPS id 140113870841; Sun, 14 Jun 2020 10:10:11 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 140113870841 Received: from cc-smtpin2.netcologne.de (cc-smtpin2.netcologne.de [89.1.8.202]) by cc-smtpout3.netcologne.de (Postfix) with ESMTP id C2F6A12B74; Sun, 14 Jun 2020 12:10:08 +0200 (CEST) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin2.netcologne.de (Postfix) with ESMTP id B54B411EA3; Sun, 14 Jun 2020 12:10:08 +0200 (CEST) Received: from [2001:4dd6:36e3:0:5b1c:29fc:15e7:fe34] (helo=cc-smtpin2.netcologne.de) by localhost with ESMTP (eXpurgate 4.11.6) (envelope-from ) id 5ee5f780-4f6f-7f0000012729-7f000001a8a8-1 for ; Sun, 14 Jun 2020 12:10:08 +0200 Received: from linux-p51k.fritz.box (2001-4dd6-36e3-0-5b1c-29fc-15e7-fe34.ipv6dyn.netcologne.de [IPv6:2001:4dd6:36e3:0:5b1c:29fc:15e7:fe34]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin2.netcologne.de (Postfix) with ESMTPSA; Sun, 14 Jun 2020 12:10:07 +0200 (CEST) To: "fortran@gcc.gnu.org" , gcc-patches Subject: [patch, fortran] PR 27318, warn if interfaces do not match Message-ID: Date: Sun, 14 Jun 2020 12:10:07 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.9.0 MIME-Version: 1.0 Content-Language: de-DE X-Spam-Status: No, score=-10.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Thomas Koenig via Gcc-patches From: Thomas Koenig Reply-To: Thomas Koenig Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" 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. 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