When a label is matched in the first statement after the end of a metadirective
body, it is bound to the associated region. However this prevents it from being
reference elsewhere.
This patch fixes it by rebinding such labels to the outer region.
PR fortran/122369
gcc/fortran/ChangeLog:
* parse.cc (rebind_label): New helper function for
parse_omp_metadirective_body.
(parse_omp_metadirective_body): Rebind labels to the outer region.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/pr122369-1.f90: New test.
* gfortran.dg/gomp/pr122369-2.f90: New test
---
gcc/fortran/parse.cc | 24 +++++++++++++
gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90 | 12 +++++++
gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90 | 36 +++++++++++++++++++
3 files changed, 72 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index b29f6900841..61e37590f23 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -6510,6 +6510,20 @@ parse_omp_dispatch (void)
return st;
}
+/* Helper function for parse_omp_metadirective_body. When a label is part of
the
+ first statement after the end of a metadirective, it is bound to this
+ metadirective, which would prevent it from being referenced elsewhere. Here
+ we rebind it to the outer region. */
+
+static void
+rebind_label (gfc_st_label **label, int old_omp_metadirective_region_count)
+{
+ int new_omp_metadirective_region_count = gfc_omp_metadirective_region_count;
+ gfc_omp_metadirective_region_count = old_omp_metadirective_region_count;
+ *label = gfc_get_st_label ((*label)->value);
+ gfc_omp_metadirective_region_count = new_omp_metadirective_region_count;
+}
+
static gfc_statement
parse_omp_metadirective_body (gfc_statement omp_st)
{
@@ -6522,6 +6536,7 @@ parse_omp_metadirective_body (gfc_statement omp_st)
gfc_statement next_st = ST_NONE;
locus next_loc;
+ int old_omp_metadirective_region_count = gfc_omp_metadirective_region_count;
while (variant)
{
@@ -6611,6 +6626,15 @@ parse_omp_metadirective_body (gfc_statement omp_st)
variant = variant->next;
}
+ if (gfc_statement_label)
+ rebind_label (&gfc_statement_label, old_omp_metadirective_region_count);
+ if ((new_st.op == EXEC_READ || new_st.op == EXEC_WRITE)
+ && new_st.ext.dt->format_label)
+ rebind_label (&new_st.ext.dt->format_label,
+ old_omp_metadirective_region_count);
+ if (new_st.label1)
+ rebind_label (&new_st.label1, old_omp_metadirective_region_count);
+
if (saw_error)
{
if (omp_st == ST_OMP_METADIRECTIVE)
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90
b/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90
new file mode 100644
index 00000000000..68c9d8e7aa0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+
+! Check that a format label referenced in the first statement past a
+! metadirective body is bound to the outer region.
+
+!$omp metadirective when(user={condition(.true.)}: target teams &
+!$omp& distribute parallel do)
+ DO JCHECK = 1, MNMIN
+ END DO
+ WRITE(6,366) PCHECK, UCHECK, VCHECK
+ 366 FORMAT(/, ' Vcheck = ',E12.4,/)
+ END PROGRAM
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90
b/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90
new file mode 100644
index 00000000000..aa6dba48250
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90
@@ -0,0 +1,36 @@
+! { dg-do compile }
+
+! Check that a statement label that ends a loop in the first statement past a
+! metadirective body is bound to the outer region.
+
+implicit none
+integer :: i, j
+logical :: cond1, cond2
+integer :: A(0:10,0:5), B(0:10,0:5)
+
+cond1 = .true.
+cond2 = .true.
+
+!$omp metadirective when(user={condition(cond1)} : parallel do collapse(2))
+ do 50 j = 0, 5
+!$omp metadirective when(user={condition(.false.)} : simd)
+ do 51 i = 0, 10
+ A(i,j) = i*10 + j
+ 51 continue
+ 50 continue
+
+ do 55 i = 0, 5
+ 55 continue
+
+!$omp begin metadirective when(user={condition(cond2)} : parallel do
collapse(2))
+ do 60 j = 0, 5
+!$omp metadirective when(user={condition(.false.)} : simd)
+ do 61 i = 0, 10
+ B(i,j) = i*10 + j
+ 61 continue
+ 60 continue
+!$omp end metadirective
+
+ do 70 j = 0, 5
+ 70 continue
+end
--
2.51.0
