public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Paul-Antoine Arras <parras@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-12] OpenMP: Fix ICE with OMP metadirectives Date: Wed, 28 Sep 2022 15:08:27 +0000 (GMT) [thread overview] Message-ID: <20220928150827.B38E93858016@sourceware.org> (raw) https://gcc.gnu.org/g:d21bfef98674abccd204dd2de5159cb3a19ea771 commit d21bfef98674abccd204dd2de5159cb3a19ea771 Author: Paul-Antoine Arras <pa@codesourcery.com> 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 <pa@codesourcery.com> + + * 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 <tobias@codesourcery.com> 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 <pa@codesourcery.com> + + * 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 <tobias@codesourcery.com> 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 +
reply other threads:[~2022-09-28 15:08 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
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=20220928150827.B38E93858016@sourceware.org \ --to=parras@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /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: linkBe 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).