diff mbox series

[3/4] openacc: Fix lowering for derived-type mappings through array elements

Message ID f241fee91966a99f6513ea2cd3dada9c22a9de7a.1612271846.git.julian@codesourcery.com
State New
Headers show
Series openacc: Mixing array elements and derived types | expand

Commit Message

Julian Brown Feb. 2, 2021, 1:28 p.m. UTC 
This patch fixes lowering of derived-type mappings which select elements
of arrays of derived types, and similar. These would previously lead
to ICEs.

With this change, update directives and enter/exit data directives can
pass through constructs that are no longer recognized by the gimplifier,
hence alterations are needed there also.

Tested with offloading to AMD GCN. OK for mainline?

Thanks,

Julian

2020-02-02  Julian Brown  <julian@codesourcery.com>

gcc/fortran/
	* trans-openmp.c (gfc_trans_omp_clauses): Handle element selection for
	arrays of derived types.

gcc/
	* gimplify.c (gimplify_scan_omp_clauses): Handle ATTACH_DETACH for
	non-decls.

gcc/testsuite/
	* gfortran.dg/goacc/array-with-dt-1.f90: New test.
	* gfortran.dg/goacc/array-with-dt-3.f90: Likewise.
	* gfortran.dg/goacc/array-with-dt-4.f90: Likewise.
	* gfortran.dg/goacc/array-with-dt-5.f90: Likewise.
	* gfortran.dg/goacc/derived-classtypes-1.f95: Uncomment
	previously-broken directives.

libgomp/
	* testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90: New test.
	* testsuite/libgomp.oacc-fortran/update-dt-array.f90: Likewise.
---
 gcc/fortran/trans-openmp.c                    | 192 ++++++++++--------
 gcc/gimplify.c                                |  12 ++
 .../gfortran.dg/goacc/array-with-dt-1.f90     |  11 +
 .../gfortran.dg/goacc/array-with-dt-3.f90     |  14 ++
 .../gfortran.dg/goacc/array-with-dt-4.f90     |  18 ++
 .../gfortran.dg/goacc/array-with-dt-5.f90     |  12 ++
 ...sstypes-1.f95 => derived-classtypes-1.f90} |   8 +-
 .../derivedtypes-arrays-1.f90                 | 109 ++++++++++
 .../libgomp.oacc-fortran/update-dt-array.f90  |  53 +++++
 9 files changed, 344 insertions(+), 85 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
 rename gcc/testsuite/gfortran.dg/goacc/{derived-classtypes-1.f95 => derived-classtypes-1.f90} (95%)
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90

Comments

Tobias Burnus Feb. 5, 2021, 4:25 p.m. UTC | #1 
(CC fortran@)

Hi Julian,

