public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Julian Brown <julian@codesourcery.com>
To: Tobias Burnus <tobias@codesourcery.com>
Cc: Jakub Jelinek <jakub@redhat.com>, <gcc-patches@gcc.gnu.org>,
	<fortran@gcc.gnu.org>, <cltang@codesourcery.com>
Subject: Re: [PATCH v3 06/11] OpenMP: Pointers and member mappings
Date: Fri, 30 Sep 2022 14:30:22 +0100	[thread overview]
Message-ID: <20220930143022.1cc80cbd@squid.athome> (raw)
In-Reply-To: <4cb8ef27-5cb0-42d5-2e66-5bf93bd11c48@codesourcery.com>

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

On Fri, 23 Sep 2022 14:10:51 +0200
Tobias Burnus <tobias@codesourcery.com> wrote:

> Hi Julian and Jakub, hi all,
> 
> On 23.09.22 09:29, Julian Brown wrote:
> > How about this version? (Re-tested.)  
> 
> Some more generic (pre)remarks – not affecting the patch code,
> but possibly the commit log message:
> 
> > This follows OMP 5.0, 2.19.7.1 "map Clause":  
> 
> which is also in "OMP 5.2, 5.8.3 map Clause [152:1-4]". It might
> make sense to add this ref in addition (or instead):
> 
> >    "If a list item in a map clause is an associated pointer and the
> >     pointer is not the base pointer of another list item in a map
> > clause on the same construct, then it is treated as if its pointer
> > target is implicitly mapped in the same clause. For the purposes of
> > the map clause, the mapped pointer target is treated as if its base
> > pointer is the associated pointer."  

I've changed the wording in the commit log text...

> Thus, the following restriction was proposed for OpenMP 6.0 (TR11):
> 
> "The association status of a list item that is a pointer must not be
>   undefined unless it is a structure component and it results from a
>   predefined default mapper."
> 
> which makes my example invalid. (Add some caveat here about TR11 not
> yet being released and also TRs being not final named-version
> releases.)

(But not this bit, for now.)

> > and then instead we should follow:
> >
> >    "If the structure sibling list item is a pointer then it is
> > treated as if its association status is undefined, unless it
> > appears as the base pointer of another list item in a map clause on
> > the same construct."  
> 
> 
> This wording disappeared in 5.1 due to some cleanup (cf. Issue 2152,
> which has multiple changes; this one is Pull Req. 2379).
> 
> I think the matching current / OpenMP 5.2 wording (5.8.3 map Clause
> [152:5-8, 11-13 (,14-16)]) is
> 
> "For map clauses on map-entering constructs, if any list item has a
> base pointer for which a corresponding pointer exists in the data
> environment upon entry to the region and either a new list item or
> the corresponding pointer is created in the device data environment
> on entry to the region, then: (Fortran)
> 1. The corresponding pointer variable is associated with a pointer
> target that has the same rank and bounds as the pointer target of the
> original pointer, such that the corresponding list item can be
> accessed through the pointer in a target region. ..."
> 
> I think here 'a new list item ... is created ... on entry' applies.
> However, this should not affect what you wrote later on.

I changed the text here too.

