From patchwork Fri Jul 5 11:31:17 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Stubbs X-Patchwork-Id: 1127984 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-504461-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="TAh9M/2W"; 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 45gCNh0wyVz9s7T for ; Fri, 5 Jul 2019 21:31:45 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :subject:to:message-id:date:mime-version:content-type; q=dns; s= default; b=sIAiyQK8BxTS/F06TUXPPk8t6tjl+CVFJhqiWlChE42Hf2rsofE6l P0OmnMSKWRMSEvV8iCntRkV/n6vKPfiQu80Elmd7vkYQsC0jxkDaB1PzGus82t86 j0c4gyVu3ST162eMP9jjztgAs1JcNztRG9BFUt1f0OJuq1LQemDorA= 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 :subject:to:message-id:date:mime-version:content-type; s= default; bh=8SArlAu0ghMBo/HNrz0wn736LUk=; b=TAh9M/2W3LFNhRgjbAfw QRC9zh3RUTWUPKoBJwPzDyt3CUkeBIF0QWyG7qQcnkIhG5cvgDYCmUiS563jpL/O RAy9VlNLDrp3XzAVCnZBLODMzAdxwH6cXDssElYHSnZls2AA/DOqHlTNhIIb4oV/ c40iVBuRKR4DUTM3vza1U0U= Received: (qmail 58131 invoked by alias); 5 Jul 2019 11:31: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 58095 invoked by uid 89); 5 Jul 2019 11:31:27 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-17.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=HTo:U*fortran, Break 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; Fri, 05 Jul 2019 11:31:26 +0000 Received: from nat-ies.mentorg.com ([192.94.31.2] helo=svr-ies-mbx-01.mgc.mentorg.com) by relay1.mentorg.com with esmtps (TLSv1.2:ECDHE-RSA-AES256-SHA384:256) id 1hjMQz-0005rV-N3 from Andrew_Stubbs@mentor.com ; Fri, 05 Jul 2019 04:31:21 -0700 Received: from [127.0.0.1] (137.202.0.90) by svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) with Microsoft SMTP Server (TLS) id 15.0.1320.4; Fri, 5 Jul 2019 12:31:17 +0100 From: Andrew Stubbs Subject: [patch, openmp/openacc] Allow Fortran parameters in map/copy. To: "gcc-patches@gcc.gnu.org" , Fortran List Message-ID: <7f793719-ef9e-de39-bace-a3f07fcbe714@codesourcery.com> Date: Fri, 5 Jul 2019 12:31:17 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:60.0) Gecko/20100101 Thunderbird/60.7.2 MIME-Version: 1.0 This patch allows Fortran "parameter" named constants to be named in OpenMP map and OpenACC copy directives. Right now, the compiler just says something like: !$omp target data map(tofrom:N,x) 1 Error: Object 'n' is not a variable at (1) This is technically correct, but is surprising to the user and AFAICT the OpenMP/OpenACC documents don't say you can't name parameters, so I'd like it to be allowed. Also, I suspect the support request that led me here originated from code originally written for another toolchain, so this is a portability issue. With this patch the compiler allows the parameter in the directive, but just ignores it (deletes it), so that it has no effect. This is safe since the named constant will have been substituted for the actual value everywhere it occurs. If that is not true in some case (can it happen?), I believe it will be automatically mapped in the same way other variables are. Using parameters in device_resident, deviceptr, private, reduction, etc., remains an error. OK to commit? Andrew Allow Fortran parameters in map/copy directives. 2019-07-05 Andrew Stubbs gcc/fortran/ * gfortran.h (gfc_free_omp_namelist_entry): New prototype. * match.c (gfc_free_omp_namelist): Break contents out into ... (gfc_free_omp_namelist_entry): ... here. * openmp.c (resolve_omp_clauses): Delete parameters in map to and from. gcc/testsuite/ * gfortran.dg/goacc/parameter.f95: Allow parameters in copy. * gfortran.dg/gomp/map-1.f90: Allow parameters in map, only. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b1f7bd0604a..5363cbd331b 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3181,6 +3181,7 @@ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); void gfc_free_namelist (gfc_namelist *); +void gfc_free_omp_namelist_entry (gfc_omp_namelist *); void gfc_free_omp_namelist (gfc_omp_namelist *); void gfc_free_equiv (gfc_equiv *); void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *); diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 0f3b2132122..51c9e9ef5ed 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -5373,6 +5373,23 @@ gfc_free_namelist (gfc_namelist *name) } +/* Free an OpenMP namelist entry. */ + +void +gfc_free_omp_namelist_entry (gfc_omp_namelist *name) +{ + gfc_free_expr (name->expr); + if (name->udr) + { + if (name->udr->combiner) + gfc_free_statement (name->udr->combiner); + if (name->udr->initializer) + gfc_free_statement (name->udr->initializer); + free (name->udr); + } + free (name); +} + /* Free an OpenMP namelist structure. */ void @@ -5382,17 +5399,8 @@ gfc_free_omp_namelist (gfc_omp_namelist *name) for (; name; name = n) { - gfc_free_expr (name->expr); - if (name->udr) - { - if (name->udr->combiner) - gfc_free_statement (name->udr->combiner); - if (name->udr->initializer) - gfc_free_statement (name->udr->initializer); - free (name->udr); - } n = name->next; - free (name); + gfc_free_omp_namelist_entry (name); } } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1c7bce6c300..d06221b41ed 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -4165,6 +4165,22 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "clause at %L", &code->loc); } + /* Remove no-op mappings, such as parameters. */ + gfc_omp_namelist **parent = &omp_clauses->lists[OMP_LIST_MAP]; + for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + if ((n->u.map_op == OMP_MAP_TO + || n->u.map_op == OMP_MAP_FROM + || n->u.map_op == OMP_MAP_TOFROM) + && n->sym->attr.flavor == FL_PARAMETER) + { + *parent = n->next; + gfc_free_omp_namelist_entry (n); + } + else + parent = &n->next; + } + /* Check that no symbol appears on multiple clauses, except that a symbol can appear on both firstprivate and lastprivate. */ for (list = 0; list < OMP_LIST_NUM; list++) diff --git a/gcc/testsuite/gfortran.dg/goacc/parameter.f95 b/gcc/testsuite/gfortran.dg/goacc/parameter.f95 index 84274611915..edfaeeadc76 100644 --- a/gcc/testsuite/gfortran.dg/goacc/parameter.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/parameter.f95 @@ -7,7 +7,7 @@ contains integer :: i integer, parameter :: a = 1 !$acc declare device_resident (a) ! { dg-error "PARAMETER" } - !$acc data copy (a) ! { dg-error "not a variable" } + !$acc data copy (a) ! This is permitted. !$acc end data !$acc data deviceptr (a) ! { dg-error "not a variable" } !$acc end data diff --git a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-1.f90 index e78b56c8f39..abe448a33f9 100644 --- a/gcc/testsuite/gfortran.dg/gomp/map-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/map-1.f90 @@ -18,7 +18,7 @@ subroutine test(aas) !$omp target map(j) !$omp end target - !$omp target map(p) ! { dg-error "Object 'p' is not a variable" } + !$omp target map(p) !$omp end target !$omp target map(j(1))