From 03476214bda71c6581b7978cf9fd5b701896a052 Mon Sep 17 00:00:00 2001 From: Paul-Antoine Arras Date: Wed, 21 Sep 2022 15:52:56 +0000 Subject: [PATCH] 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. --- gcc/fortran/ChangeLog.omp | 7 ++++ gcc/fortran/parse.cc | 32 ++++++++++----- gcc/testsuite/ChangeLog.omp | 7 ++++ .../gfortran.dg/gomp/metadirective-1.f90 | 2 +- .../gfortran.dg/gomp/metadirective-10.f90 | 40 +++++++++++++++++++ .../gfortran.dg/gomp/metadirective-11.f90 | 33 +++++++++++++++ .../gfortran.dg/gomp/metadirective-9.f90 | 30 ++++++++++++++ 7 files changed, 141 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 diff --git gcc/fortran/ChangeLog.omp gcc/fortran/ChangeLog.omp index 8c89cd5bd43..14f897e8fec 100644 --- gcc/fortran/ChangeLog.omp +++ gcc/fortran/ChangeLog.omp @@ -1,3 +1,10 @@ +2022-09-21 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-09 Tobias Burnus Backport from mainline: diff --git gcc/fortran/parse.cc gcc/fortran/parse.cc index b35d76a4f6b..fc88111a7ad 100644 --- gcc/fortran/parse.cc +++ 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 gcc/testsuite/ChangeLog.omp gcc/testsuite/ChangeLog.omp index e0c8c138620..f0d1b1a388b 100644 --- gcc/testsuite/ChangeLog.omp +++ gcc/testsuite/ChangeLog.omp @@ -1,3 +1,10 @@ +2022-09-21 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-09 Paul-Antoine Arras Backport from mainline: diff --git gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 index aa439fc855e..ca62aecad89 100644 --- gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 +++ 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 gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 gcc/testsuite/gfortran.dg/gomp/metadirective-10.f90 new file mode 100644 index 00000000000..5dad5d29eb6 --- /dev/null +++ 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 gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 gcc/testsuite/gfortran.dg/gomp/metadirective-11.f90 new file mode 100644 index 00000000000..e7de70e6259 --- /dev/null +++ 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 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 gcc/testsuite/gfortran.dg/gomp/metadirective-9.f90 new file mode 100644 index 00000000000..e6ab3fc0a65 --- /dev/null +++ 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 + -- 2.31.1