public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
From: Tobias Burnus <tobias@codesourcery.com>
To: Jakub Jelinek <jakub@redhat.com>, fortran <fortran@gcc.gnu.org>,
	gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [Patch] OpenMP: Fortran - fix ancestor's requires reverse_offload check
Date: Wed, 8 Jun 2022 09:54:07 +0200	[thread overview]
Message-ID: <35ed17a9-2429-1428-2825-c4076321a068@codesourcery.com> (raw)

[-- Attachment #1: Type: text/plain, Size: 541 bytes --]

The OpenMP requires directive may only be placed in the specification part of
a program unit (except it happens via the USE of a module).

But the target directive ancestor-requires-'reverse_offload' only checked
the current namespace.

OK for mainline?

Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: fix-ns-ancestor.diff --]
[-- Type: text/x-patch, Size: 2989 bytes --]

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.

 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 d12cec43d64..aeb8a43e12e 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -2014,8 +2014,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

             reply	other threads:[~2022-06-08  7:54 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-06-08  7:54 Tobias Burnus [this message]
2022-06-08  7:59 ` Jakub Jelinek

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=35ed17a9-2429-1428-2825-c4076321a068@codesourcery.com \
    --to=tobias@codesourcery.com \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=jakub@redhat.com \
    /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: link
Be 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).