From patchwork Wed Mar 20 10:07:31 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 1059003 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-498167-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="vcvya6NT"; 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 44PQbS3J22z9sPd for ; Wed, 20 Mar 2019 21:07:59 +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:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; q=dns; s=default; b=JtaW6XHdgRbK9M0M cxqH7p81PrK23kmwyWIsRSyyLA0w8/rSJeYbdeb8IL7EI9OpZRWWCJTyJYeXmGUF X+IEii/ks5ADFgSdIvrdO/QeDNWoSdhJj/M8uc335qnACR0qaDHye/Ra4dtE7fv+ umftWk+DkotfZ/drHwRhzk9ygmg= 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:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; s=default; bh=Ad84aiiyM2kcL8O99H/t1v UCkc0=; b=vcvya6NTyWZPnGk+UZNyGddFoCsIW312IAe3ABitR6zBxtaEq4cu1p Q9t3gXJGaQ0HjgkImvNzUyFEc0MY/aztXVtF7jYUIUuBEY/KkfxSWAqKQGCIN9um PJg1acoOU6/7ga+EAAysJ3FT5cFEIHW7jOFveE7SwHC0XTCPtjDN8= Received: (qmail 3909 invoked by alias); 20 Mar 2019 10:07:47 -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 3891 invoked by uid 89); 20 Mar 2019 10:07:47 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-14.3 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_SHORT, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=aug, Aug, gang, goacc X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Wed, 20 Mar 2019 10:07:44 +0000 Received: from svr-orw-mbx-05.mgc.mentorg.com ([147.34.90.205]) by relay1.mentorg.com with esmtps (TLSv1.2:ECDHE-RSA-AES256-SHA384:256) id 1h6Y8L-0003Sg-Ik from Thomas_Schwinge@mentor.com ; Wed, 20 Mar 2019 03:07:41 -0700 Received: from svr-orw-mbx-04.mgc.mentorg.com (147.34.90.204) by SVR-ORW-MBX-05.mgc.mentorg.com (147.34.90.205) with Microsoft SMTP Server (TLS) id 15.0.1320.4; Wed, 20 Mar 2019 03:07:38 -0700 Received: from tftp-cs (147.34.91.1) by svr-orw-mbx-04.mgc.mentorg.com (147.34.90.204) with Microsoft SMTP Server id 15.0.1320.4 via Frontend Transport; Wed, 20 Mar 2019 03:07:38 -0700 Received: by tftp-cs (Postfix, from userid 49978) id 61C14C231E; Wed, 20 Mar 2019 03:07:38 -0700 (PDT) From: Thomas Schwinge To: , CC: Jakub Jelinek Subject: [PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute In-Reply-To: <9e1f3bc5-2da8-1aae-67b0-bf478a53dd2a@codesourcery.com> References: <9e1f3bc5-2da8-1aae-67b0-bf478a53dd2a@codesourcery.com> User-Agent: Notmuch/0.9-125-g4686d11 (http://notmuchmail.org) Emacs/25.2.2 (x86_64-pc-linux-gnu) Date: Wed, 20 Mar 2019 11:07:31 +0100 Message-ID: <87imwdsvto.fsf@euler.schwinge.homeip.net> MIME-Version: 1.0 Hi! On Fri, 26 Aug 2016 08:16:43 -0700, Cesar Philippidis wrote: > While working on [...], I noticed If only all such issues would end up in their own PRs, instead of mixing them with other changes... > that the fortran FE wasn't permitting > named functions inside acc routine directives. E.g. > > integer :: foo > !$acc routine(foo) gang > > ... = foo () ACK. Perhaps not the most pretty style, but gfortran does accept this. Do I understand right that there exists no equivalent syntax in Fortran to declare a subroutine (instead of a function) with implicit EXTERNAL attribute? (See also the new 'gfortran.dg/goacc/pr89773.f90' test case I'm adding.) > This patch also fixes this issue. But to do that, I had to add a > gfc_resolve_oacc_routines pass in order to identify if a variable is a > function or variable because that information isn't available during > matching. OK to fix this as in the attached patch? If approving this patch, please respond with "Reviewed-by: NAME " so that your effort will be recorded in the commit log, see . Grüße Thomas From 38d953f51280e6fc327af6b8e35e10ef5d70d589 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Wed, 20 Mar 2019 10:58:58 +0100 Subject: [PATCH] [PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute gcc/fortran/ PR fortran/89773 * gfortran.h (gfc_oacc_routine_name): Add loc member. (gfc_resolve_oacc_routines): Declare. * openmp.c (gfc_match_oacc_routine): Move some error checking into... (gfc_resolve_oacc_routines): ... this new function. * resolve.c (resolve_codes): Call it. gcc/testsuite/ PR fortran/89773 * gfortran.dg/goacc/pr89773.f90: New file. * gfortran.dg/goacc/pr77765.f90: Adjust. * gfortran.dg/goacc/routine-6.f90: Adjust, and extend. --- gcc/fortran/gfortran.h | 2 ++ gcc/fortran/openmp.c | 30 +++++++++++----- gcc/fortran/resolve.c | 1 + gcc/testsuite/gfortran.dg/goacc/pr77765.f90 | 2 +- gcc/testsuite/gfortran.dg/goacc/pr89773.f90 | 36 +++++++++++++++++++ gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 21 +++++++++-- 6 files changed, 80 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr89773.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2f55b9c387a6..caf5e528c7e0 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1739,6 +1739,7 @@ typedef struct gfc_oacc_routine_name struct gfc_symbol *sym; struct gfc_omp_clauses *clauses; struct gfc_oacc_routine_name *next; + locus loc; } gfc_oacc_routine_name; @@ -3210,6 +3211,7 @@ void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_declare (gfc_namespace *); void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *); +void gfc_resolve_oacc_routines (gfc_namespace *); /* expr.c */ void gfc_free_actual_arglist (gfc_actual_arglist *); diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 7a06eb58f5cf..69b05084dc06 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2319,15 +2319,10 @@ gfc_match_oacc_routine (void) sym = NULL; } - if ((isym == NULL && st == NULL) - || (sym - && !sym->attr.external - && !sym->attr.function - && !sym->attr.subroutine)) + if (isym == NULL && st == NULL) { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " - "invalid function name %s", - (sym) ? sym->name : buffer); + gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C", + buffer); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -2397,6 +2392,7 @@ gfc_match_oacc_routine (void) n->sym = sym; n->clauses = c; n->next = gfc_current_ns->oacc_routine_names; + n->loc = old_loc; gfc_current_ns->oacc_routine_names = n; } } @@ -6069,6 +6065,24 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) } } + +void +gfc_resolve_oacc_routines (gfc_namespace *ns) +{ + for (gfc_oacc_routine_name *orn = ns->oacc_routine_names; + orn; + orn = orn->next) + { + gfc_symbol *sym = orn->sym; + if (!sym->attr.external + && !sym->attr.function + && !sym->attr.subroutine) + gfc_error ("NAME %qs does not refer to a subroutine or function" + " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc); + } +} + + void gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7539aa7038c4..e1cd2007e59a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -16818,6 +16818,7 @@ resolve_codes (gfc_namespace *ns) bitmap_obstack_initialize (&labels_obstack); gfc_resolve_oacc_declare (ns); + gfc_resolve_oacc_routines (ns); gfc_resolve_omp_local_vars (ns); gfc_resolve_code (ns->code, ns); diff --git a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 index afa0a56a6324..e0ea391b9a6d 100644 --- a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 @@ -14,5 +14,5 @@ end module m ! { dg-error "Procedure 'f' at .1. is already defined" "" { target *-*-* } 8 } ! { dg-error ".1." "" { target *-*-* } 10 } -! { dg-error "Syntax error in ..ACC ROUTINE . NAME . at .1., invalid function name f" "" { target *-*-* } 11 } +! { dg-error "Invalid NAME 'f' in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } 11 } ! { dg-error "Expecting END MODULE statement" "" { target *-*-* } 12 } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 new file mode 100644 index 000000000000..f709c033edd9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 @@ -0,0 +1,36 @@ +! Valid usage of external procedures with OpenACC 'routine' directives. + +! { dg-additional-options "-fdump-tree-optimized-raw" } + + subroutine test (x) + implicit none + integer, intent(inout) :: x + !$acc routine (test) + + integer, external :: f_1 + !$acc routine (f_1) + + integer f_2 ! No explicit EXTERNAL attribute. + !$acc routine (f_2) + + external s_1 + !$acc routine (s_1) + + ! 's_2' will be an external subroutine without explicit EXTERNAL + ! attribute, but we don't have a handle for it yet... + !!$acc routine (s_2) ..., so can't specify this, here. + + if (x < 1) then + x = 1 + else + x = x * x - 1 + f_1(f_2(x)) + call s_1(x) + call s_2(x) + end if + end subroutine test + +! { dg-final { scan-tree-dump-times "gimple_call" 4 "optimized" } } +! { dg-final { scan-tree-dump-times "gimple_call