From patchwork Thu Nov 2 01:09:57 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Steve Kargl X-Patchwork-Id: 833170 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-465710-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="H/JmHr6m"; 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 3yS6Sz15Z5z9s4s for ; Thu, 2 Nov 2017 12:10:08 +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:date :from:to:subject:message-id:reply-to:mime-version:content-type; q=dns; s=default; b=c2Hgmsa/p0guVdWGxN1Hd0aqR87zgkVKSKJKQ221QcV 78ohZWlOhTc4Vcb0Clhv975UVPMHa5g6E6JK/NbtAefMZUjC6hwQ8NTT85Lr4ba7 HW7J01US2gI4XOecI7v6JzZy/KHPMG8ADVlbKVpzCCxlHN9KTnHK03Ei9Vo/jtSY = 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:date :from:to:subject:message-id:reply-to:mime-version:content-type; s=default; bh=BNvgwk3DcZTqNFgXYW09mH8zrcg=; b=H/JmHr6ms5RqPeALz /tVvdaoyJhHw+al5ESdIWNxJ0BJEEtwgbKTU7yUX/p0r0Hc4CAlI2sTcHX9CCNZp PdGvUt32BB/iKNCQY+3GlmCydalu11nTGKKq5B2bCbddYbbMuS4YzR/YJnck9GRX BIqn6ihVI4Vah3WUryem6x+oIc= Received: (qmail 21025 invoked by alias); 2 Nov 2017 01:10:01 -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 20991 invoked by uid 89); 2 Nov 2017 01:10:00 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-9.3 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=sk:karglg, U*kargl, karglgccgnuorg, H*R:D*edu X-Spam-User: qpsmtpd, 2 recipients X-HELO: troutmask.apl.washington.edu Received: from troutmask.apl.washington.edu (HELO troutmask.apl.washington.edu) (128.95.76.21) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 02 Nov 2017 01:09:59 +0000 Received: from troutmask.apl.washington.edu (localhost [127.0.0.1]) by troutmask.apl.washington.edu (8.15.2/8.15.2) with ESMTPS id vA219v6v031667 (version=TLSv1.2 cipher=DHE-RSA-AES256-GCM-SHA384 bits=256 verify=NO); Wed, 1 Nov 2017 18:09:57 -0700 (PDT) (envelope-from sgk@troutmask.apl.washington.edu) Received: (from sgk@localhost) by troutmask.apl.washington.edu (8.15.2/8.15.2/Submit) id vA219vi0031666; Wed, 1 Nov 2017 18:09:57 -0700 (PDT) (envelope-from sgk) Date: Wed, 1 Nov 2017 18:09:57 -0700 From: Steve Kargl To: fortran@gcc.gnu.org, gcc-patches@gcc.gnu.org Subject: [PATCH] PR fortran/82796 -- common entity in equivalence in pure routine Message-ID: <20171102010957.GA31553@troutmask.apl.washington.edu> Reply-To: sgk@troutmask.apl.washington.edu MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.7.2 (2016-11-26) The attached patch fixes a regression where gfortran was issuing an error for an entity in a common block within a module when it appears in equivalence, and the entity *is not* use associated in a pure subprogram. OK to commit? 2017-11-01 Steven G. Kargl PR fortran/82796 * resolve.c (resolve_equivalence): An entity in a common block within a module cannot appear in an equivalence statement if the entity is with a pure procedure. 2017-11-01 Steven G. Kargl PR fortran/82796 * gfortran.dg/equiv_pure.f90: New test. Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 254241) +++ gcc/fortran/resolve.c (working copy) @@ -15936,9 +15936,22 @@ resolve_equivalence (gfc_equiv *eq) && sym->ns->proc_name->attr.pure && sym->attr.in_common) { - gfc_error ("Common block member %qs at %L cannot be an EQUIVALENCE " - "object in the pure procedure %qs", - sym->name, &e->where, sym->ns->proc_name->name); + /* Need to check for symbols that may have entered the pure + procedure via a USE statement. */ + bool saw_sym = false; + if (sym->ns->use_stmts) + { + gfc_use_rename *r; + for (r = sym->ns->use_stmts->rename; r; r = r->next) + if (strcmp(r->use_name, sym->name) == 0) saw_sym = true; + } + else + saw_sym = true; + + if (saw_sym) + gfc_error ("COMMON block member %qs at %L cannot be an " + "EQUIVALENCE object in the pure procedure %qs", + sym->name, &e->where, sym->ns->proc_name->name); break; } Index: gcc/testsuite/gfortran.dg/equiv_pure.f90 =================================================================== --- gcc/testsuite/gfortran.dg/equiv_pure.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/equiv_pure.f90 (working copy) @@ -0,0 +1,50 @@ +! { dg-do compile } +module eq + implicit none + integer :: n1, n2 + integer, dimension(2) :: a + equivalence (a(1), n1) + equivalence (a(2), n2) + common /a/ a +end module eq + +module m + use eq + implicit none + type, public :: t + integer :: i + end type t +end module m + +module p + implicit none + contains + pure integer function d(h) + use m + implicit none + integer, intent(in) :: h + d = h + end function +end module p + +module q + implicit none + contains + pure integer function d(h) + use m, only : t + implicit none + integer, intent(in) :: h + d = h + end function +end module q + +module r + implicit none + contains + pure integer function d(h) + use m, only : a ! { dg-error "cannot be an EQUIVALENCE object" } + implicit none + integer, intent(in) :: h + d = h + end function +end module r