> > But, that's not implemented quite right at the moment [...]
> > The solution is to detect when we're mapping a smaller part of the
> > array (or a subcomponent) on the same directive, and only map the
> > descriptor in that case. So we get mappings like this instead:
> >
> >    map(to: tvar%arrptr)   -->
> >    GOMP_MAP_ALLOC  tvar%arrptr  (the descriptor)
> >
> >    map(tofrom: tvar%arrptr(3:8)   -->
> >    GOMP_MAP_TOFROM tvar%arrptr%data(3) (size 8-3+1, etc.)
> >    GOMP_MAP_ALWAYS_POINTER tvar%arrptr%data (bias 3, etc.)  
> 
> (I concur.)

Thank you!

> > --- a/gcc/fortran/trans-openmp.cc
> > +++ b/gcc/fortran/trans-openmp.cc
> > ...
> > @@ -2470,22 +2471,18 @@ gfc_trans_omp_array_section (stmtblock_t
> > *block, gfc_omp_namelist *n, }
> >     if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
> >       {
> > ...
> > +      if (ptr_kind != GOMP_MAP_ALWAYS_POINTER)
> >   	{
> > ...
> > +	  /* For OpenMP, the descriptor must be mapped with its
> > own explicit
> > +	     map clause (e.g. both "map(foo%arr)" and
> > "map(foo%arr(:))" must
> > +	     be present in the clause list if "foo%arr" is a
> > pointer to an
> > +	     array).  So, we don't create a GOMP_MAP_TO_PSET node
> > here.  */
> > +	  node2 = build_omp_clause (input_location,
> > OMP_CLAUSE_MAP);
> > +	  OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);  
> 
> I found the last sentence of the comment and the set_map_kind
> confusing: The comment says no MAP_TO_PSET and the SET_MAP_KIND use
> it.
> 
> I wonder whether that should be something like 'if (openacc)' instead,
> which kind of matches the first way gfc_trans_omp_array_section is
> called:

I agree it was confusing -- I've tweaked the wording of the comment.
The condition changes in the "address tokenization" follow-up patch
anyway.

> inner, element, kind, node, node2, node3,
>                                                     node4);
> However, there is also a second call to it:
> 
>                    /* An array element or array section which is not
> part of a derived type, etc.  */
> ...
>                    gomp_map_kind k = GOMP_MAP_POINTER;
> ...
>                    gfc_trans_omp_array_section (block, n, decl,
> element, k, node, node2, node3, node4);

> And without following all 'if' conditions through, I don't see why
> that should be handled differently.

GOMP_MAP_POINTER is used for non-component accesses -- those get the
GOMP_MAP_TO_PSET mapping in gfc_trans_omp_array_section.  (Some of
these conditions are based on perhaps-not-quite obvious implications,
but again, they change in the follow-up patch mentioned above anyway.)

> > +  /* We're only interested in cases where we have an expression,
> > e.g. a
> > +     component access.  */
> > +  if (n->expr && n->expr->symtree)
> > +    use_sym = n->expr->symtree->n.sym;  
> 
> The second part looks unsafe in light of 'lvalues'. The next OpenMP
> version will likely permit:
> "A locator list item is a variable list item, a function reference
> with data pointer result, or a reserved locator."
> 
> Thus, permitting 'map( f(cnt=4))' for a function that returns a data
> pointer like interface
>      function f(cnt) result(res)
>        integer :: cnt
>        real, pointer :: res(:,:)
>      end
>    end interface
> 
> (In Fortran, referencing 'f' counts as variable. However, contrary to
> C/C++, 'f()%comp or 'f()(1:4)', i.e. component and array reverences,
> are not permitted.)
> 
> Thus, it seems to make more sense to have n->expr->expr_type ==
> EXPR_VARIABLE as the symtree is also set for EXPR_FUNCTION and
> EXPR_COMPCALL. The later is something like  dt%f(5)  where 'dt' is a
> variable of derived type and 'f' is a variable bound to the derived
> type. – I think it might also be set for PARAMETER, but I am not sure
> until which point.

I added n->expr->expr_type == EXPR_VARIABLE to the condition -- I think
that should suffice for now?

> > +	  if (!n2->expr || !n2->expr->symtree)
> > +	    continue;  
> Likewise.
> > +			  /* If the last reference is a pointer to
> > a derived
> > +			     type ("foo%dt_ptr"), check if any
> > subcomponents
> > +			     of the same derived type member are
> > being mapped
> > +			     elsewhere in the clause list
> > ("foo%dt_ptr%x",
> > +			     etc.).  If we have such subcomponent
> > mappings,
> > +			     we only create an ALLOC node for the
> > pointer
> > +			     itself, and inhibit mapping the whole
> > derived
> > +			     type.  */  
> 
> Does the current code handle also the following?
> 
>    i = 1; j = 2
>    map (foo(i)%dt_ptr(1:3), foo(j)%dt_ptr)

Good catch! In that gfc_dep_resolver considers those terms to have a
dependency, and that triggers the mapping node transformation. But I
don't think OpenMP allows you to write this: IIUC if "foo" is an array,
you're not allowed to separately map two parts of the array because of
(OpenMP 5.2, "5.8.3 map Clause"):

  "Two list items of the map clauses on the same construct must not
   share original storage unless they are the same list item or unless
   one is the containing structure of the other."

and,

  "If a list item is an array section, it must specify contiguous
   storage."

and maybe also (for different directive arrangements),

   "If an array appears as a list item in a map clause, multiple parts
    of the array have corresponding storage in the device data
    environment prior to a task encountering the construct associated
    with the map clause, and the corresponding storage for those parts
    was created by maps from more than one earlier construct, the
    behavior is unspecified."

One thing that *does* work is a similar test to yours but with "i" and
"j" pointing to the *same* location.  That needs the "address
tokenization" patch to be applied too, though. (I added a new test to
this version of the patch.)

(If multiple variable indices to the same struct array component *were*
allowed, that'd cause serious problems for the struct sibling list
building code -- it'd no longer be possible to sort members statically.
And if different "names" for the same blocks of host memory were
allowed, e.g. allowing a pointer and a pointed-to block to be mapped
using different variables, that'd imply a requirement to compare each
clause against each other clause at runtime -- a quadratic number of
tests, probably.)

> Note: I have not thought about validity nor checked your code, but it
> does not seem to be completely odd code to write.
> 
> A similar mean way to write code would be:
> 
> integer, target :: A(5)
> integer, pointer :: p(:), p2(:)
> type(t) :: var
> 
> allocate(p2(1:20))
> p => A
> var%p2 => p2
> !$omp target map(A(3:4), p2(4:8), p, var%p2)
>   ....
> !$omp end target
> 
> which has a similar issue – it is not clear from the syntax whether
> p's or var%p2's pointer target has been mapped or not.

Again, I don't think you're allowed to write that: that's "different
list items" sharing the same "original storage", IIUC. (It'd be nice to
diagnose it at compile time, but that's probably not that easy...)

> I don't currently see whether that's handled or not - but I fear it
> is not. All this seems to points to first handle all non-pointer
> variables, then all with tailing array refs and only then the rest -
> and implicit mapping last (followed by use_device_{ptr,addr}).

