From: Tobias Burnus <tobias@codesourcery.com>
To: gcc-patches <gcc-patches@gcc.gnu.org>
Cc: fortran <fortran@gcc.gnu.org>, Jakub Jelinek <jakub@redhat.com>
Subject: [committed] OpenMP/Fortran: Extend reject code between target + teams [PR71065, PR110725] (was: Re: [patch] OpenMP/Fortran: Reject declarations between target + teams (was: [Patch] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065]))
Date: Thu, 27 Jul 2023 18:36:49 +0200 [thread overview]
Message-ID: <447c2f24-912a-cfa7-5256-f5f560ed15f7@codesourcery.com> (raw)
In-Reply-To: <8b5edd17-db3e-d4d7-121e-de8550fa9dbc@codesourcery.com>
[-- Attachment #1: Type: text/plain, Size: 658 bytes --]
Yet another omission, the flag was not properly set for deeply buried
'omp teams' as I stopped too early when walking up the stack.
Now fixed by commit r14-2826-g081e25d3cfd86c
* * *
This was found when 'repairing' the feature on the OG13
(devel/omp/gcc-13) branch for metadirectives, cf. the second attached
patch, applied after cherry-picking the mainline patch.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 4414 bytes --]
commit 081e25d3cfd86c4094999ded0bbe99b91762013c
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Thu Jul 27 18:14:11 2023 +0200
OpenMP/Fortran: Extend reject code between target + teams [PR71065, PR110725]
The previous version failed to diagnose when the 'teams' was nested
more deeply inside the target region, e.g. inside a DO or some
block or structured block.
PR fortran/110725
PR middle-end/71065
gcc/fortran/ChangeLog:
* openmp.cc (resolve_omp_target): Minor cleanup.
* parse.cc (decode_omp_directive): Find TARGET statement
also higher in the stack.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/teams-6.f90: Extend.
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 52eeaf2d4da..2952cd300ac 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -10666,15 +10666,14 @@ resolve_omp_target (gfc_code *code)
if (!code->ext.omp_clauses->contains_teams_construct)
return;
+ gfc_code *c = code->block->next;
if (code->ext.omp_clauses->target_first_st_is_teams
- && ((GFC_IS_TEAMS_CONSTRUCT (code->block->next->op)
- && code->block->next->next == NULL)
- || (code->block->next->op == EXEC_BLOCK
- && code->block->next->next
- && GFC_IS_TEAMS_CONSTRUCT (code->block->next->next->op)
- && code->block->next->next->next == NULL)))
+ && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
+ || (c->op == EXEC_BLOCK
+ && c->next
+ && GFC_IS_TEAMS_CONSTRUCT (c->next->op)
+ && c->next->next == NULL)))
return;
- gfc_code *c = code->block->next;
while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op))
c = c->next;
if (c)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index aa6bb663def..e797402b59f 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1318,32 +1318,27 @@ decode_omp_directive (void)
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case ST_OMP_TEAMS_LOOP:
- if (gfc_state_stack->previous && gfc_state_stack->previous->tail)
- {
- gfc_state_data *stk = gfc_state_stack;
- do {
- stk = stk->previous;
- } while (stk && stk->tail && stk->tail->op == EXEC_BLOCK);
- if (stk && stk->tail)
- switch (stk->tail->op)
- {
- case EXEC_OMP_TARGET:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- case EXEC_OMP_TARGET_PARALLEL:
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- case EXEC_OMP_TARGET_SIMD:
- stk->tail->ext.omp_clauses->contains_teams_construct = 1;
- break;
- default:
- break;
- }
- }
+ for (gfc_state_data *stk = gfc_state_stack->previous; stk;
+ stk = stk->previous)
+ if (stk && stk->tail)
+ switch (stk->tail->op)
+ {
+ case EXEC_OMP_TARGET:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_TEAMS_LOOP:
+ case EXEC_OMP_TARGET_PARALLEL:
+ case EXEC_OMP_TARGET_PARALLEL_DO:
+ case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+ case EXEC_OMP_TARGET_PARALLEL_LOOP:
+ case EXEC_OMP_TARGET_SIMD:
+ stk->tail->ext.omp_clauses->contains_teams_construct = 1;
+ break;
+ default:
+ break;
+ }
break;
case ST_OMP_ERROR:
if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION)
diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-6.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90
index be453f27f40..0bd7735e738 100644
--- a/gcc/testsuite/gfortran.dg/gomp/teams-6.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/teams-6.f90
@@ -37,6 +37,16 @@ end block
i = 5
!$omp end teams
!$omp end target
+
+
+!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+block
+ do i = 5, 8
+ !$omp teams
+ block; end block
+ end do
+end block
+
end
[-- Attachment #3: og13.diff --]
[-- Type: text/x-patch, Size: 8489 bytes --]
commit eae457d9aa6ccad1692759bffee8fa3f6c92a3a0
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Thu Jul 27 18:30:20 2023 +0200
OpenMP/Fortran: Fix target + teams diagnostic with metadirectives
gcc/fortran/ChangeLog:
* gfortran.h (gfc_omp_clauses): Rename target_first_st_is_teams
to target_first_st_is_teams_or_meta.
* parse.cc (parse_omp_structured_block): Handle metadirectives
for target_first_st_is_teams.
* openmp.cc (resolve_omp_target): Likewise to fix target+teams
diagnostic with metadirectives.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/metadirective-1.f90: Extend.
* testsuite/libgomp.fortran/metadirective-6.f90: New test.
---
gcc/fortran/ChangeLog.omp | 9 ++++
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/openmp.cc | 35 ++++++++++---
gcc/fortran/parse.cc | 4 +-
libgomp/ChangeLog.omp | 5 ++
.../testsuite/libgomp.fortran/metadirective-1.f90 | 28 +++++++++++
.../testsuite/libgomp.fortran/metadirective-6.f90 | 58 ++++++++++++++++++++++
7 files changed, 132 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index c197f77f1f9..237e9ebeba2 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,12 @@
+2023-07-27 Tobias Burnus <tobias@codesourcery.com>
+
+ * gfortran.h (gfc_omp_clauses): Rename target_first_st_is_teams
+ to target_first_st_is_teams_or_meta.
+ * parse.cc (parse_omp_structured_block): Handle metadirectives
+ for target_first_st_is_teams.
+ * openmp.cc (resolve_omp_target): Likewise to fix target+teams
+ diagnostic with metadirectives.
+
2023-07-27 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2cf8a0e0c39..0e7e80e4bf1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1588,7 +1588,7 @@ typedef struct gfc_omp_clauses
unsigned order_unconstrained:1, order_reproducible:1, capture:1;
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
unsigned non_rectangular:1, order_concurrent:1;
- unsigned contains_teams_construct:1, target_first_st_is_teams:1;
+ unsigned contains_teams_construct:1, target_first_st_is_teams_or_meta:1;
unsigned unroll_full:1, unroll_none:1, unroll_partial:1;
unsigned unroll_partial_factor;
ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 18a4a33feaa..deccb14a525 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12252,13 +12252,34 @@ resolve_omp_target (gfc_code *code)
if (!code->ext.omp_clauses->contains_teams_construct)
return;
gfc_code *c = code->block->next;
- if (code->ext.omp_clauses->target_first_st_is_teams
- && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
- || (c->op == EXEC_BLOCK
- && c->next
- && GFC_IS_TEAMS_CONSTRUCT (c->next->op)
- && c->next->next == NULL)))
- return;
+ if (c->op == EXEC_BLOCK)
+ c = c->next;
+ if (code->ext.omp_clauses->target_first_st_is_teams_or_meta)
+ {
+ if (c->op == EXEC_OMP_METADIRECTIVE)
+ {
+ struct gfc_omp_metadirective_clause *mc
+ = c->ext.omp_metadirective_clauses;
+ /* All mc->(next...->)code should be identical with regards
+ to the diagnostic below. */
+ do
+ {
+ if (mc->stmt != ST_NONE
+ && GFC_IS_TEAMS_CONSTRUCT (mc->code->op))
+ {
+ if (c->next == NULL && mc->code->next == NULL)
+ return;
+ c = mc->code;
+ break;
+ }
+ mc = mc->next;
+ }
+ while (mc);
+ }
+ else if (GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
+ return;
+ }
+
while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op))
c = c->next;
if (c)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 2070a8a7dee..efedde1d84b 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5833,9 +5833,11 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case ST_OMP_TEAMS_LOOP:
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
{
gfc_state_data *stk = gfc_state_stack->previous;
- stk->tail->ext.omp_clauses->target_first_st_is_teams = true;
+ stk->tail->ext.omp_clauses->target_first_st_is_teams_or_meta = true;
break;
}
default:
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index f83700f1c00..9f8e3ec947d 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,8 @@
+2023-07-27 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/metadirective-1.f90: Extend.
+ * testsuite/libgomp.fortran/metadirective-6.f90: New test.
+
2023-07-26 Tobias Burnus <tobias@codesourcery.com>
Backported from master:
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
index 9f6a07459e0..7b3e09f7c2a 100644
--- a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
@@ -17,17 +17,45 @@ program test
do i = 1, N
if (z(i) .ne. x(i) * y(i)) stop 1
end do
+
+ ! -----
+ do i = 1, N
+ x(i) = i;
+ y(i) = -i;
+ end do
+
+ call g (x, y, z)
+
+ do i = 1, N
+ if (z(i) .ne. x(i) * y(i)) stop 1
+ end do
+
contains
subroutine f (x, y, z)
integer :: x(N), y(N), z(N)
!$omp target map (to: x, y) map(from: z)
+ block
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ end subroutine
+ subroutine g (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z)
+ block
!$omp metadirective &
!$omp& when(device={arch("nvptx")}: teams loop) &
!$omp& default(parallel loop)
do i = 1, N
z(i) = x(i) * y(i)
enddo
+ end block
!$omp end target
end subroutine
end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-6.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90
new file mode 100644
index 00000000000..436fdbade2f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-6.f90
@@ -0,0 +1,58 @@
+! { dg-do compile }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: x(N), y(N), z(N)
+ integer :: i
+
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop) ! { dg-error "\\(1\\)" }
+ ! FIXME: The line above should be the same error as above but some fails here with -fno-diagnostics-show-caret
+ ! Seems as if some gcc/testsuite/ fix is missing for libgomp/testsuite
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ z(N) = z(N) + 1 ! <<< invalid
+ end block
+ end subroutine
+
+ subroutine f2 (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ integer :: i ! << invalid
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ end subroutine
+ subroutine g (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" }
+ block
+ !$omp metadirective & ! <<<< invalid
+ !$omp& when(device={arch("nvptx")}: flush) &
+ !$omp& default(nothing)
+ !$omp teams loop
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ end block
+ !$omp end target
+ end subroutine
+
+end program
prev parent reply other threads:[~2023-07-27 16:37 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-24 19:43 [Patch] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065] Tobias Burnus
2023-07-24 19:49 ` Jakub Jelinek
2023-07-24 20:05 ` Tobias Burnus
2023-07-25 7:37 ` Tobias Burnus
2023-07-25 11:14 ` [patch] OpenMP/Fortran: Reject declarations between target + teams (was: [Patch] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065]) Tobias Burnus
2023-07-27 16:36 ` Tobias Burnus [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=447c2f24-912a-cfa7-5256-f5f560ed15f7@codesourcery.com \
--to=tobias@codesourcery.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=jakub@redhat.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).