From patchwork Tue Mar 12 21:42:21 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 1055773 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-497778-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=pass (p=quarantine dis=none) header.from=netcologne.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="XYxQupYr"; dkim=pass (2048-bit key; unprotected) header.d=netcologne.de header.i=@netcologne.de header.b="QGN9LUoN"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 44JpNf6q5rz9s70 for ; Wed, 13 Mar 2019 08:42:42 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=Y9iGgwGJ5vWl6PmVJlZn+N587Sw6cEBhpalOJPp4e+N6feh6wR P9CoTAoZYENIWVaJUL6d2MN70I5cPXxULer3P3FfzO/nMxppAqMIaQomu7eGGbcW aDq5UTwIbeG8N359fmmxZja935B0XcKkQfgN6qTChRHyYGVZOVb5NOO9k= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=DR8Y3EE1ZksuSB+iAipvCXaMt4w=; b=XYxQupYrMAlXx/eqo6p6 mU4Hkyw1A3VV3ofwc+uC4MUmFxJXYttOy4+5JCYe1jtkFI92mzfiKV2azll7dXRD 3rWLaaLM+EQYkMfX1FxNnA0+msven184zT7SHOr816TZXatC5ID0S9MULcLw/l9k pTi3MpkuuSu45vxJIfMCV2g= Received: (qmail 121904 invoked by alias); 12 Mar 2019 21:42:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 121888 invoked by uid 89); 12 Mar 2019 21:42:31 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-9.8 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_NUMSUBJECT, KAM_STOCKGEN, RCVD_IN_DNSWL_LOW, SPF_PASS autolearn=ham version=3.3.1 spammy=gfortran.h, UD:gfortran.h, gfortranh, H*F:U*tkoenig X-HELO: cc-smtpout1.netcologne.de Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 12 Mar 2019 21:42:28 +0000 Received: from cc-smtpin3.netcologne.de (cc-smtpin3.netcologne.de [89.1.8.203]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 28E4313312; Tue, 12 Mar 2019 22:42:23 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=netcologne.de; s=nc1116a; t=1552426943; bh=Xk+FQd0FEyOhRUSoxN3O0YEmgKRMwx7XyNQiFaia5b8=; h=To:From:Subject:Message-ID:Date:From; b=QGN9LUoN0Fkw7a/4g77UT2WKTG7nEUx4yShNme9dNv8vP9WI8/BsaQjSRrFWBwGFk ukjiSIjje0Wws+5FgK6TQC79h0d26aZrAKvJ3FkGqkilHX/20tmY5F8EX5Glqja+fy u21zcVgH8JN6mw127uYjO7JT0VdsifGUUIKyJuNkX3iRge2LQ+P51+Ui1GFiVGD2Ax nOiE9dCeFNJeQcofT+7gYkQGX8zemUz1Katj5gO6zJjxOdpUmVwtX9Wo7PPbyG3zu2 IEQ0uSDj58pC2ZHMYRAPgRc0RV70oKPgF8IDk79jpyahm/ObdPEhWMcbPPdJOR1OBf YakTwMf9IT4bA== Received: from localhost (localhost [127.0.0.1]) by cc-smtpin3.netcologne.de (Postfix) with ESMTP id 1824811EF1; Tue, 12 Mar 2019 22:42:23 +0100 (CET) Received: from [2001:4dd6:32f0:0:7285:c2ff:fe6c:992d] (helo=cc-smtpin3.netcologne.de) by localhost with ESMTP (eXpurgate 4.6.0) (envelope-from ) id 5c8827bf-0bea-7f0000012729-7f000001c7e2-1 for ; Tue, 12 Mar 2019 22:42:23 +0100 Received: from [IPv6:2001:4dd6:32f0:0:7285:c2ff:fe6c:992d] (2001-4dd6-32f0-0-7285-c2ff-fe6c-992d.ipv6dyn.netcologne.de [IPv6:2001:4dd6:32f0:0:7285:c2ff:fe6c:992d]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin3.netcologne.de (Postfix) with ESMTPSA; Tue, 12 Mar 2019 22:42:21 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Fix PR 66695, 77746 and 79485 Message-ID: <5b16d6f2-1bc0-f959-6e55-3589112102e6@netcologne.de> Date: Tue, 12 Mar 2019 22:42:21 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.5.1 MIME-Version: 1.0 Hello world, the attached patch fixes three very closely related 7/8/9 regressions. The common root cause of these PRs was that , if a binding label existed, gfc_get_extern_function_decl first looked for that name in the global symbol table for that function and used its backend_decl. If there was a module procedure with the same name as the BIND(C) routine (perfectly legal), the wrong procedure would then be called. The approach is straightforward: In the global symbol table, record whether we are looking at a "normal" or a BIND(C) name, and if we come across the wrong kind of entry in gfc_get_extern_function_decl, just ignore it. Regressoin-tested. OK for trunk? Regards Thomas 2019-03-12 Thomas Koenig PR fortran/66695 PR fortran/77746 PR fortran/79485 * gfortran.h (gfc_symbol): Add bind_c component. (gfc_get_gsymbol): Add argument bind_c. * decl.c (add_global_entry): Add bind_c argument to gfc_get_symbol. * parse.c (parse_block_data): Likewise. (parse_module): Likewise. (add_global_procedure): Likewise. (add_global_program): Likewise. * resolve.c (resolve_common_blocks): Likewise. (resolve_global_procedure): Likewise. (gfc_verify_binding_labels): Likewise. * symbol.c (gfc_get_gsymbol): Add argument bind_c. Set bind_c in gsym. * trans-decl.c (gfc_get_module_backend_decl): Add bind_c argument to gfc_get_symbol. (gfc_get_extern_function_decl): If the sym has a binding label and it cannot be found in the global symbol tabel, it is the wrong one and vice versa. 2019-03-12 Thomas Koenig PR fortran/66695 PR fortran/77746 PR fortran/79485 * gfortran.dg/binding_label_tests_24.f90: New test. * gfortran.dg/binding_label_tests_25.f90: New test. * gfortran.dg/binding_label_tests_26.f90: New test. * gfortran.dg/binding_label_tests_27.f90: New test. Index: gfortran.h =================================================================== --- gfortran.h (Revision 269624) +++ gfortran.h (Arbeitskopie) @@ -1891,6 +1891,7 @@ typedef struct gfc_gsymbol enum gfc_symbol_type type; int defined, used; + bool bind_c; locus where; gfc_namespace *ns; } @@ -3114,7 +3115,7 @@ void gfc_enforce_clean_symbol_state (void); void gfc_free_dt_list (void); -gfc_gsymbol *gfc_get_gsymbol (const char *); +gfc_gsymbol *gfc_get_gsymbol (const char *, bool bind_c); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); gfc_gsymbol *gfc_find_case_gsymbol (gfc_gsymbol *, const char *); Index: decl.c =================================================================== --- decl.c (Revision 269624) +++ decl.c (Arbeitskopie) @@ -7248,7 +7248,7 @@ add_global_entry (const char *name, const char *bi name is a global identifier. */ if (!binding_label || gfc_notification_std (GFC_STD_F2008)) { - s = gfc_get_gsymbol (name); + s = gfc_get_gsymbol (name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { @@ -7270,7 +7270,7 @@ add_global_entry (const char *name, const char *bi && (!gfc_notification_std (GFC_STD_F2008) || strcmp (name, binding_label) != 0)) { - s = gfc_get_gsymbol (binding_label); + s = gfc_get_gsymbol (binding_label, true); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type)) { Index: parse.c =================================================================== --- parse.c (Revision 269624) +++ parse.c (Arbeitskopie) @@ -5839,7 +5839,7 @@ parse_block_data (void) } else { - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA)) gfc_global_used (s, &gfc_new_block->declared_at); @@ -5921,7 +5921,7 @@ parse_module (void) gfc_gsymbol *s; bool error; - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE)) gfc_global_used (s, &gfc_new_block->declared_at); else @@ -5985,7 +5985,7 @@ add_global_procedure (bool sub) name is a global identifier. */ if (!gfc_new_block->binding_label || gfc_notification_std (GFC_STD_F2008)) { - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN @@ -6010,7 +6010,7 @@ add_global_procedure (bool sub) && (!gfc_notification_std (GFC_STD_F2008) || strcmp (gfc_new_block->name, gfc_new_block->binding_label) != 0)) { - s = gfc_get_gsymbol (gfc_new_block->binding_label); + s = gfc_get_gsymbol (gfc_new_block->binding_label, true); if (s->defined || (s->type != GSYM_UNKNOWN @@ -6042,7 +6042,7 @@ add_global_program (void) if (gfc_new_block == NULL) return; - s = gfc_get_gsymbol (gfc_new_block->name); + s = gfc_get_gsymbol (gfc_new_block->name, false); if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM)) gfc_global_used (s, &gfc_new_block->declared_at); Index: resolve.c =================================================================== --- resolve.c (Revision 269624) +++ resolve.c (Arbeitskopie) @@ -1050,7 +1050,7 @@ resolve_common_blocks (gfc_symtree *common_root) } if (!gsym) { - gsym = gfc_get_gsymbol (common_root->n.common->name); + gsym = gfc_get_gsymbol (common_root->n.common->name, false); gsym->type = GSYM_COMMON; gsym->where = common_root->n.common->where; gsym->defined = 1; @@ -1072,7 +1072,7 @@ resolve_common_blocks (gfc_symtree *common_root) } if (!gsym) { - gsym = gfc_get_gsymbol (common_root->n.common->binding_label); + gsym = gfc_get_gsymbol (common_root->n.common->binding_label, true); gsym->type = GSYM_COMMON; gsym->where = common_root->n.common->where; gsym->defined = 1; @@ -2487,7 +2487,8 @@ resolve_global_procedure (gfc_symbol *sym, locus * type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; - gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name); + gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name, + sym->binding_label != NULL); if ((gsym->type != GSYM_UNKNOWN && gsym->type != type)) gfc_global_used (gsym, where); @@ -11847,7 +11848,7 @@ gfc_verify_binding_labels (gfc_symbol *sym) && (gsym->type == GSYM_FUNCTION || gsym->type == GSYM_SUBROUTINE))) { if (!gsym) - gsym = gfc_get_gsymbol (sym->binding_label); + gsym = gfc_get_gsymbol (sym->binding_label, true); gsym->where = sym->declared_at; gsym->sym_name = sym->name; gsym->binding_label = sym->binding_label; Index: symbol.c =================================================================== --- symbol.c (Revision 269624) +++ symbol.c (Arbeitskopie) @@ -4330,7 +4330,7 @@ gsym_compare (void *_s1, void *_s2) /* Get a global symbol, creating it if it doesn't exist. */ gfc_gsymbol * -gfc_get_gsymbol (const char *name) +gfc_get_gsymbol (const char *name, bool bind_c) { gfc_gsymbol *s; @@ -4341,6 +4341,7 @@ gfc_gsymbol * s = XCNEW (gfc_gsymbol); s->type = GSYM_UNKNOWN; s->name = gfc_get_string ("%s", name); + s->bind_c = bind_c; gfc_insert_bbt (&gfc_gsym_root, s, gsym_compare); Index: trans-decl.c =================================================================== --- trans-decl.c (Revision 269624) +++ trans-decl.c (Arbeitskopie) @@ -843,7 +843,7 @@ gfc_get_module_backend_decl (gfc_symbol *sym) { if (!gsym) { - gsym = gfc_get_gsymbol (sym->module); + gsym = gfc_get_gsymbol (sym->module, false); gsym->type = GSYM_MODULE; gsym->ns = gfc_get_namespace (NULL, 0); } @@ -2002,10 +2002,23 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gf return get_proc_pointer_decl (sym); /* See if this is an external procedure from the same file. If so, - return the backend_decl. */ - gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label - ? sym->binding_label : sym->name); + return the backend_decl. If we are looking at a BIND(C) + procedure and the symbol is not BIND(C), or vice versa, we + haven't found the right procedure. */ + if (sym->binding_label) + { + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->binding_label); + if (gsym && !gsym->bind_c) + gsym = NULL; + } + else + { + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name); + if (gsym && gsym->bind_c) + gsym = NULL; + } + if (gsym && !gsym->defined) gsym = NULL;