I think I'd need that plan explained a bit more verbosely! But anyway,
hopefully it's not necessary.

Attached patch re-tested with offloading to NVPTX. OK?

Thanks,

Julian

[-- Attachment #2: v3-0001-OpenMP-Pointers-and-member-mappings.patch --]
[-- Type: text/x-patch, Size: 21932 bytes --]

From 1c703b3d187e3416df1e94c753f18d60e263e5cc Mon Sep 17 00:00:00 2001
From: Julian Brown <julian@codesourcery.com>
Date: Tue, 31 May 2022 18:39:00 +0000
Subject: [PATCH v3] OpenMP: Pointers and member mappings

Implementing the "omp declare mapper" functionality, I noticed some
cases where handling of derived type members that are pointers doesn't
seem to be quite right. At present, a type such as this:

  type T
  integer, pointer, dimension(:) :: arrptr
  end type T

  type(T) :: tvar
  [...]
  !$omp target map(tofrom: tvar%arrptr)

will be mapped using three mapping nodes:

  GOMP_MAP_TO             tvar%arrptr       (the descriptor)
  GOMP_MAP_TOFROM         *tvar%arrptr%data (the actual array data)
  GOMP_MAP_ALWAYS_POINTER tvar%arrptr%data  (a pointer to the array data)

This follows OMP 5.0, 2.19.7.1 (or OpenMP 5.2, 5.8.3) "map Clause":

  "If a list item in a map clause is an associated pointer and the
   pointer is not the base pointer of another list item in a map clause
   on the same construct, then it is treated as if its pointer target
   is implicitly mapped in the same clause. For the purposes of the map
   clause, the mapped pointer target is treated as if its base pointer
   is the associated pointer."

However, we can also write this:

  map(to: tvar%arrptr) map(tofrom: tvar%arrptr(3:8))

and then instead we should follow (OpenMP 5.2, 5.8.3 "map Clause"):

  "For map clauses on map-entering constructs, if any list item has a base
   pointer for which a corresponding pointer exists in the data environment
   upon entry to the region and either a new list item or the corresponding
   pointer is created in the device data environment on entry to the region,
   then:
   1. [Fortran] The corresponding pointer variable is associated with
      a pointer target that has the same rank and bounds as the pointer
      target of the original pointer, such that the corresponding list item
      can be accessed through the pointer in a target region.
   2. The corresponding pointer variable becomes an attached pointer
      for the corresponding list item."

But, that's not implemented quite right at the moment (and completely
breaks once we introduce declare mappers), because we still map the "to:
tvar%arrptr" as the descriptor and the entire array, then we map the
"tvar%arrptr(3:8)" part using the descriptor (again!) and the array slice.

The solution is to detect when we're mapping a smaller part of the array
(or a subcomponent) on the same directive, and only map the descriptor
in that case. So we get mappings like this instead:

  map(to: tvar%arrptr)   -->
  GOMP_MAP_ALLOC  tvar%arrptr  (the descriptor)

  map(tofrom: tvar%arrptr(3:8)   -->
  GOMP_MAP_TOFROM tvar%arrptr%data(3) (size 8-3+1, etc.)
  GOMP_MAP_ALWAYS_POINTER tvar%arrptr%data (bias 3, etc.)

This version of the patch builds a hash table separating candidate
clauses for dependency checking by root symbol, to alleviate potential
quadratic behaviour.

2022-09-28  Julian Brown  <julian@codesourcery.com>

gcc/fortran/
	* gfortran.h (gfc_omp_namelist): Add "duplicate_of" field to "u2"
	union.
	* trans-openmp.cc (dependency.h): Include.
	(gfc_trans_omp_array_section): Do not map descriptors here for OpenMP.
	(gfc_symbol_rooted_namelist): New function.
	(gfc_trans_omp_clauses): Check subcomponent and subarray/element
	accesses elsewhere in the clause list for pointers to derived types or
	array descriptors, and map just the pointer/descriptor if we have any.

libgomp/
	* testsuite/libgomp.fortran/map-subarray.f90: New test.
	* testsuite/libgomp.fortran/map-subarray-2.f90: New test.
	* testsuite/libgomp.fortran/map-subarray-3.f90: New test.
	* testsuite/libgomp.fortran/map-subcomponents.f90: New test.
	* testsuite/libgomp.fortran/struct-elem-map-1.f90: Adjust for
	descriptor-mapping changes.
---
 gcc/fortran/gfortran.h                        |   1 +
 gcc/fortran/trans-openmp.cc                   | 209 ++++++++++++++++--
 .../libgomp.fortran/map-subarray-2.f90        | 108 +++++++++
 .../libgomp.fortran/map-subarray-3.f90        |  42 ++++
 .../libgomp.fortran/map-subarray.f90          |  33 +++
 .../libgomp.fortran/map-subcomponents.f90     |  35 +++
 .../libgomp.fortran/struct-elem-map-1.f90     |  10 +-
 7 files changed, 421 insertions(+), 17 deletions(-)
 create mode 100644 libgomp/testsuite/libgomp.fortran/map-subarray-2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/map-subarray-3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/map-subarray.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/map-subcomponents.f90

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4babd77924b..fe8c4e131f3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1358,6 +1358,7 @@ typedef struct gfc_omp_namelist
     {
       struct gfc_omp_namelist_udr *udr;
       gfc_namespace *ns;
+      struct gfc_omp_namelist *duplicate_of;
     } u2;
   struct gfc_omp_namelist *next;
   locus where;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 8e9d5346b05..987810bb3d4 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -40,6 +40,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "omp-general.h"
 #include "omp-low.h"
 #include "memmodel.h"  /* For MEMMODEL_ enums.  */
+#include "dependency.h"
 
 #undef GCC_DIAG_STYLE
 #define GCC_DIAG_STYLE __gcc_tdiag__
@@ -2470,22 +2471,20 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
     }
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
     {
-      tree desc_node;
       tree type = TREE_TYPE (decl);
       ptr2 = gfc_conv_descriptor_data_get (decl);
-      desc_node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
-      OMP_CLAUSE_DECL (desc_node) = decl;
-      OMP_CLAUSE_SIZE (desc_node) = TYPE_SIZE_UNIT (type);
-      if (ptr_kind == GOMP_MAP_ALWAYS_POINTER)
+      if (ptr_kind != GOMP_MAP_ALWAYS_POINTER)
 	{
-	  OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO);
-	  node2 = node;
-	  node = desc_node;  /* Needs to come first.  */
-	}
-      else
-	{
-	  OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO_PSET);
-	  node2 = desc_node;
+	  /* We only create a GOMP_MAP_TO_PSET mapping for derived-type
+	     members here for OpenACC.
+	     For OpenMP, the descriptor must be mapped with its own explicit
+	     map clause (e.g. both "map(foo%arr)" and "map(foo%arr(:))" must
+	     be present in the clause list if "foo%arr" is a pointer to an
+	     array).  */
+	  node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+	  OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
+	  OMP_CLAUSE_DECL (node2) = decl;
+	  OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
 	}
       node3 = build_omp_clause (input_location,
 				OMP_CLAUSE_MAP);
