From patchwork Sat Mar 30 12:40:19 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 1070798 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-498653-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="Ks6JerhX"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="LiV40gK7"; 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 44WdW95Sykz9sRW for ; Sat, 30 Mar 2019 23:40:49 +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 :mime-version:from:date:message-id:subject:to:cc:content-type; q=dns; s=default; b=D8ameYMFKcPmDNtk1DuQUjSN3x1QteMk3oKWhyTWg/e yU59OBZK+CMvMk/NI/zWx/L4LRcztnU+1gubXMzUl82PKKHigeonrYMQJTygA1Xw rRXvJhliEWsoNnF9HcJv1vxJzRJs3KddYXDztbtlHectBIz0AM3FW3Zm/qmweBWI = 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 :mime-version:from:date:message-id:subject:to:cc:content-type; s=default; bh=Azclsz2TpeZLKmJo2B7B5ZVfx6c=; b=Ks6JerhXUVUBWpCUB MXY4othYK2oi2JJ5SB6KGwX7hKNhc8g0rYX9RoGymTqdNhPVUN9lCsYXSG/B+kc/ yTGL6iP2RWWFRuRIP+TWX9dNWw03bVCaApG65VaOLIJNTqFl/u2bDTig2TR3p3fJ 8GHXq3QEQ0eDdJ5Sa/O5IdFrfk= Received: (qmail 6426 invoked by alias); 30 Mar 2019 12:40:35 -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 6406 invoked by uid 89); 30 Mar 2019 12:40:34 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-3.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, URIBL_BLOCKED autolearn=ham version=3.3.1 spammy=FC29, fc29, ****, D*t-online.de X-HELO: mail-lf1-f42.google.com Received: from mail-lf1-f42.google.com (HELO mail-lf1-f42.google.com) (209.85.167.42) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 30 Mar 2019 12:40:32 +0000 Received: by mail-lf1-f42.google.com with SMTP id 10so3228824lfr.8; Sat, 30 Mar 2019 05:40:32 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:from:date:message-id:subject:to:cc; bh=OCrflEw5WcmRGIjSTwBpv+aZ3oC0u/0KV1dy26iKJKs=; b=LiV40gK7Xb/t9TyP0ffNQcOaLE4xJARY3VqB6rJNDZ048CF1l1pmroJ9DbwJWYGJNt 73xPnHvghoHdbW+hWHhE9HRvJEWuU2bAD2GoLMPVQRVza0WpE38XrtENy/8grYjZ04vn vyrFCpmfI8VNm8KRGoQfVRQ0I8suIIqyaDd1lA/Bo6n4i4YHwmI6AMTmhJppkN50hQ23 paTei1gDeLS/wmR82Jb1xcN/mcwvRHtVV1hdAQCJheYJ0Zqz7m3OGnLzVCN8oMyrBaZj dGNbQtYDq6UC0l+HieyBiDUW8etysLxHqJgHk2PHNlWdrwMFKOjZM4CNKJpUOYNwR7qR 9XkQ== MIME-Version: 1.0 From: Paul Richard Thomas Date: Sat, 30 Mar 2019 12:40:19 +0000 Message-ID: Subject: [Patch, fortran] PR87127 - External function not recognised from within an associate block To: "fortran@gcc.gnu.org" , gcc-patches Cc: gscfq@t-online.de This patch is pretty self-explanatory. I have checked that a sensible errors are given if 'exfunc' in the testcase is referenced if it is a variable. Bootstrapped and regtested on FC29/x86_64 - OK for trunk? Paul 2019-03-30 Paul Thomas PR fortran/87127 * resolve.c (check_host_association): If an external function is typed but not declared explicitly to be external, change the old symbol from a variable to an external function. 2019-03-30 Paul Thomas PR fortran/87127 * gfortran.dg/external_procedures_4.f90: New test. Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 269160) --- gcc/fortran/resolve.c (working copy) *************** resolve_procedure: *** 5615,5625 **** /* Checks to see that the correct symbol has been host associated. ! The only situation where this arises is that in which a twice ! contained function is parsed after the host association is made. ! Therefore, on detecting this, change the symbol in the expression ! and convert the array reference into an actual arglist if the old ! symbol is a variable. */ static bool check_host_association (gfc_expr *e) { --- 5615,5628 ---- /* Checks to see that the correct symbol has been host associated. ! The only situations where this arises are: ! (i) That in which a twice contained function is parsed after ! the host association is made. On detecting this, change ! the symbol in the expression and convert the array reference ! into an actual arglist if the old symbol is a variable; or ! (ii) That in which an external function is typed but not declared ! explicitly to be external. Here, the old symbol is changed ! from a variable to an external function. */ static bool check_host_association (gfc_expr *e) { *************** check_host_association (gfc_expr *e) *** 5709,5714 **** --- 5712,5737 ---- gfc_resolve_expr (e); sym->refs++; } + /* This case corresponds to a call, from a block or a contained + procedure, to an external function, which has not been declared + as being external in the main program but has been typed. */ + else if (sym && old_sym != sym + && !e->ref + && sym->ts.type == BT_UNKNOWN + && old_sym->ts.type != BT_UNKNOWN + && sym->attr.flavor == FL_PROCEDURE + && old_sym->attr.flavor == FL_VARIABLE + && sym->ns->parent == old_sym->ns + && sym->ns->proc_name + && (sym->ns->proc_name->attr.flavor == FL_LABEL + || sym->ns->proc_name->attr.flavor == FL_PROCEDURE)) + { + old_sym->attr.flavor = FL_PROCEDURE; + old_sym->attr.external = 1; + old_sym->attr.function = 1; + old_sym->result = old_sym; + gfc_resolve_expr (e); + } } /* This might have changed! */ return e->expr_type == EXPR_FUNCTION; Index: gcc/testsuite/gfortran.dg/external_procedures_4.f90 =================================================================== *** gcc/testsuite/gfortran.dg/external_procedures_4.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/external_procedures_4.f90 (working copy) *************** *** 0 **** --- 1,28 ---- + ! { dg-do run } + ! + ! Test the fix for PR87127 in which the references to exfunc cause + ! the error "‘exfunc’ at (1) is not a function". + ! + ! Contributed by Gerhard Steinmetz + ! + function exfunc(i) + implicit none + integer :: exfunc,i + exfunc = 2*i + end function + + ! contents of test.f90 + program test + implicit none + integer :: exfunc,i + integer,parameter :: array(2)=[6,7] + associate(i=>array(2)) ! Original bug + if (exfunc(i) .ne. 2*i) stop 1 + end associate + i = 99 + call foo + contains + subroutine foo() ! Comment #3 + if (exfunc(i) .ne. 2*i) stop 2 + end subroutine foo + end program