not doing an extensive review yet, but the following gives an ICE
with this patch applied. (I believe the others are already in, aren't they?)

type t
  integer :: i, j
end type t
type t2
  type(t) :: b(4)
end type
type(t2) :: var(10)
!$acc update host(var(3)%b(:)%j)
!$acc update host(var(3)%b%j)
end

That's a noncontiguous array – which is permitted for 'update'
and it gives an ICE via:

0x9b0c59 gfc_conv_scalarized_array_ref
         ../../repos/gcc/gcc/fortran/trans-array.c:3570
0x9b2134 gfc_conv_array_ref(gfc_se*, gfc_array_ref*, gfc_expr*, locus*)
         ../../repos/gcc/gcc/fortran/trans-array.c:3721
0x9e9cc6 gfc_conv_variable
         ../../repos/gcc/gcc/fortran/trans-expr.c:2998
0xa22682 gfc_trans_omp_clauses
         ../../repos/gcc/gcc/fortran/trans-openmp.c:2963

  * * *

> +           bool allocatable = false, pointer = false;
> +
> +           if (lastref && lastref->type == REF_COMPONENT)
> +             {
> +               gfc_component *c = lastref->u.c.component;
> +
> +               if (c->ts.type == BT_CLASS)
> +                 {
> +                   pointer = CLASS_DATA (c)->attr.class_pointer;
> +                   allocatable = CLASS_DATA (c)->attr.allocatable;
> +                 }
> +               else
> +                 {
> +                   pointer = c->attr.pointer;
> +                   allocatable = c->attr.allocatable;
> +                 }
> +             }
> +

I am not sure how the rest will change, but I was wondering
whether the following helps. I see that 'lastref' is used
elsewhere – hence, I am not sure whether it is indeed better.

symbol_attribute attr = {};
if (n->expr)
   attr = gfc_expr_attr (n->expr);

(Not really looked at the rest before wondering whether
my testcase above is handled – which isn't.)

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
Julian Brown Feb. 6, 2021, 10:49 a.m. UTC | #2 
On Fri, 5 Feb 2021 17:25:10 +0100
Tobias Burnus <tobias@codesourcery.com> wrote:

> (CC fortran@)
> 
> Hi Julian,
> 
> not doing an extensive review yet, but the following gives an ICE
> with this patch applied. (I believe the others are already in, aren't
> they?)
> 
> type t
>   integer :: i, j
> end type t
> type t2
>   type(t) :: b(4)
> end type
> type(t2) :: var(10)
> !$acc update host(var(3)%b(:)%j)
> !$acc update host(var(3)%b%j)
> end
> 
> That's a noncontiguous array – which is permitted for 'update'
> and it gives an ICE via:
> 
> 0x9b0c59 gfc_conv_scalarized_array_ref
>          ../../repos/gcc/gcc/fortran/trans-array.c:3570
> 0x9b2134 gfc_conv_array_ref(gfc_se*, gfc_array_ref*, gfc_expr*,
> locus*) ../../repos/gcc/gcc/fortran/trans-array.c:3721
> 0x9e9cc6 gfc_conv_variable
>          ../../repos/gcc/gcc/fortran/trans-expr.c:2998
> 0xa22682 gfc_trans_omp_clauses
>          ../../repos/gcc/gcc/fortran/trans-openmp.c:2963

I think the attached patch fixes that. (This could be merged into the
parent patch or kept separate, not sure which is better.)

Re-tested with offloading to AMD GCN. OK?

> > +	      bool allocatable = false, pointer = false;
> > +
> > +	      if (lastref && lastref->type == REF_COMPONENT)
> > +		{
> > +		  gfc_component *c = lastref->u.c.component;
> > +
> > +		  if (c->ts.type == BT_CLASS)
> > +		    {
> > +		      pointer = CLASS_DATA (c)->attr.class_pointer;
> > +		      allocatable = CLASS_DATA
> > (c)->attr.allocatable;
> > +		    }
> > +		  else
> > +		    {
> > +		      pointer = c->attr.pointer;
> > +		      allocatable = c->attr.allocatable;
> > +		    }
> > +		}
> > +  
> 
> I am not sure how the rest will change, but I was wondering
> whether the following helps. I see that 'lastref' is used
> elsewhere – hence, I am not sure whether it is indeed better.
>   
> symbol_attribute attr = {};
> if (n->expr)
>    attr = gfc_expr_attr (n->expr);

Ah, I didn't know about that one! But yeah, not sure if it's better
here.

Thanks for (pre-)review!

Julian
Tobias Burnus Feb. 8, 2021, 3 p.m. UTC | #3 
On 06.02.21 11:49, Julian Brown wrote:

>             if (n->expr)
>               for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
> -               if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
> +               if (ref->type == REF_COMPONENT)
>                   lastref = ref;
> +               else if (ref->type == REF_ARRAY)

This one fails to build:

../../repos/gcc/gcc/fortran/trans-openmp.c: In function ‘tree_node* gfc_trans_omp_clauses(stmtblock_t*, gfc_omp_clauses*, locus, bool, bool)’:
../../repos/gcc/gcc/fortran/trans-openmp.c:2681:18: error: suggest explicit braces to avoid ambiguous ‘else’ [-Werror=dangling-else]
  2681 |               if (n->expr)
       |                  ^


Previous patch in this 3/4 thread:
> + && !lastref->u.c.component->attr.dimension) + { + /* Derived type
> access with last component being a scalar. */

I was wondering whether that causes any issues with local access to coarrays,
but that seems to work (compile with -fcoarray=single or -fcoarray=lib -lcaf_single);
I have not check the dump whether it indeed works.

(The interesting case is -fcoarray=lib; all those accesses go
to the local variable – remote access (like A[image_idx]) is
correctly rejected with 'List item shall not be coindexed'
or with a parse error.)

implicit none
type t2
   integer :: x, y
end type t2
type t
   type(t2), allocatable :: B[:], BB(:)[:]
end type t
type(t) :: var
type(t2), allocatable :: A[:], AA(:)[:]
type(t2) :: C[*], CC(10)[*]

!$acc update self(var%B, var%BB)
!$acc update self(var%BB(1))
!$acc update self(var%B%x)
!$acc update self(var%BB%x)
!$acc update self(var%BB(1)%x)
!$acc update self(A, AA)
!$acc update self(AA(1))
!$acc update self(A%x, AA%y)
!$acc update self(AA(1)%y)
!$acc update self(C, CC)
!$acc update self(CC(1))
!$acc update self(C%x, CC%y)
!$acc update self(CC(1)%y)
end


> else - sorry ("unhandled derived-type component"); + sorry ("unhandled
> expression type");

Nit: That's not an expression type but a reference type. Remaining
are: REF_SUBSTRING and REF_INQUIRY. I wonder whether that should be 'gcc_unreachable' or 'internal_error'
but 'sorry' does not make sense. I think that message occurs twice.
Otherwise, it looks good to me. Tobias PS: I have a follow-up patch
related to %re/%im or %kind, to be submitted later today.


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
diff mbox series

Patch

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 7be34ef9a35..0ab08dabe9a 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2675,6 +2675,32 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      tree decl = gfc_trans_omp_variable (n->sym, false);
 	      if (DECL_P (decl))
 		TREE_ADDRESSABLE (decl) = 1;
+
+	      gfc_ref *lastref = NULL;
+
+	      if (n->expr)
+		for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
+		  if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
+		    lastref = ref;
+
+	      bool allocatable = false, pointer = false;
+
+	      if (lastref && lastref->type == REF_COMPONENT)
+		{
+		  gfc_component *c = lastref->u.c.component;
+
+		  if (c->ts.type == BT_CLASS)
+		    {
+		      pointer = CLASS_DATA (c)->attr.class_pointer;
+		      allocatable = CLASS_DATA (c)->attr.allocatable;
+		    }
+		  else
+		    {
+		      pointer = c->attr.pointer;
+		      allocatable = c->attr.allocatable;
+		    }
+		}
+
 	      if (n->expr == NULL
 		  || (n->expr->ref->type == REF_ARRAY
 		      && n->expr->ref->u.ar.type == AR_FULL))
@@ -2911,74 +2937,79 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		}
 	      else if (n->expr
 		       && n->expr->expr_type == EXPR_VARIABLE
-		       && n->expr->ref->type == REF_COMPONENT)
+		       && n->expr->ref->type == REF_ARRAY
+		       && !n->expr->ref->next)
 		{
-		  gfc_ref *lastcomp;
-
-		  for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
-		    if (ref->type == REF_COMPONENT)
-		      lastcomp = ref;
-
-		  symbol_attribute sym_attr;
-
-		  if (lastcomp->u.c.component->ts.type == BT_CLASS)
-		    sym_attr = CLASS_DATA (lastcomp->u.c.component)->attr;
-		  else
-		    sym_attr = lastcomp->u.c.component->attr;
-
+		  /* An array element or array section which is not part of a
+		     derived type, etc.  */
+		  bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
+		  gfc_trans_omp_array_section (block, n, decl, element,
+					       GOMP_MAP_POINTER, node, node2,
+					       node3, node4);
+		}
+	      else if (n->expr
+		       && n->expr->expr_type == EXPR_VARIABLE
+		       && (n->expr->ref->type == REF_COMPONENT
+			   || n->expr->ref->type == REF_ARRAY)
+		       && lastref
+		       && lastref->type == REF_COMPONENT
+		       && lastref->u.c.component->ts.type != BT_CLASS
+		       && lastref->u.c.component->ts.type != BT_DERIVED
+		       && !lastref->u.c.component->attr.dimension)
+		{
+		  /* Derived type access with last component being a scalar.  */
 		  gfc_init_se (&se, NULL);
 
-		  if (!sym_attr.dimension
-		      && lastcomp->u.c.component->ts.type != BT_CLASS
-		      && lastcomp->u.c.component->ts.type != BT_DERIVED)
+		  gfc_conv_expr (&se, n->expr);
+		  gfc_add_block_to_block (block, &se.pre);
+		  /* For BT_CHARACTER a pointer is returned.  */
+		  OMP_CLAUSE_DECL (node)
+		    = POINTER_TYPE_P (TREE_TYPE (se.expr))
+		      ? build_fold_indirect_ref (se.expr) : se.expr;
+		  gfc_add_block_to_block (block, &se.post);
+		  if (pointer || allocatable)
 		    {
-		      /* Last component is a scalar.  */
-		      gfc_conv_expr (&se, n->expr);
-		      gfc_add_block_to_block (block, &se.pre);
-		      /* For BT_CHARACTER a pointer is returned.  */
-		      OMP_CLAUSE_DECL (node)
+		      node2 = build_omp_clause (input_location,
+						OMP_CLAUSE_MAP);
+		      gomp_map_kind kind
+			= (openacc ? GOMP_MAP_ATTACH_DETACH
+				   : GOMP_MAP_ALWAYS_POINTER);
+		      OMP_CLAUSE_SET_MAP_KIND (node2, kind);
+		      OMP_CLAUSE_DECL (node2)
 			= POINTER_TYPE_P (TREE_TYPE (se.expr))
-			  ? build_fold_indirect_ref (se.expr) : se.expr;
-		      gfc_add_block_to_block (block, &se.post);
-		      if (sym_attr.pointer || sym_attr.allocatable)
+			  ? se.expr
+			  : gfc_build_addr_expr (NULL, se.expr);
+		      OMP_CLAUSE_SIZE (node2) = size_int (0);
+		      if (!openacc
+			  && n->expr->ts.type == BT_CHARACTER
+			  && n->expr->ts.deferred)
 			{
-			  node2 = build_omp_clause (input_location,
+			  gcc_assert (se.string_length);
+			  tree tmp
+			    = gfc_get_char_type (n->expr->ts.kind);
+			  OMP_CLAUSE_SIZE (node)
+			    = fold_build2 (MULT_EXPR, size_type_node,
+					   fold_convert (size_type_node,
+					       se.string_length),
+					   TYPE_SIZE_UNIT (tmp));
+			  node3 = build_omp_clause (input_location,
 						    OMP_CLAUSE_MAP);
-			  OMP_CLAUSE_SET_MAP_KIND (node2,
-						   openacc
-						   ? GOMP_MAP_ATTACH_DETACH
-						   : GOMP_MAP_ALWAYS_POINTER);
-			  OMP_CLAUSE_DECL (node2)
-			    = POINTER_TYPE_P (TREE_TYPE (se.expr))
-			      ? se.expr :  gfc_build_addr_expr (NULL, se.expr);
-			  OMP_CLAUSE_SIZE (node2) = size_int (0);
-			  if (!openacc
-			      && n->expr->ts.type == BT_CHARACTER
-			      && n->expr->ts.deferred)
-			    {
-			      gcc_assert (se.string_length);
-			      tree tmp = gfc_get_char_type (n->expr->ts.kind);
-			      OMP_CLAUSE_SIZE (node)
-				= fold_build2 (MULT_EXPR, size_type_node,
-					       fold_convert (size_type_node,
-							     se.string_length),
-					       TYPE_SIZE_UNIT (tmp));
-			      node3 = build_omp_clause (input_location,
-							OMP_CLAUSE_MAP);
-			      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
-			      OMP_CLAUSE_DECL (node3) = se.string_length;
-			      OMP_CLAUSE_SIZE (node3)
-				= TYPE_SIZE_UNIT (gfc_charlen_type_node);
-			    }
+			  OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
+			  OMP_CLAUSE_DECL (node3) = se.string_length;
+			  OMP_CLAUSE_SIZE (node3)
+			    = TYPE_SIZE_UNIT (gfc_charlen_type_node);
 			}
-		      goto finalize_map_clause;
 		    }
-
+		}
+	      else if (n->expr
+		       && n->expr->expr_type == EXPR_VARIABLE
+		       && (n->expr->ref->type == REF_COMPONENT
+			   || n->expr->ref->type == REF_ARRAY))
+		{
+		  gfc_init_se (&se, NULL);
 		  se.expr = gfc_maybe_dereference_var (n->sym, decl);
 
-		  for (gfc_ref *ref = n->expr->ref;
-		       ref && ref != lastcomp->next;
-		       ref = ref->next)
+		  for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
 		    {
 		      if (ref->type == REF_COMPONENT)
 			{
@@ -2987,24 +3018,30 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
 			  gfc_conv_component_ref (&se, ref);
 			}
+		      else if (ref->type == REF_ARRAY)
+			{
+			  if (ref->u.ar.type == AR_ELEMENT && ref->next)
+			    gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
+						&n->expr->where);
+			  else
+			    gcc_assert (!ref->next);
+			}
 		      else
-			sorry ("unhandled derived-type component");
+			sorry ("unhandled expression type");
 		    }
 
 		  tree inner = se.expr;
 
 		  /* Last component is a derived type or class pointer.  */
-		  if (lastcomp->u.c.component->ts.type == BT_DERIVED
-		      || lastcomp->u.c.component->ts.type == BT_CLASS)
+		  if (lastref->type == REF_COMPONENT
+		      && (lastref->u.c.component->ts.type == BT_DERIVED
+			  || lastref->u.c.component->ts.type == BT_CLASS))
 		    {
-		      bool pointer
-			= (lastcomp->u.c.component->ts.type == BT_CLASS
-			   ? sym_attr.class_pointer : sym_attr.pointer);
-		      if (pointer || (openacc && sym_attr.allocatable))
+		      if (pointer || (openacc && allocatable))
 			{
 			  tree data, size;
 
-			  if (lastcomp->u.c.component->ts.type == BT_CLASS)
+			  if (lastref->u.c.component->ts.type == BT_CLASS)
 			    {
 			      data = gfc_class_data_get (inner);
 			      size = gfc_class_vtab_size_get (inner);
@@ -3037,9 +3074,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    = TYPE_SIZE_UNIT (TREE_TYPE (inner));
 			}
 		    }
-		  else if (lastcomp->next
-			   && lastcomp->next->type == REF_ARRAY
-			   && lastcomp->next->u.ar.type == AR_FULL)
+		  else if (lastref->type == REF_ARRAY
+			   && lastref->u.ar.type == AR_FULL)
 		    {
 		      /* Just pass the (auto-dereferenced) decl through for
 			 bare attach and detach clauses.  */
@@ -3133,27 +3169,21 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      else
 			OMP_CLAUSE_DECL (node) = inner;
 		    }
-		  else  /* An array element or section.  */
+		  else if (lastref->type == REF_ARRAY)
 		    {
-		      bool element
-			= (lastcomp->next
-			   && lastcomp->next->type == REF_ARRAY
-			   && lastcomp->next->u.ar.type == AR_ELEMENT);
-
+		      /* An array element or section.  */
+		      bool element = lastref->u.ar.type == AR_ELEMENT;
 		      gomp_map_kind kind = (openacc ? GOMP_MAP_ATTACH_DETACH
 						    : GOMP_MAP_ALWAYS_POINTER);
 		      gfc_trans_omp_array_section (block, n, inner, element,
 						   kind, node, node2, node3,
 						   node4);
 		    }
+		  else
+		    gcc_unreachable ();
 		}
-	      else  /* An array element or array section.  */
-		{
-		  bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
-		  gfc_trans_omp_array_section (block, n, decl, element,
-					       GOMP_MAP_POINTER, node, node2,
-					       node3, node4);
-		}
+	      else
+		sorry ("unhandled expression");
 
 	      finalize_map_clause:
 
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 95d55bb8ba4..62fb6370819 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -9406,6 +9406,18 @@  gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
 			}
 		    }
 		}