@@ -2592,6 +2591,74 @@ handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
   return list;
 }
 
+/* To alleviate quadratic behaviour in checking each entry of a
+   gfc_omp_namelist against every other entry, we build a hashtable indexed by
+   gfc_symbol pointer, which we can use in the (overwhelmingly common) case
+   that a map expression has a symbol as its root term.  Return a namelist
+   based on the root symbol used by N, building a new table in SYM_ROOTED_NL
+   using the gfc_omp_namelist N2 (all clauses) if we haven't done so
+   already.  */
+
+static gfc_omp_namelist *
+get_symbol_rooted_namelist (hash_map<gfc_symbol *,
+				     gfc_omp_namelist *> *&sym_rooted_nl,
+			    gfc_omp_namelist *n,
+			    gfc_omp_namelist *n2, bool *sym_based)
+{
+  /* Early-out if we have a NULL clause list (e.g. for OpenACC).  */
+  if (!n2)
+    return NULL;
+
+  gfc_symbol *use_sym = NULL;
+
+  /* We're only interested in cases where we have an expression, e.g. a
+     component access.  */
+  if (n->expr && n->expr->expr_type == EXPR_VARIABLE && n->expr->symtree)
+    use_sym = n->expr->symtree->n.sym;
+
+  *sym_based = false;
+
+  if (!use_sym)
+    return n2;
+
+  if (!sym_rooted_nl)
+    {
+      sym_rooted_nl = new hash_map<gfc_symbol *, gfc_omp_namelist *> ();
+
+      for (; n2 != NULL; n2 = n2->next)
+	{
+	  if (!n2->expr
+	      || n2->expr->expr_type != EXPR_VARIABLE
+	      || !n2->expr->symtree)
+	    continue;
+
+	  gfc_omp_namelist *nl_copy = gfc_get_omp_namelist ();
+	  memcpy (nl_copy, n2, sizeof *nl_copy);
+	  nl_copy->u2.duplicate_of = n2;
+	  nl_copy->next = NULL;
+
+	  gfc_symbol *idx_sym = n2->expr->symtree->n.sym;
+
+	  bool existed;
+	  gfc_omp_namelist *&entry
+	    = sym_rooted_nl->get_or_insert (idx_sym, &existed);
+	  if (existed)
+	    nl_copy->next = entry;
+	  entry = nl_copy;
+	}
+    }
+
+  gfc_omp_namelist **n2_sym = sym_rooted_nl->get (use_sym);
+
+  if (n2_sym)
+    {
+      *sym_based = true;
+      return *n2_sym;
+    }
+
+  return NULL;
+}
+
 static tree
 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		       locus where, bool declare_simd = false,
@@ -2609,6 +2676,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
   if (clauses == NULL)
     return NULL_TREE;
 
