From patchwork Thu Mar 21 20:18:55 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 1060443 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-498265-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="o9SXS4eT"; 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 44QJ6S2yFCz9sNs for ; Fri, 22 Mar 2019 07:19:26 +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:subject:in-reply-to:references:date:message-id:mime-version :content-type; q=dns; s=default; b=BBHCtwmxmI462eqDJzkgagy4tnwyA 9hg5dzF1KBXHO6xRIim61OGDRK3KYLZD4TKFQ/1oFvxHjk6RsLtE7N82jxRZ+vjC ukC5uHHkMYn9t19ghOyqxhGAigi2b87WTDzpeXTptJAgT4rnrL9c0YkLG6toSkk/ YF06BjidMk+py0= 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:subject:in-reply-to:references:date:message-id:mime-version :content-type; s=default; bh=dHDUadkKef1iiNHnja6VnDF4Y5k=; b=o9S XS4eTNhOEwrne2Zu1PXXOlhaAE7waLaHptXznjez1h/0DMGqr4ynzEt/MElmcIC+ xrxo/m2oIyzB4W9mGoW7g9iX277aLfgHMlg7EOzzUlojUl4HDSQqZXZLwDBb/7gq BeBGqFq02UBrNA9s0N89h3jhsFBwPgISD9m0+WDo= Received: (qmail 5625 invoked by alias); 21 Mar 2019 20:19:16 -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 5606 invoked by uid 89); 21 Mar 2019 20:19:15 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-14.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=measure, 1124, differing 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; Thu, 21 Mar 2019 20:19:09 +0000 Received: from svr-orw-mbx-06.mgc.mentorg.com ([147.34.90.206]) by relay1.mentorg.com with esmtps (TLSv1.2:ECDHE-RSA-AES256-SHA384:256) id 1h749b-0007fG-AL from Thomas_Schwinge@mentor.com ; Thu, 21 Mar 2019 13:19:07 -0700 Received: from svr-orw-mbx-08.mgc.mentorg.com (147.34.90.208) by SVR-ORW-MBX-06.mgc.mentorg.com (147.34.90.206) with Microsoft SMTP Server (TLS) id 15.0.1320.4; Thu, 21 Mar 2019 13:19:04 -0700 Received: from tftp-cs (147.34.91.1) by svr-orw-mbx-08.mgc.mentorg.com (147.34.90.208) with Microsoft SMTP Server id 15.0.1320.4 via Frontend Transport; Thu, 21 Mar 2019 13:19:04 -0700 Received: by tftp-cs (Postfix, from userid 49978) id 1D7E8C232B; Thu, 21 Mar 2019 13:19:04 -0700 (PDT) From: Thomas Schwinge To: , Subject: [PR72741] Properly handle clauses specifying the level of parallelism for 'external' Fortran OpenACC routines (was: [gomp4] check for sufficient parallelism when calling acc routines in fortran) 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: Thu, 21 Mar 2019 21:18:55 +0100 Message-ID: <87tvfwq8uo.fsf@euler.schwinge.homeip.net> MIME-Version: 1.0 Hi! On Fri, 26 Aug 2016 08:16:43 -0700, Cesar Philippidis wrote: > This patch (..., variants of which got re-submitted a few times, later on...) > teaches the fortran FE how to verify that there is sufficient > parallelism when calling acc routines inside acc loop. E.g. the fortran > FE will now error if you call a gang routine from a vector loop, because > there's no way for vector partitioned code to spawn new gangs with the > OpenACC current execution model. These proposed Fortran front end changes seemed strange to me: the generic middle end OMP code is already doing such checking, and works for other Fortran test cases. This should also work for the 'external' case discussed here; see also the 'c-c++-common/goacc/routine-3-extern.c', 'c-c++-common/goacc/routine-4-extern.c' test cases I'm adding. Now that I looked into these proposed changes in more detail, I found that indeed the error is a different one than what/how it's getting addressed there, and the solution is much simpler one. > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/goacc/routine-nested-parallelism.f > @@ -0,0 +1,340 @@ > +! Validate calls to ACC ROUTINES. Ensure that the loop containing the > +! call has sufficient parallelism to for the routine. > + > + subroutine sub > + implicit none > + integer, parameter :: n = 100 > + integer :: a(n), i, j > + external gangr, workerr, vectorr, seqr > +!$acc routine (gangr) gang > +!$acc routine (workerr) worker > +!$acc routine (vectorr) vector > +!$acc routine (seqr) seq > + > +! > +! Test subroutine calls inside nested loops. > +! > + > +!$acc parallel loop > + do i = 1, n > + !$acc loop > + do j = 1, n That "!$acc loop" directive is not considered; needs to be in the first column. > + call workerr (a, n) > + end do > + end do > +!$acc end parallel loop > + > +!$acc parallel loop > + do i = 1, n > +!$acc loop gang > + do j = 1, n If this loop is using OpenACC 'gang' parallelism, then no parallelism is available for the outer loop; the generic middle end OMP code diagnoses: "warning: insufficient partitioning available to parallelize loop". Similar in other such places. > + call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" } The generic middle end OMP code diagnoses: "error: routine call uses same OpenACC parallelism as containing loop". Similar in other such places. > +[...] > +!$acc parallel loop seq > + do i = 1, n > + call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" } > + end do > +!$acc end parallel loop That's not correct. The outer loop is tagged 'seq', so not parallelized, and thus 'gang' parallelism is still available for the 'gangr' routine call. Similar in other such places. > +[...] > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/goacc/routine-nested-parallelism.f90 That's the same as 'gfortran.dg/goacc/routine-nested-parallelism.f', just differing in whitespace; file removed. For good measure I also created a corresponding test case to "Check valid calls to 'external' OpenACC routines", and also added '-fopt-info-optimized-omp' scanning to both these new Fortran test cases. Committed to trunk r269858 "[PR72741] Properly handle clauses specifying the level of parallelism for 'external' Fortran OpenACC routines", see attached. Grüße Thomas From 33718c02f44cf560c5725ed1681ae5981acbfc69 Mon Sep 17 00:00:00 2001 From: tschwinge Date: Thu, 21 Mar 2019 20:13:44 +0000 Subject: [PATCH] [PR72741] Properly handle clauses specifying the level of parallelism for 'external' Fortran OpenACC routines ..., so as to also for these enable the generic middle end OMP code to verify proper nesting of loops/routines regarding their levels of parallelism. gcc/fortran/ PR fortran/72741 * openmp.c (gfc_match_oacc_routine): Set the level of parallelism for all variants. (gfc_resolve_oacc_routines): Call gfc_add_omp_declare_target. gcc/testsuite/ PR fortran/72741 * c-c++-common/goacc/routine-3-extern.c: New file. * c-c++-common/goacc/routine-3.c: Adjust. * c-c++-common/goacc/routine-4-extern.c: New file. * c-c++-common/goacc/routine-4.c: Adjust. * gfortran.dg/goacc/routine-module-3.f90: New file. * gfortran.dg/goacc/routine-external-level-of-parallelism-1.f: New file. * gfortran.dg/goacc/routine-external-level-of-parallelism-2.f: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269858 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 + gcc/fortran/openmp.c | 8 + gcc/testsuite/ChangeLog | 16 + .../c-c++-common/goacc/routine-3-extern.c | 89 +++++ gcc/testsuite/c-c++-common/goacc/routine-3.c | 1 + .../c-c++-common/goacc/routine-4-extern.c | 124 ++++++ gcc/testsuite/c-c++-common/goacc/routine-4.c | 1 + .../routine-external-level-of-parallelism-1.f | 347 +++++++++++++++++ .../routine-external-level-of-parallelism-2.f | 361 ++++++++++++++++++ .../gfortran.dg/goacc/routine-module-3.f90 | 16 + 10 files changed, 968 insertions(+) create mode 100644 gcc/testsuite/c-c++-common/goacc/routine-3-extern.c create mode 100644 gcc/testsuite/c-c++-common/goacc/routine-4-extern.c create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-1.f create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-2.f create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-module-3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7ce67eb46fe7..dd4347ef3d1b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,10 @@ 2019-03-21 Thomas Schwinge + PR fortran/72741 + * openmp.c (gfc_match_oacc_routine): Set the level of parallelism + for all variants. + (gfc_resolve_oacc_routines): Call gfc_add_omp_declare_target. + PR fortran/89773 * gfortran.h (gfc_oacc_routine_name): Add loc member. (gfc_resolve_oacc_routines): Declare. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 983b83db4a7b..9fc236760a1c 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2391,6 +2391,8 @@ gfc_match_oacc_routine (void) if (add) { + sym->attr.oacc_routine_lop = lop; + n = gfc_get_oacc_routine_name (); n->sym = sym; n->clauses = c; @@ -6085,6 +6087,12 @@ gfc_resolve_oacc_routines (gfc_namespace *ns) " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc); continue; } + if (!gfc_add_omp_declare_target (&sym->attr, sym->name, &orn->loc)) + { + gfc_error ("NAME %qs invalid" + " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc); + continue; + } } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e771a8743194..f575c0f59a9f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,4 +1,20 @@ 2019-03-21 Thomas Schwinge + Cesar Philippidis + + PR fortran/72741 + * gfortran.dg/goacc/routine-external-level-of-parallelism-1.f: New + file. + * gfortran.dg/goacc/routine-external-level-of-parallelism-2.f: + Likewise. + +2019-03-21 Thomas Schwinge + + PR fortran/72741 + * c-c++-common/goacc/routine-3-extern.c: New file. + * c-c++-common/goacc/routine-3.c: Adjust. + * c-c++-common/goacc/routine-4-extern.c: New file. + * c-c++-common/goacc/routine-4.c: Adjust. + * gfortran.dg/goacc/routine-module-3.f90: New file. PR fortran/89773 * gfortran.dg/goacc/pr89773.f90: New file. diff --git a/gcc/testsuite/c-c++-common/goacc/routine-3-extern.c b/gcc/testsuite/c-c++-common/goacc/routine-3-extern.c new file mode 100644 index 000000000000..e32cfdefd2a2 --- /dev/null +++ b/gcc/testsuite/c-c++-common/goacc/routine-3-extern.c @@ -0,0 +1,89 @@ +/* Test invalid calls to routines. */ +/* Variant of 'routine-3.c', moving the callees 'extern'. */ + +#pragma acc routine gang +extern int extern_gang (); /* { dg-message "declared here" "3" } */ + +#pragma acc routine worker +extern int extern_worker (); /* { dg-message "declared here" "2" } */ + +#pragma acc routine vector +extern int extern_vector (); /* { dg-message "declared here" } */ + +#pragma acc routine seq +extern int extern_seq (); + +int +main () +{ + int red = 0; +#pragma acc parallel copy (red) + { + /* Independent/seq loop tests. */ +#pragma acc loop reduction (+:red) // { dg-warning "insufficient partitioning" } + for (int i = 0; i < 10; i++) + red += extern_gang (); + +#pragma acc loop reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_worker (); + +#pragma acc loop reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_vector (); + + /* Gang routine tests. */ +#pragma acc loop gang reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_gang (); // { dg-error "routine call uses same" } + +#pragma acc loop worker reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_gang (); // { dg-error "routine call uses same" } + +#pragma acc loop vector reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_gang (); // { dg-error "routine call uses same" } + + /* Worker routine tests. */ +#pragma acc loop gang reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_worker (); + +#pragma acc loop worker reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_worker (); // { dg-error "routine call uses same" } + +#pragma acc loop vector reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_worker (); // { dg-error "routine call uses same" } + + /* Vector routine tests. */ +#pragma acc loop gang reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_vector (); + +#pragma acc loop worker reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_vector (); + +#pragma acc loop vector reduction (+:red) /* { dg-message "containing loop" } */ + for (int i = 0; i < 10; i++) + red += extern_vector (); // { dg-error "routine call uses same" } + + /* Seq routine tests. */ +#pragma acc loop gang reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_seq (); + +#pragma acc loop worker reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_seq (); + +#pragma acc loop vector reduction (+:red) + for (int i = 0; i < 10; i++) + red += extern_seq (); + } + + return 0; +} diff --git a/gcc/testsuite/c-c++-common/goacc/routine-3.c b/gcc/testsuite/c-c++-common/goacc/routine-3.c index eaea470fac09..364c8ad9ff5c 100644 --- a/gcc/testsuite/c-c++-common/goacc/routine-3.c +++ b/gcc/testsuite/c-c++-common/goacc/routine-3.c @@ -1,4 +1,5 @@ /* Test invalid calls to routines. */ +/* See also variant 'routine-3-extern.c', moving the callees 'extern'. */ #pragma acc routine gang int diff --git a/gcc/testsuite/c-c++-common/goacc/routine-4-extern.c b/gcc/testsuite/c-c++-common/goacc/routine-4-extern.c new file mode 100644 index 000000000000..ec21db1c3194 --- /dev/null +++ b/gcc/testsuite/c-c++-common/goacc/routine-4-extern.c @@ -0,0 +1,124 @@ +/* Test invalid intra-routine parallelism. */ +/* Variant of 'routine-4.c', moving the callees 'extern'. */ + +extern void extern_gang (void); +#pragma acc routine (extern_gang) gang +extern void extern_worker (void); +#pragma acc routine (extern_worker) worker +extern void extern_vector (void); +#pragma acc routine (extern_vector) vector +extern void extern_seq (void); +#pragma acc routine (extern_seq) seq + +void gang (void); +void worker (void); +void vector (void); + +#pragma acc routine (gang) gang +#pragma acc routine (worker) worker +#pragma acc routine (vector) vector + +#pragma acc routine seq +void seq (void) +{ + extern_gang (); /* { dg-error "routine call uses" } */ + extern_worker (); /* { dg-error "routine call uses" } */ + extern_vector (); /* { dg-error "routine call uses" } */ + extern_seq (); + + int red; + +#pragma acc loop reduction (+:red) // { dg-warning "insufficient partitioning" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop gang reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop worker reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop vector reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; +} + +void vector (void) +{ + extern_gang (); /* { dg-error "routine call uses" } */ + extern_worker (); /* { dg-error "routine call uses" } */ + extern_vector (); + extern_seq (); + + int red; + +#pragma acc loop reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop gang reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop worker reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop vector reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; +} + +void worker (void) +{ + extern_gang (); /* { dg-error "routine call uses" } */ + extern_worker (); + extern_vector (); + extern_seq (); + + int red; + +#pragma acc loop reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop gang reduction (+:red) // { dg-error "disallowed by containing routine" } + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop worker reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop vector reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; +} + +void gang (void) +{ + extern_gang (); + extern_worker (); + extern_vector (); + extern_seq (); + + int red; + +#pragma acc loop reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop gang reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop worker reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; + +#pragma acc loop vector reduction (+:red) + for (int i = 0; i < 10; i++) + red ++; +} diff --git a/gcc/testsuite/c-c++-common/goacc/routine-4.c b/gcc/testsuite/c-c++-common/goacc/routine-4.c index efc4a0b95e59..5f2194c3f623 100644 --- a/gcc/testsuite/c-c++-common/goacc/routine-4.c +++ b/gcc/testsuite/c-c++-common/goacc/routine-4.c @@ -1,4 +1,5 @@ /* Test invalid intra-routine parallelism. */ +/* See also variant 'routine-4-extern.c', moving the callees 'extern'. */ void gang (void); void worker (void); diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-1.f b/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-1.f new file mode 100644 index 000000000000..c27fe7924ed5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-1.f @@ -0,0 +1,347 @@ +! Check valid calls to 'external' OpenACC routines. + +! { dg-additional-options "-fopt-info-optimized-omp" } + + subroutine sub + implicit none + integer, parameter :: n = 100 + integer :: a(n), i, j + external :: gangr, workerr, vectorr, seqr +!$acc routine (gangr) gang +!$acc routine (workerr) worker +!$acc routine (vectorr) vector +!$acc routine (seqr) seq + +! +! Test subroutine calls inside nested loops. +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n +!$acc loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do j = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do + end do +!$acc end parallel loop + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n +!$acc loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do j = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do + end do +!$acc end parallel loop + +! +! Test calls to seq routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to gang routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to worker routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to vector routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + end subroutine sub + + subroutine func + implicit none + integer, parameter :: n = 100 + integer :: a(n), i, j + integer, external :: gangf, workerf, vectorf, seqf +!$acc routine (gangf) gang +!$acc routine (workerf) worker +!$acc routine (vectorf) vector +!$acc routine (seqf) seq + +! +! Test subroutine calls inside nested loops. +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n +!$acc loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do j = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do + end do +!$acc end parallel loop + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n +!$acc loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do j = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do + end do +!$acc end parallel loop + +! +! Test calls to seq routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to gang routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to worker routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to vector routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + end subroutine func diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-2.f b/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-2.f new file mode 100644 index 000000000000..0e8dfb19e2b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-external-level-of-parallelism-2.f @@ -0,0 +1,361 @@ +! Check invalid calls to 'external' OpenACC routines. + +! { dg-additional-options "-fopt-info-optimized-omp" } + + subroutine sub + implicit none + integer, parameter :: n = 100 + integer :: a(n), i, j + external :: gangr, workerr, vectorr, seqr +!$acc routine (gangr) gang +!$acc routine (workerr) worker +!$acc routine (vectorr) vector +!$acc routine (seqr) seq + +! +! Test subroutine calls inside nested loops. +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n +!$acc loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do j = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do + end do +!$acc end parallel loop + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n +!$acc loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do j = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do + end do +!$acc end parallel loop + +! +! Test calls to seq routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call seqr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to gang routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call gangr (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to worker routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call workerr (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to vector routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + call vectorr (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + end subroutine sub + + subroutine func + implicit none + integer, parameter :: n = 100 + integer :: a(n), i, j + integer, external :: gangf, workerf, vectorf, seqf +!$acc routine (gangf) gang +!$acc routine (workerf) worker +!$acc routine (vectorf) vector +!$acc routine (seqf) seq + +! +! Test subroutine calls inside nested loops. +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n +!$acc loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do j = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do + end do +!$acc end parallel loop + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n +!$acc loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do j = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do + end do +!$acc end parallel loop + +! +! Test calls to seq routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = seqf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to gang routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-warning "insufficient partitioning available to parallelize loop" "" { target *-*-* } .-1 } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = gangf (a, n) ! { dg-message "optimized: assigned OpenACC gang worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to worker routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = workerf (a, n) ! { dg-message "optimized: assigned OpenACC worker vector loop parallelism" } + end do +!$acc end parallel loop + +! +! Test calls to vector routines +! + +!$acc parallel loop ! { dg-message "optimized: assigned OpenACC gang worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop gang ! { dg-message "optimized: assigned OpenACC gang loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop worker ! { dg-message "optimized: assigned OpenACC worker loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + +!$acc parallel loop vector ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } +! { dg-error "routine call uses same OpenACC parallelism as containing loop" "" { target *-*-* } .-1 } + end do +!$acc end parallel loop + +!$acc parallel loop seq ! { dg-message "optimized: assigned OpenACC seq loop parallelism" } + do i = 1, n + a(i) = vectorf (a, n) ! { dg-message "optimized: assigned OpenACC vector loop parallelism" } + end do +!$acc end parallel loop + end subroutine func diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-module-3.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-module-3.f90 new file mode 100644 index 000000000000..a4ff54954afa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-module-3.f90 @@ -0,0 +1,16 @@ +! Invalid use of routines defined inside a Fortran module. + +! { dg-compile-aux-modules "routine-module-mod-1.f90" } + +program main + use routine_module_mod_1 + implicit none + !$acc routine (s_1) seq ! { dg-error "Cannot change attributes of USE-associated symbol s_1" } + ! { dg-error "NAME 's_1' invalid in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } .-1 } + !$acc routine (s_2) seq ! { dg-error "Cannot change attributes of USE-associated symbol s_2" } + ! { dg-error "NAME 's_2' invalid in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } .-1 } + !$acc routine (v_1) seq ! { dg-error "Cannot change attributes of USE-associated symbol v_1" } + ! { dg-error "NAME 'v_1' invalid in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } .-1 } + !$acc routine (w_1) gang ! { dg-error "Cannot change attributes of USE-associated symbol w_1" } + ! { dg-error "NAME 'w_1' invalid in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } .-1 } +end program main -- 2.17.1