+	      else if ((code == OACC_ENTER_DATA
+			|| code == OACC_EXIT_DATA
+			|| code == OACC_DATA
+			|| code == OACC_PARALLEL
+			|| code == OACC_KERNELS
+			|| code == OACC_SERIAL)
+		       && OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_ATTACH_DETACH)
+		{
+		  gomp_map_kind k = (code == OACC_EXIT_DATA
+				     ? GOMP_MAP_DETACH : GOMP_MAP_ATTACH);
+		  OMP_CLAUSE_SET_MAP_KIND (c, k);
+		}
 
 	      if (gimplify_expr (pd, pre_p, NULL, is_gimple_lvalue, fb_lvalue)
 		  == GS_ERROR)
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
new file mode 100644
index 00000000000..4a3ff0ef3a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-1.f90
@@ -0,0 +1,11 @@ 
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t), allocatable :: b(:)
+
+!$acc update host(b)
+!$acc update host(b(:))
+!$acc update host(b(1)%A)
+!$acc update host(b(1)%A(:,:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
new file mode 100644
index 00000000000..dcb63657f2b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-3.f90
@@ -0,0 +1,14 @@ 
+type t2
+   integer :: A(200,200)
+end type t2
+type t
+   integer, allocatable :: A(:,:)
+end type t
+
+type(t2),allocatable :: c(:)
+type(t), allocatable :: d(:)
+
+!$acc exit data delete(c(1)%A)
+!$acc exit data delete(d(1)%A)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
new file mode 100644
index 00000000000..637d5f57e1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-4.f90
@@ -0,0 +1,18 @@ 
+type t4
+  integer, allocatable :: quux(:)
+end type t4
+type t3
+  type(t4), pointer :: qux(:)
+end type t3
+type t2
+  type(t3), allocatable :: bar(:)
+end type t2
+type t
+  type(t2), allocatable :: foo(:)
+end type t
+
+type(t), allocatable :: c(:)
+
+!$acc enter data copyin(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+!$acc exit data delete(c(5)%foo(4)%bar(3)%qux(2)%quux(:))
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90 b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
new file mode 100644
index 00000000000..900587b7eaf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/array-with-dt-5.f90
@@ -0,0 +1,12 @@ 
+type t2
+  integer :: bar
+end type t2
+type t
+  type(t2), pointer :: foo
+end type t
+
+type(t) :: c
+
+!$acc enter data copyin(c%foo)
+
+end
diff --git a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95 b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f90
similarity index 95%
rename from gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
rename to gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f90
index e6cf09c6d3c..85a2e1d373d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/derived-classtypes-1.f90
@@ -71,7 +71,7 @@  class(type7), allocatable :: acshiela
 !$acc enter data copyin(bar)
 !$acc enter data copyin(bar%b)
 !$acc enter data copyin(qux)
-!!$acc enter data copyin(qux%c)
+!$acc enter data copyin(qux%c)
 !$acc enter data copyin(quux)
 !$acc enter data copyin(quux%d)
 !$acc enter data copyin(fred)
@@ -86,7 +86,7 @@  class(type7), allocatable :: acshiela
 !$acc enter data copyin(pbar)
 !$acc enter data copyin(pbar%b)
 !$acc enter data copyin(pqux)
-!!$acc enter data copyin(pqux%c)
+!$acc enter data copyin(pqux%c)
 !$acc enter data copyin(pquux)
 !$acc enter data copyin(pquux%d)
 !$acc enter data copyin(pfred)
@@ -101,7 +101,7 @@  class(type7), allocatable :: acshiela
 !$acc enter data copyin(cbar)
 !$acc enter data copyin(cbar%b)
 !$acc enter data copyin(cqux)
-!!$acc enter data copyin(cqux%c)
+!$acc enter data copyin(cqux%c)
 !$acc enter data copyin(cquux)
 !$acc enter data copyin(cquux%d)
 !$acc enter data copyin(cfred)
@@ -116,7 +116,7 @@  class(type7), allocatable :: acshiela
 !$acc enter data copyin(acbar)
 !$acc enter data copyin(acbar%b)
 !$acc enter data copyin(acqux)
-!!$acc enter data copyin(acqux%c)
+!$acc enter data copyin(acqux%c)
 !$acc enter data copyin(acquux)
 !$acc enter data copyin(acquux%d)
 !$acc enter data copyin(acfred)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
new file mode 100644
index 00000000000..644ad1f6b2f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/derivedtypes-arrays-1.f90
@@ -0,0 +1,109 @@ 
+! { dg-do run }
+
+type type1
+  integer, allocatable :: arr1(:,:)
+end type type1
+
+type type2
+  type(type1) :: t1
+end type type2
+
+type type3
+  type(type2) :: t2(20)
+end type type3
+
+type type4
+  type(type3), allocatable :: t3(:)
+end type type4
+
+integer :: i, j, k
+
+type(type4), allocatable :: var1(:)
+type(type4) :: var2
+type(type3) :: var3
+
+allocate(var1(1:20))
+do i=1,20
+  allocate(var1(i)%t3(1:20))
+  do j=1,20
+    do k=1,20
+      allocate(var1(i)%t3(j)%t2(k)%t1%arr1(1:20,1:20))
+    end do
+  end do
+end do
+
+allocate(var2%t3(1:20))
+do i=1,20
+  do j=1,20
+    allocate(var2%t3(i)%t2(j)%t1%arr1(1:20,1:20))
+  end do
+end do
+
+do i=1,20
+  do j=1,20
+    do k=1,20
+      var1(i)%t3(j)%t2(k)%t1%arr1(:,:) = 0
+    end do
+    var2%t3(i)%t2(j)%t1%arr1(:,:) = 0
+  end do
+end do
+
+!$acc enter data copyin(var2%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc enter data copyin(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+
+var2%t3(4)%t2(3)%t1%arr1(:,:) = 5
+var1(5)%t3(4)%t2(3)%t1%arr1(:,:) = 4
+
+!$acc update device(var2%t3(4)%t2(3)%t1%arr1)
+!$acc update device(var1(5)%t3(4)%t2(3)%t1%arr1)
+
+!$acc exit data copyout(var1(5)%t3(4)%t2(3)%t1%arr1(:,:))
+!$acc exit data copyout(var2%t3(4)%t2(3)%t1%arr1(:,:))
+
+do i=1,20
+  do j=1,20
+    do k=1,20
+      if (i.eq.5 .and. j.eq.4 .and. k.eq.3) then
+        if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 4)) stop 1
+      else
+        if (any(var1(i)%t3(j)%t2(k)%t1%arr1 .ne. 0)) stop 2
+      end if
+    end do
+    if (i.eq.4 .and. j.eq.3) then
+      if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 5)) stop 3
+    else
+      if (any(var2%t3(i)%t2(j)%t1%arr1 .ne. 0)) stop 4
+    end if
+  end do
+end do
+
+do i=1,20
+  allocate(var3%t2(i)%t1%arr1(1:20, 1:20))
+  var3%t2(i)%t1%arr1(:,:) = 0
+end do
+
+!$acc enter data copyin(var3)
+!$acc enter data copyin(var3%t2(:))
+!$acc enter data copyin(var3%t2(5)%t1)
+!$acc data copyin(var3%t2(5)%t1%arr1)
+
+!$acc serial present(var3%t2(5)%t1%arr1)
+var3%t2(5)%t1%arr1(:,:) = 6
+!$acc end serial
+
+!$acc update host(var3%t2(5)%t1%arr1)
+
+!$acc end data
+!$acc exit data delete(var3%t2(5)%t1)
+!$acc exit data delete(var3%t2)
+!$acc exit data delete(var3)
+
+do i=1,20
+  if (i.eq.5) then
+    if (any(var3%t2(i)%t1%arr1.ne.6)) stop 5
+  else
+    if (any(var3%t2(i)%t1%arr1.ne.0)) stop 6
+  end if
+end do
+
+end
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90 b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
new file mode 100644
index 00000000000..d796eddceda
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/update-dt-array.f90
@@ -0,0 +1,53 @@ 
+! { dg-do run }
+
+program myprog
+
+  type mytype
+    integer, allocatable :: myarr(:,:)
+  end type mytype
+  integer :: i
+
+  type(mytype), allocatable :: typearr(:)
+
+  allocate(typearr(1:100))
+
+  do i=1,100
+    allocate(typearr(i)%myarr(1:100,1:100))
+  end do
+
+  do i=1,100
+    typearr(i)%myarr(:,:) = 0
+  end do
+
+  !$acc enter data copyin(typearr)
+
+  do i=1,100
+    !$acc enter data copyin(typearr(i)%myarr)
+  end do
+
+  i=33
+  typearr(i)%myarr(:,:) = 50
+
+  !$acc update device(typearr(i)%myarr(:,:))
+
+  do i=1,100
+    !$acc exit data copyout(typearr(i)%myarr)
+  end do
+
+  !$acc exit data delete(typearr)
+
+  do i=1,100
+    if (i.eq.33) then
+      if (any(typearr(i)%myarr.ne.50)) stop 1
+    else
+      if (any(typearr(i)%myarr.ne.0)) stop 2
+    end if
+  end do
+
+  do i=1,100
+    deallocate(typearr(i)%myarr)
+  end do
+
+  deallocate(typearr)
+
+end program myprog