+  hash_map<gfc_symbol *, gfc_omp_namelist *> *sym_rooted_nl = NULL;
+
   for (list = 0; list < OMP_LIST_NUM; list++)
     {
       gfc_omp_namelist *n = clauses->lists[list];
@@ -3448,6 +3517,56 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      if (pointer || (openacc && allocatable))
 			{
+			  gfc_omp_namelist *n2
+			    = openacc ? NULL : clauses->lists[OMP_LIST_MAP];
+
+			  bool sym_based;
+			  n2 = get_symbol_rooted_namelist (sym_rooted_nl, n,
+							   n2, &sym_based);
+
+			  /* If the last reference is a pointer to a derived
+			     type ("foo%dt_ptr"), check if any subcomponents
+			     of the same derived type member are being mapped
+			     elsewhere in the clause list ("foo%dt_ptr%x",
+			     etc.).  If we have such subcomponent mappings,
+			     we only create an ALLOC node for the pointer
+			     itself, and inhibit mapping the whole derived
+			     type.  */
+
+			  for (; n2 != NULL; n2 = n2->next)
+			    {
+			      if ((!sym_based && n == n2)
+				  || (sym_based && n == n2->u2.duplicate_of)
+				  || !n2->expr)
+				continue;
+
+			      int dep
+				= gfc_dep_resolver (n->expr->ref, n2->expr->ref,
+						    NULL, true);
+			      if (dep == 0)
+				continue;
+
+			      gfc_ref *ref1 = n->expr->ref;
+			      gfc_ref *ref2 = n2->expr->ref;
+
+			      while (ref1->next && ref2->next)
+				{
+				  ref1 = ref1->next;
+				  ref2 = ref2->next;
+				}
+
+			      if (ref2->next)
+				{
+				  inner = build_fold_addr_expr (inner);
+				  OMP_CLAUSE_SET_MAP_KIND (node,
+							   GOMP_MAP_ALLOC);
+				  OMP_CLAUSE_DECL (node) = inner;
+				  OMP_CLAUSE_SIZE (node)
+				    = TYPE_SIZE_UNIT (TREE_TYPE (inner));
+				  goto finalize_map_clause;
+				}
+			    }
+
 			  tree data, size;
 
 			  if (lastref->u.c.component->ts.type == BT_CLASS)
@@ -3549,8 +3668,55 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    node2 = desc_node;
 			  else
 			    {
+			      gfc_omp_namelist *n2
+				= clauses->lists[OMP_LIST_MAP];
 			      node2 = node;
 			      node = desc_node;  /* Put first.  */
+
+			      bool sym_based;
+			      n2 = get_symbol_rooted_namelist (sym_rooted_nl,
+							       n, n2,
+							       &sym_based);
+
+			      for (; n2 != NULL; n2 = n2->next)
+				{
+				  if ((!sym_based && n == n2)
+				      || (sym_based && n == n2->u2.duplicate_of)
+				      || !n2->expr)
+				    continue;
+
+				  int dep
+				    = gfc_dep_resolver (n->expr->ref,
+							n2->expr->ref,
+							NULL, true);
+				  if (dep == 0)
+				    continue;
+
+				  gfc_ref *ref1 = n->expr->ref;
+				  gfc_ref *ref2 = n2->expr->ref;
+
+				  /* We know ref1 and ref2 overlap.  We're
+				     interested in whether ref2 describes a
+				     smaller part of the array than ref1, which
+				     we already know refers to the full
+				     array.  */
+
+				  while (ref1->next && ref2->next)
+				    {
+				      ref1 = ref1->next;
+				      ref2 = ref2->next;
+				    }
+
+				  if (ref2->next
+				      || (ref2->type == REF_ARRAY
+					  && (ref2->u.ar.type == AR_ELEMENT
+					      || (ref2->u.ar.type
+						  == AR_SECTION))))
+				    {
+				      node2 = NULL_TREE;
+				      goto finalize_map_clause;
+				    }
+				}
 			    }
 			  node3 = build_omp_clause (input_location,
 						    OMP_CLAUSE_MAP);
@@ -3702,6 +3868,23 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	}
     }
 
