From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 7899) id B38E93858016; Wed, 28 Sep 2022 15:08:27 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org B38E93858016 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1664377707; bh=kSF4+48RW68yjRwhGtSNQQUEcYJTkTz7rq6ukntceDA=; h=From:To:Subject:Date:From; b=u4J7sdloAe94JSQ8Ra3EwaEbPNqavNzxYBeR5oREUeaz/vsB0TrkUzjRlGHqFICq1 t9nFRMvrMOZE6BJnCZv2eRAstZzgNZGalN34JPmTzKKJMFnlpIoe8gy20hG6zRnaqn mi7cuUXNPOSLVZVSMUmjEVrk0671dpsrpei6SyFc= Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Paul-Antoine Arras To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-12] OpenMP: Fix ICE with OMP metadirectives X-Act-Checkin: gcc X-Git-Author: Paul-Antoine Arras X-Git-Refname: refs/heads/devel/omp/gcc-12 X-Git-Oldrev: 4ed1f19b84797569a0be6f0347401f2f6c882c32 X-Git-Newrev: d21bfef98674abccd204dd2de5159cb3a19ea771 Message-Id: <20220928150827.B38E93858016@sourceware.org> Date: Wed, 28 Sep 2022 15:08:27 +0000 (GMT) List-Id: https://gcc.gnu.org/g:d21bfef98674abccd204dd2de5159cb3a19ea771 commit d21bfef98674abccd204dd2de5159cb3a19ea771 Author: Paul-Antoine Arras Date: Wed Sep 21 15:52:56 2022 +0000 OpenMP: Fix ICE with OMP metadirectives Problem: ending an OpenMP metadirective block with an OMP end statement results in an internal compiler error. Solution: reject invalid end statements and issue a proper diagnostic. This revision also fixes a couple of minor metadirective issues and adds related test cases. gcc/fortran/ChangeLog: * parse.cc (gfc_ascii_statement): Missing $ in !$OMP END METADIRECTIVE. (parse_omp_structured_block): Fix handling of OMP end metadirective. (parse_omp_metadirective_body): Reject OMP end statements at the end of an OMP metadirective. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/metadirective-1.f90: Match !$OMP END METADIRECTIVE. * gfortran.dg/gomp/metadirective-10.f90: New test. * gfortran.dg/gomp/metadirective-11.f90: New xfail test. * gfortran.dg/gomp/metadirective-9.f90: New test. Diff: --- gcc/fortran/ChangeLog.omp | 8 +++++ gcc/fortran/parse.cc | 32 ++++++++++++----- gcc/testsuite/ChangeLog.omp | 7 ++++ gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 | 2 +- .../gfortran.dg/gomp/metadirective-10.f90 | 40 ++++++++++++++++++++++ .../gfortran.dg/gomp/metadirective-11.f90 | 33 ++++++++++++++++++ gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 | 30 ++++++++++++++++ 7 files changed, 142 insertions(+), 10 deletions(-) diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 923a46312a9..7e782d5820f 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,11 @@ + +2022-09-28 Paul-Antoine Arras + + * parse.cc (gfc_ascii_statement): Missing $ in !$OMP END METADIRECTIVE. + (parse_omp_structured_block): Fix handling of OMP end metadirective. + (parse_omp_metadirective_body): Reject OMP end statements + at the end of an OMP metadirective. + 2022-09-23 Tobias Burnus Backport from mainline: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index b35d76a4f6b..fc88111a7ad 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -2517,7 +2517,7 @@ gfc_ascii_statement (gfc_statement st) p = "!$OMP END MASTER TASKLOOP SIMD"; break; case ST_OMP_END_METADIRECTIVE: - p = "!OMP END METADIRECTIVE"; + p = "!$OMP END METADIRECTIVE"; break; case ST_OMP_END_ORDERED: p = "!$OMP END ORDERED"; @@ -5643,9 +5643,15 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) np->block = NULL; omp_end_st = gfc_omp_end_stmt (omp_st, false, true); - if (omp_st == ST_NONE) + if (omp_end_st == ST_NONE) gcc_unreachable (); + /* If handling a metadirective variant, treat 'omp end metadirective' + as the expected end statement for the current construct. */ + if (gfc_state_stack->previous != NULL + && gfc_state_stack->previous->state == COMP_OMP_BEGIN_METADIRECTIVE) + omp_end_st = ST_OMP_END_METADIRECTIVE; + bool block_construct = false; gfc_namespace *my_ns = NULL; gfc_namespace *my_parent = NULL; @@ -5744,13 +5750,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only) else st = parse_executable (st); - /* If handling a metadirective variant, treat 'omp end metadirective' - as the expected end statement for the current construct. */ - if (st == ST_OMP_END_METADIRECTIVE - && gfc_state_stack->previous != NULL - && gfc_state_stack->previous->state == COMP_OMP_BEGIN_METADIRECTIVE) - st = omp_end_st; - if (st == ST_NONE) unexpected_eof (); else if (st == ST_OMP_SECTION @@ -5863,6 +5862,21 @@ parse_omp_metadirective_body (gfc_statement omp_st) break; } + if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE + && startswith (gfc_ascii_statement (st), "!$OMP END ")) + { + for (gfc_state_data *p = gfc_state_stack; p; p = p->previous) + if (p->state == COMP_OMP_STRUCTURED_BLOCK + || p->state == COMP_OMP_BEGIN_METADIRECTIVE) + goto finish; + gfc_error ( + "Unexpected %s statement in an OMP METADIRECTIVE block at %C", + gfc_ascii_statement (st)); + reject_statement (); + st = next_statement (); + } + finish: + gfc_in_metadirective_body = old_in_metadirective_body; if (gfc_state_stack->head) diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 15e95baa089..435914c8bdb 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,10 @@ +2022-09-28 Paul-Antoine Arras + + * gfortran.dg/gomp/metadirective-1.f90: Match !$OMP END METADIRECTIVE. + * gfortran.dg/gomp/metadirective-10.f90: New test. + * gfortran.dg/gomp/metadirective-11.f90: New test. + * gfortran.dg/gomp/metadirective-9.f90: New test. + 2022-09-27 Tobias Burnus Backport from mainline: diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 index aa439fc855e..ca62aecad89 100644 --- a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 @@ -37,5 +37,5 @@ program main do i = 1, N c(i) = a(i) * b(i) end do - !$omp end metadirective ! { dg-error "Unexpected !OMP END METADIRECTIVE statement at .1." } + !$omp end metadirective ! { dg-error "Unexpected !.OMP END METADIRECTIVE statement at .1." } end program diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 new file mode 100644 index 00000000000..5dad5d29eb6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } + +program metadirectives + implicit none + logical :: UseDevice + + !$OMP metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : parallel ) & + !$OMP default ( parallel ) + block + call bar() + end block + + !$OMP metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : parallel ) & + !$OMP default ( parallel ) + call bar() + !$omp end parallel ! Accepted, because all cases have 'parallel' + + !$OMP begin metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : nothing ) & + !$OMP default ( parallel ) + call bar() + block + call foo() + end block + !$OMP end metadirective + + !$OMP begin metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : parallel ) & + !$OMP default ( parallel ) + call bar() + !$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement at .1." } +end program ! { dg-error "Unexpected END statement at .1." } + +! { dg-error "Unexpected end of file" "" { target *-*-* } 0 } diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 new file mode 100644 index 00000000000..e7de70e6259 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! { dg-ice "Statements following a block in a metadirective" } +! PR fortran/107067 + +program metadirectives + implicit none + logical :: UseDevice + + !$OMP begin metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : nothing ) & + !$OMP default ( parallel ) + block + call foo() + end block + call bar() ! FIXME/XFAIL ICE in parse_omp_metadirective_body() + !$omp end metadirective + + + !$OMP begin metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : nothing ) & + !$OMP default ( parallel ) + block + call bar() + end block + block ! FIXME/XFAIL ICE in parse_omp_metadirective_body() + call foo() + end block + !$omp end metadirective +end program + + diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 new file mode 100644 index 00000000000..e6ab3fc0a65 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 @@ -0,0 +1,30 @@ +! { dg-do compile } + +program OpenMP_Metadirective_WrongEnd_Test + implicit none + + integer :: & + iaVS, iV, jV, kV + integer, dimension ( 3 ) :: & + lV, uV + logical :: & + UseDevice + + !$OMP metadirective & + !$OMP when ( user = { condition ( UseDevice ) } & + !$OMP : target teams distribute parallel do simd collapse ( 3 ) & + !$OMP private ( iaVS ) ) & + !$OMP default ( parallel do simd collapse ( 3 ) private ( iaVS ) ) + do kV = lV ( 3 ), uV ( 3 ) + do jV = lV ( 2 ), uV ( 2 ) + do iV = lV ( 1 ), uV ( 1 ) + + + end do + end do + end do + !$OMP end target teams distribute parallel do simd ! { dg-error "Unexpected !.OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD statement in an OMP METADIRECTIVE block at .1." } + + +end program +