[gcc/devel/omp/gcc-12] OpenMP: Fortran - fix ancestor's requires reverse_offload check

[gcc/devel/omp/gcc-12] OpenMP: Fortran - fix ancestor's requires reverse_offload check

[Tobias Burnus]

https://gcc.gnu.org/g:6c0936c4c9a91cd56be2fa08a0f9b5f78e05d25e

commit 6c0936c4c9a91cd56be2fa08a0f9b5f78e05d25e
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Tue Jul 5 11:16:43 2022 +0200

    OpenMP: Fortran - fix ancestor's requires reverse_offload check
    
    gcc/fortran/
    
            * openmp.cc (gfc_match_omp_clauses): Check also parent namespace
            for 'requires reverse_offload'.
    
    gcc/testsuite/
    
            * gfortran.dg/gomp/target-device-ancestor-5.f90: New test.
    
    (cherry picked from commit 5e5deac508e3025e2d2c36212aa52d52001b893d)

Diff:
---
 gcc/fortran/openmp.cc                              |  9 ++-
 .../gfortran.dg/gomp/target-device-ancestor-5.f90  | 69 ++++++++++++++++++++++
 2 files changed, 77 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 64529f97336..613ebc121c3 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2560,8 +2560,15 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		}
 	      else if (gfc_match ("ancestor : ") == MATCH_YES)
 		{
+		  bool has_requires = false;
 		  c->ancestor = true;
-		  if (!(gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
+		  for (gfc_namespace *ns = gfc_current_ns; ns; ns = ns->parent)
+		    if (ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)
+		      {
+			has_requires = true;
+			break;
+		      }
+		  if (!has_requires)
 		    {
 		      gfc_error ("%<ancestor%> device modifier not "
 				 "preceded by %<requires%> directive "
diff --git a/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90 b/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90
new file mode 100644
index 00000000000..06a11eb5092
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/target-device-ancestor-5.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+!
+! Check that a requires directive is still recognized
+! if it is in the associated parent namespace of the
+! target directive.
+!
+
+module m
+  !$omp requires reverse_offload  ! { dg-error "REQUIRES directive is not yet supported" }
+contains
+  subroutine foo()
+    !$omp target device(ancestor:1)
+    !$omp end target
+  end subroutine foo
+
+  subroutine bar()
+    block
+      block
+        block
+          !$omp target device(ancestor:1)
+          !$omp end target
+        end block
+      end block
+    end block
+  end subroutine bar
+end module m
+
+subroutine foo()
+  !$omp requires reverse_offload  ! { dg-error "REQUIRES directive is not yet supported" }
+  block
+    block
+      block
+        !$omp target device(ancestor:1)
+        !$omp end target
+      end block
+    end block
+  end block
+contains
+  subroutine bar()
+    block
+      block
+        block
+          !$omp target device(ancestor:1)
+          !$omp end target
+        end block
+      end block
+    end block
+  end subroutine bar
+end subroutine foo
+
+program main
+  !$omp requires reverse_offload  ! { dg-error "REQUIRES directive is not yet supported" }
+contains
+  subroutine foo()
+    !$omp target device(ancestor:1)
+    !$omp end target
+  end subroutine foo
+
+  subroutine bar()
+    block
+      block
+        block
+          !$omp target device(ancestor:1)
+          !$omp end target
+        end block
+      end block
+    end block
+  end subroutine bar
+end