+  /* Free hashmap if we built it.  */
+  if (sym_rooted_nl)
+    {
+      typedef hash_map<gfc_symbol *, gfc_omp_namelist *>::iterator hti;
+      for (hti it = sym_rooted_nl->begin (); it != sym_rooted_nl->end (); ++it)
+	{
+	  gfc_omp_namelist *&nl = (*it).second;
+	  while (nl)
+	    {
+	      gfc_omp_namelist *next = nl->next;
+	      free (nl);
+	      nl = next;
+	    }
+	}
+      delete sym_rooted_nl;
+    }
+
   if (clauses->if_expr)
     {
       tree if_var;
diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray-2.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray-2.f90
new file mode 100644
index 00000000000..02f08c52a8c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-subarray-2.f90
@@ -0,0 +1,108 @@
+! { dg-do run }
+
+program myprog
+type u
+  integer, dimension (:), pointer :: tarr1
+  integer, dimension (:), pointer :: tarr2
+  integer, dimension (:), pointer :: tarr3
+end type u
+
+type(u) :: myu1, myu2, myu3
+
+integer, dimension (12), target :: myarray1
+integer, dimension (12), target :: myarray2
+integer, dimension (12), target :: myarray3
+integer, dimension (12), target :: myarray4
+integer, dimension (12), target :: myarray5
+integer, dimension (12), target :: myarray6
+integer, dimension (12), target :: myarray7
+integer, dimension (12), target :: myarray8
+integer, dimension (12), target :: myarray9
+
+myu1%tarr1 => myarray1
+myu1%tarr2 => myarray2
+myu1%tarr3 => myarray3
+myu2%tarr1 => myarray4
+myu2%tarr2 => myarray5
+myu2%tarr3 => myarray6
+myu3%tarr1 => myarray7
+myu3%tarr2 => myarray8
+myu3%tarr3 => myarray9
+
+myu1%tarr1 = 0
+myu1%tarr2 = 0
+myu1%tarr3 = 0
+myu2%tarr1 = 0
+myu2%tarr2 = 0
+myu2%tarr3 = 0
+myu3%tarr1 = 0
+myu3%tarr2 = 0
+myu3%tarr3 = 0
+
+!$omp target map(to:myu1%tarr1) map(tofrom:myu1%tarr1(:)) &
+!$omp&       map(to:myu1%tarr2) map(tofrom:myu1%tarr2(:)) &
+!$omp&       map(to:myu1%tarr3) map(tofrom:myu1%tarr3(:)) &
+!$omp&       map(to:myu2%tarr1) map(tofrom:myu2%tarr1(:)) &
+!$omp&       map(to:myu2%tarr2) map(tofrom:myu2%tarr2(:)) &
+!$omp&       map(to:myu2%tarr3) map(tofrom:myu2%tarr3(:)) &
+!$omp&       map(to:myu3%tarr1) map(tofrom:myu3%tarr1(:)) &
+!$omp&       map(to:myu3%tarr2) map(tofrom:myu3%tarr2(:)) &
+!$omp&       map(to:myu3%tarr3) map(tofrom:myu3%tarr3(:))
+myu1%tarr1(1) = myu1%tarr1(1) + 1
+myu2%tarr1(1) = myu2%tarr1(1) + 1
+myu3%tarr1(1) = myu3%tarr1(1) + 1
+!$omp end target
+
+!$omp target map(to:myu1%tarr1) map(tofrom:myu1%tarr1(1:2)) &
+!$omp&       map(to:myu1%tarr2) map(tofrom:myu1%tarr2(1:2)) &
+!$omp&       map(to:myu1%tarr3) map(tofrom:myu1%tarr3(1:2)) &
+!$omp&       map(to:myu2%tarr1) map(tofrom:myu2%tarr1(1:2)) &
+!$omp&       map(to:myu2%tarr2) map(tofrom:myu2%tarr2(1:2)) &
+!$omp&       map(to:myu2%tarr3) map(tofrom:myu2%tarr3(1:2)) &
+!$omp&       map(to:myu3%tarr1) map(tofrom:myu3%tarr1(1:2)) &
+!$omp&       map(to:myu3%tarr2) map(tofrom:myu3%tarr2(1:2)) &
+!$omp&       map(to:myu3%tarr3) map(tofrom:myu3%tarr3(1:2))
+myu1%tarr2(1) = myu1%tarr2(1) + 1
+myu2%tarr2(1) = myu2%tarr2(1) + 1
+myu3%tarr2(1) = myu3%tarr2(1) + 1
+!$omp end target
+
+!$omp target map(to:myu1%tarr1) map(tofrom:myu1%tarr1(1)) &
+!$omp&       map(to:myu1%tarr2) map(tofrom:myu1%tarr2(1)) &
+!$omp&       map(to:myu1%tarr3) map(tofrom:myu1%tarr3(1)) &
+!$omp&       map(to:myu2%tarr1) map(tofrom:myu2%tarr1(1)) &
+!$omp&       map(to:myu2%tarr2) map(tofrom:myu2%tarr2(1)) &
+!$omp&       map(to:myu2%tarr3) map(tofrom:myu2%tarr3(1)) &
+!$omp&       map(to:myu3%tarr1) map(tofrom:myu3%tarr1(1)) &
+!$omp&       map(to:myu3%tarr2) map(tofrom:myu3%tarr2(1)) &
+!$omp&       map(to:myu3%tarr3) map(tofrom:myu3%tarr3(1))
+myu1%tarr3(1) = myu1%tarr3(1) + 1
+myu2%tarr3(1) = myu2%tarr3(1) + 1
+myu3%tarr3(1) = myu3%tarr3(1) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu1%tarr1) &
+!$omp&       map(tofrom:myu1%tarr2) &
+!$omp&       map(tofrom:myu1%tarr3) &
+!$omp&       map(tofrom:myu2%tarr1) &
+!$omp&       map(tofrom:myu2%tarr2) &
+!$omp&       map(tofrom:myu2%tarr3) &
+!$omp&       map(tofrom:myu3%tarr1) &
+!$omp&       map(tofrom:myu3%tarr2) &
+!$omp&       map(tofrom:myu3%tarr3)
+myu1%tarr2(1) = myu1%tarr2(1) + 1
+myu2%tarr2(1) = myu2%tarr2(1) + 1
+myu3%tarr2(1) = myu3%tarr2(1) + 1
+!$omp end target
+
+if (myu1%tarr1(1).ne.1) stop 1
+if (myu2%tarr1(1).ne.1) stop 2
+if (myu3%tarr1(1).ne.1) stop 3
+if (myu1%tarr2(1).ne.2) stop 4
+if (myu2%tarr2(1).ne.2) stop 5
+if (myu3%tarr2(1).ne.2) stop 6
+if (myu1%tarr3(1).ne.1) stop 7
+if (myu2%tarr3(1).ne.1) stop 8
+if (myu3%tarr3(1).ne.1) stop 9
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray-3.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray-3.f90
new file mode 100644
index 00000000000..9198bec1cae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-subarray-3.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+
+module mymod
+type G
+integer :: x, y
+integer, pointer :: arr(:)
+integer :: z
+end type G
+end module mymod
+
+program myprog
+use mymod
+
+integer, target :: arr1(10)
+integer, target :: arr2(10)
+integer, target :: arr3(10)
+type(G), dimension(3) :: gvar
+
+integer :: i, j
+
+gvar(1)%arr => arr1
+gvar(2)%arr => arr2
+gvar(3)%arr => arr3
+
+gvar(1)%arr = 0
+gvar(2)%arr = 0 
+gvar(3)%arr = 0
+
+i = 1
+j = 1
+
+!$omp target map(gvar(i)%arr, gvar(j)%arr(1:5))
+gvar(i)%arr(1) = gvar(i)%arr(1) + 1
+gvar(j)%arr(1) = gvar(j)%arr(1) + 2
+!$omp end target
+
+if (gvar(i)%arr(1).ne.3) stop 1
+
+end program myprog
+
+! This is fixed by the address inspector/address tokenization patch.
+! { dg-xfail-run-if TODO { offload_device_nonshared_as } }
diff --git a/libgomp/testsuite/libgomp.fortran/map-subarray.f90 b/libgomp/testsuite/libgomp.fortran/map-subarray.f90
new file mode 100644
index 00000000000..85f5af3a2a6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-subarray.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program myprog
+type u
+  integer, dimension (:), pointer :: tarr
+end type u
+
+type(u) :: myu
+integer, dimension (12), target :: myarray
+
+myu%tarr => myarray
+
+myu%tarr = 0
+
+!$omp target map(to:myu%tarr) map(tofrom:myu%tarr(:))
+myu%tarr(1) = myu%tarr(1) + 1
+!$omp end target
+
+!$omp target map(to:myu%tarr) map(tofrom:myu%tarr(1:2))
+myu%tarr(1) = myu%tarr(1) + 1
+!$omp end target
+
+!$omp target map(to:myu%tarr) map(tofrom:myu%tarr(1))
+myu%tarr(1) = myu%tarr(1) + 1
+!$omp end target
+
+!$omp target map(tofrom:myu%tarr)
+myu%tarr(1) = myu%tarr(1) + 1
+!$omp end target
+
+if (myu%tarr(1).ne.4) stop 1
+
+end program myprog
diff --git a/libgomp/testsuite/libgomp.fortran/map-subcomponents.f90 b/libgomp/testsuite/libgomp.fortran/map-subcomponents.f90
new file mode 100644
index 00000000000..4074a952dd1
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-subcomponents.f90
@@ -0,0 +1,35 @@
+! { dg-do run }
+
+module mymod
+type F
+integer :: a, b, c
+integer, dimension(10) :: d
+end type F
+
+type G
+integer :: x, y
+type(F), pointer :: myf
+integer :: z
+end type G
+end module mymod
+
+program myprog
+use mymod
+
+type(F), target :: ftmp
+type(G) :: gvar
+
+gvar%myf => ftmp
+
+gvar%myf%d = 0
+
+!$omp target map(to:gvar%myf) map(tofrom: gvar%myf%b, gvar%myf%d)
+gvar%myf%d(1) = gvar%myf%d(1) + 1
+!$omp end target
+
+if (gvar%myf%d(1).ne.1) stop 1
+
+end program myprog
+
+! This is fixed by the address inspector/address tokenization patch.
+! { dg-xfail-run-if TODO { offload_device_nonshared_as } }
diff --git a/libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90 b/libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90
index 58550c79d69..f128ebcffc1 100644
--- a/libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90
+++ b/libgomp/testsuite/libgomp.fortran/struct-elem-map-1.f90
@@ -229,7 +229,8 @@ contains
 
 !   !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3)) &
 !   !$omp&       map(tofrom: var%str4(2:2), var%uni2(2:3), var%uni4(2:2))
-    !$omp target map(tofrom: var%d(4:7), var%f(2:3), var%str2(2:3), var%uni2(2:3))
+    !$omp target map(to: var%f) map(tofrom: var%d(4:7), var%f(2:3), &
+    !$omp&       var%str2(2:3), var%uni2(2:3))
       if (any (var%d(4:7) /= [(-3*i, i = 4, 7)])) stop 4
       if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
 
@@ -274,7 +275,7 @@ contains
       if (any (var%str2(2:3) /= ["67890", "ABCDE"])) stop 6
     !$omp end target
 
-    !$omp target map(tofrom: var%f(2:3))
+    !$omp target map(to: var%f) map(tofrom: var%f(2:3))
      if (.not. associated (var%f)) stop 9
      if (size (var%f) /= 4) stop 10
      if (any (var%f(2:3) /= [33, 44])) stop 11
@@ -314,7 +315,8 @@ contains
 
 !   !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), &
 !   !$omp                    var%str4(2), var%uni2(3), var%uni4(2))
-    !$omp target map(tofrom: var%d(5), var%f(3), var%str2(3), var%uni2(3))
+    !$omp target map(to: var%f) map(tofrom: var%d(5), var%f(3), &
+    !$omp&                                  var%str2(3), var%uni2(3))
       if (var%d(5) /= -3*5) stop 4
       if (var%str2(3) /= "ABCDE") stop 6
       if (var%uni2(3) /= 4_"ABCDE") stop 7
@@ -362,7 +364,7 @@ contains
       if (any (var%uni2(2:3) /= [4_"67890", 4_"ABCDE"])) stop 7
     !$omp end target
 
-    !$omp target map(tofrom: var%f(2:3))
+    !$omp target map(to: var%f) map(tofrom: var%f(2:3))
      if (.not. associated (var%f)) stop 9
      if (size (var%f) /= 4) stop 10
      if (any (var%f(2:3) /= [33, 44])) stop 11
-- 
2.29.2


  reply	other threads:[~2022-09-30 13:30 UTC|newest]

Thread overview: 36+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2022-09-13 21:01 [PATCH v3 00/11] OpenMP 5.0: Struct & mapping clause expansion rework Julian Brown
2022-09-13 21:01 ` [PATCH v3 01/11] OpenMP 5.0: Clause ordering for OpenMP 5.0 (topological sorting by base pointer) Julian Brown
2022-09-14 10:34   ` Jakub Jelinek
2022-09-13 21:01 ` [PATCH v3 02/11] Remove omp_target_reorder_clauses Julian Brown
2022-09-14 10:35   ` Jakub Jelinek
2022-09-13 21:01 ` [PATCH v3 03/11] OpenMP/OpenACC struct sibling list gimplification extension and rework Julian Brown
2022-09-14 11:21   ` Jakub Jelinek
2022-09-13 21:01 ` [PATCH v3 04/11] OpenMP/OpenACC: mapping group list-handling improvements Julian Brown
2022-09-14 11:30   ` Jakub Jelinek
2022-09-13 21:03 ` [PATCH v3 05/11] OpenMP: push attaches to end of clause list in "target" regions Julian Brown
2022-09-14 12:44   ` Jakub Jelinek
2022-09-18 19:10     ` Julian Brown
2022-09-18 19:18       ` Jakub Jelinek
2022-09-13 21:03 ` [PATCH v3 06/11] OpenMP: Pointers and member mappings Julian Brown
2022-09-14 12:53   ` Jakub Jelinek
2022-09-18 19:19     ` Julian Brown
2022-09-22 13:17       ` Jakub Jelinek
2022-09-23  7:29         ` Julian Brown
2022-09-23  9:38           ` Jakub Jelinek
2022-09-23 12:10           ` Tobias Burnus
2022-09-30 13:30             ` Julian Brown [this message]
2022-09-30 14:42               ` Tobias Burnus
2022-09-30 15:01               ` Tobias Burnus
2022-09-13 21:03 ` [PATCH v3 07/11] OpenMP/OpenACC: Reindent TO/FROM/_CACHE_ stanza in {c_}finish_omp_clause Julian Brown
2022-09-14 13:06   ` Jakub Jelinek
2022-09-13 21:03 ` [PATCH v3 08/11] OpenMP/OpenACC: Rework clause expansion and nested struct handling Julian Brown
2022-09-14 13:24   ` Jakub Jelinek
2022-09-14 13:59     ` Julian Brown
2022-09-19 19:40     ` Julian Brown
2022-09-22 13:20       ` Jakub Jelinek
2022-09-13 21:03 ` [PATCH v3 09/11] FYI/unfinished: OpenMP: lvalue parsing for map clauses (C++) Julian Brown
2022-09-13 21:04 ` [PATCH v3 10/11] Use OMP_ARRAY_SECTION instead of TREE_LIST in C++ FE Julian Brown
2022-09-13 21:04 ` [PATCH v3 11/11] FYI/unfinished: OpenMP 5.0 "declare mapper" support for C++ Julian Brown
2022-09-14  6:30   ` FYI: "declare mapper" patch set for Fortran (June 2022) (was: [PATCH v3 11/11] FYI/unfinished: OpenMP 5.0 "declare mapper" support for C++) Tobias Burnus
2022-09-14 14:58   ` [PATCH v3 11/11] FYI/unfinished: OpenMP 5.0 "declare mapper" support for C++ Jakub Jelinek
2022-09-14 16:32     ` Julian Brown

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=20220930143022.1cc80cbd@squid.athome \
    --to=julian@codesourcery.com \
    --cc=cltang@codesourcery.com \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=jakub@redhat.com \
    --cc=tobias@codesourcery.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).