diff mbox series

Fortran/OpenMP: Support automatic mapping allocatable components (deep mapping)

Message ID aa440bea-42fc-4624-a1f6-d50f248791fc@baylibre.com
State New
Headers
Series Fortran/OpenMP: Support automatic mapping allocatable components (deep mapping) |

Checks

Context Check Description
linaro-tcwg-bot/tcwg_gcc_build--master-aarch64 success Build passed
linaro-tcwg-bot/tcwg_gcc_build--master-arm fail Patch failed to apply

Commit Message

Tobias Burnus April 15, 2025, 9:30 a.m. UTC 
  This is a long overdue patch for the most important still missing OpenMP
feature: Handling derived types with allocatable components. OpenMP
automatically maps them (if allocated; OpenMP 6/6.1 permits some finetuning).

Additionally, there is now more aggressive warnings when mapping polymorphic
variables / polymorphic allocatable components as those aren't well handled.
(OpenMP 6.0 explicitly rejects them, while OpenMP 6.1 will permit more.)

As PRIVATE/FIRSTPRIVATE do not handle allocatable components at all, there
is now an error for those. (For mapping; for data sharing, polymorphic/allocatables
should work just fine - at least for firstprivate; I think for 'private'
the same issue exists as with do concurrent's 'local': default initialization
fails.)

This patch relies on some middle end support and some smaller fixes, but
those have been committed before:r15-3895-ge4a58b6f28383c and on the Fortran side 
r15-7661-g8293b9e40f12e9. Unless there are further comments, I intent to 
commit it later today. Test remarks: As 
libgomp.fortran/map-alloc-comp-9.f90 shows, USM support makes a 
difference in what is supported. My laptop supports it and I had to 
change conditionally disable some code if it is not supported. For USM 
(unified-shared memory) support, see: 
https://gcc.gnu.org/onlinedocs/libgomp/Offload-Target-Specifics.html 
[With USM, the _vptr->_size data is available.] This patch should only 
affect Fortran OpenMP code mapping allocatable components and, thus, 
should be of low risk. TODO: I will file an issue regarding the support 
for PRIVATE/FIRSTPRIVATE with allocatable components (missing feature). 
Some OpenMP 6.1 polymorphic support will also eventually land, albeit it 
seems as if currently it is mostly about handling the _vptr with 
polymophic variables and USM, which works to some extend (a bit unclear 
as this feature is WIP for OpenMP 6.1). * * * For cross ref: This patch 
is based on an older patch that did not make it into GCC before a 
release and was only in a vendor branch (devel/omp/gcc-XX aka OGxx) for 
too long. Contrary to the attached version, the original one also 
properly mapped polymorphic variables - but without handling _vptr it 
did not quite help and it modified the ABI by adding another type-bound 
procedure to the vtable - breaking API compatibility - for no good 
reason as without _vtab, it is not really usable. [Well, now it would as 
we GCC has support for unified-shared memory on some systems.] The 
original first patch was 
https://gcc.gnu.org/pipermail/fortran/2022-March/057622.html (yes, 
that's 3 years ago, targeting GCC 12 mainline) There were some updates 
later that year but then nothing happened until GCC 15. Tobias

Comments

Thomas Schwinge April 18, 2025, 9:28 a.m. UTC | #1 
Hi Tobias!

On 2025-04-15T11:30:18+0200, Tobias Burnus <tburnus@baylibre.com> wrote:
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
> @@ -0,0 +1,308 @@
> +! NOTE: This code uses POINTER.
> +! While map(p, var%p) etc. maps the ptr/ptr comp p / var%p (incl. allocatable comps),
> +! map(var) does not map var%p.
> +
> +use iso_c_binding
> +implicit none
> +type t2
> +  integer, allocatable :: x, y, z
> +end type t2
> +type t
> +  integer, pointer :: A => null()
> +  integer, pointer :: B(:) => null()
> +  type(t2), pointer :: C => null()
> +  type(t2), pointer :: D(:,:) => null()
> +end type t
> +
> +type t3
> +  type(t) :: Q
> +  type(t) :: R(5)
> +end type
> +
> +type(t) :: var, var2
> +type(t3) :: var3, var4
> +integer(c_intptr_t) :: iptr
> +
> +! --------------------------------------
> +! Assign + allocate
> +allocate (var%A, source=45)
> +allocate (var%B(3), source=[1,2,3])
> +allocate (var%C)
> +var%C%x = 6; var%C%y = 5; var%C%z = 4
> +allocate (var%D(2,2))
> +var%D(1,1)%x = 1
> +var%D(1,1)%y = 2
> +var%D(1,1)%z = 3
> +var%D(2,1)%x = 4
> +var%D(2,1)%y = 5
> +var%D(2,1)%z = 6
> +var%D(1,2)%x = 11
> +var%D(1,2)%y = 12
> +var%D(1,2)%z = 13
> +var%D(2,2)%x = 14
> +var%D(2,2)%y = 15
> +var%D(2,2)%z = 16
> +
> +! Assign + allocate
> +allocate (var2%A, source=145)
> +allocate (var2%B, source=[991,992,993])
> +allocate (var2%C)
> +var2%C%x = 996; var2%C%y = 995; var2%C%z = 994
> +allocate (var2%D(2,2))
> +var2%D(1,1)%x = 199
> +var2%D(1,1)%y = 299
> +var2%D(1,1)%z = 399
> +var2%D(2,1)%x = 499
> +var2%D(2,1)%y = 599
> +var2%D(2,1)%z = 699
> +var2%D(1,2)%x = 1199
> +var2%D(1,2)%y = 1299
> +var2%D(1,2)%z = 1399
> +var2%D(2,2)%x = 1499
> +var2%D(2,2)%y = 1599
> +var2%D(2,2)%z = 1699
> +
> +block
> +  integer(c_intptr_t) :: loc_a, loc_b, loc_c, loc_d, loc2_a, loc2_b, loc2_c, loc2_d
> +  loc_a = loc (var%a)
> +  loc_b = loc (var%b)
> +  loc_c = loc (var%d)
> +  loc_d = loc (var%d)
> +  loc2_a = loc (var2%a)
> +  loc2_b = loc (var2%b)
> +  loc2_c = loc (var2%c)
> +  loc2_d = loc (var2%d)
> +  ! var/var2 are mapped, but the pointer components aren't
> +  !$omp target map(to: var) map(tofrom: var2)
> +    if (loc_a /= loc (var%a)) stop 31
> +    if (loc_b /= loc (var%b)) stop 32
> +    if (loc_c /= loc (var%d)) stop 33
> +    if (loc_d /= loc (var%d)) stop 34
> +    if (loc2_a /= loc (var2%a)) stop 35
> +    if (loc2_b /= loc (var2%b)) stop 36
> +    if (loc2_c /= loc (var2%c)) stop 37
> +    if (loc2_d /= loc (var2%d)) stop 38
> +  !$omp end target
> +  if (loc_a /= loc (var%a)) stop 41
> +  if (loc_b /= loc (var%b)) stop 42
> +  if (loc_c /= loc (var%d)) stop 43
> +  if (loc_d /= loc (var%d)) stop 44
> +  if (loc2_a /= loc (var2%a)) stop 45
> +  if (loc2_b /= loc (var2%b)) stop 46
> +  if (loc2_c /= loc (var2%c)) stop 47
> +  if (loc2_d /= loc (var2%d)) stop 48
> +end block
> +
> +block
> +  ! Map only (all) components, but this maps also the alloc comps
> +  !$omp target map(to: var%a, var%b, var%c, var%d) map(tofrom: var2%a, var2%b, var2%c, var2%d)
> +    call foo (var,var2)
> +  !$omp end target
> +end block
> +
> +if (var2%A /= 45) stop 9
> +if (any (var2%B /= [1,2,3])) stop 10
> +if (var2%C%x /= 6) stop 11
> +if (var2%C%y /= 5) stop 11
> +if (var2%C%z /= 4) stop 11
> +block
> +  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
> +  tmp_x = reshape([1, 4, 11, 14], [2,2])
> +  tmp_y = reshape([2, 5, 12, 15], [2,2])
> +  tmp_z = reshape([3, 6, 13, 16], [2,2])
> +  do j = 1, 2
> +    do i = 1, 2
> +      if (var2%D(i,j)%x /= tmp_x(i,j)) stop 12
> +      if (var2%D(i,j)%y /= tmp_y(i,j)) stop 12
> +      if (var2%D(i,j)%z /= tmp_z(i,j)) stop 12
> +    end do
> +  end do
> +end block
> +
> +! Extra deallocates due to PR fortran/104697
> +deallocate(var%C%x, var%C%y, var%C%z)
> +deallocate(var%D(1,1)%x, var%D(1,1)%y, var%D(1,1)%z)
> +deallocate(var%D(2,1)%x, var%D(2,1)%y, var%D(2,1)%z)
> +deallocate(var%D(1,2)%x, var%D(1,2)%y, var%D(1,2)%z)
> +deallocate(var%D(2,2)%x, var%D(2,2)%y, var%D(2,2)%z)
> +deallocate(var%A, var%B, var%C, var%D)
> +
> +deallocate(var2%C%x, var2%C%y, var2%C%z)
> +deallocate(var2%D(1,1)%x, var2%D(1,1)%y, var2%D(1,1)%z)
> +deallocate(var2%D(2,1)%x, var2%D(2,1)%y, var2%D(2,1)%z)
> +deallocate(var2%D(1,2)%x, var2%D(1,2)%y, var2%D(1,2)%z)
> +deallocate(var2%D(2,2)%x, var2%D(2,2)%y, var2%D(2,2)%z)
> +deallocate(var2%A, var2%B, var2%C, var2%D)
> +
> +! --------------------------------------
> +! Assign + allocate
> +allocate (var3%Q%A, source=45)
> +allocate (var3%Q%B, source=[1,2,3])
> +allocate (var3%Q%C, source=t2(6,5,4))
> +allocate (var3%Q%D(2,2))
> +var3%Q%D(1,1) = t2(1,2,3)
> +var3%Q%D(2,1) = t2(4,5,6)
> +var3%Q%D(1,2) = t2(11,12,13)
> +var3%Q%D(2,2) = t2(14,15,16)
> +
> +allocate (var3%R(2)%A, source=45)
> +allocate (var3%R(2)%B, source=[1,2,3])
> +allocate (var3%R(2)%C, source=t2(6,5,4))
> +allocate (var3%R(2)%D(2,2))
> +var3%R(2)%D(1,1) = t2(1,2,3)
> +var3%R(2)%D(2,1) = t2(4,5,6)
> +var3%R(2)%D(1,2) = t2(11,12,13)
> +var3%R(2)%D(2,2) = t2(14,15,16)
> +
> +! Assign + allocate
> +allocate (var4%Q%A, source=145)
> +allocate (var4%Q%B, source=[991,992,993])
> +allocate (var4%Q%C, source=t2(996,995,994))
> +allocate (var4%Q%D(2,2))
> +var4%Q%D(1,1) = t2(199,299,399)
> +var4%Q%D(2,1) = t2(499,599,699)
> +var4%Q%D(1,2) = t2(1199,1299,1399)
> +var4%Q%D(2,2) = t2(1499,1599,1699)
> +
> +allocate (var4%R(3)%A, source=145)
> +allocate (var4%R(3)%B, source=[991,992,993])
> +allocate (var4%R(3)%C, source=t2(996,995,994))
> +allocate (var4%R(3)%D(2,2))
> +var4%R(3)%D(1,1) = t2(199,299,399)
> +var4%R(3)%D(2,1) = t2(499,599,699)
> +var4%R(3)%D(1,2) = t2(1199,1299,1399)
> +var4%R(3)%D(2,2) = t2(1499,1599,1699)
> +
> +!$omp target map(to: var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D) &
> +!$omp&       map(tofrom: var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
> +  call foo(var3%Q, var4%Q)
> +!$omp end target
> +
> +iptr = loc(var3%R(2)%A)
> +
> +!$omp target map(to: var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D) &
> +!$omp&       map(tofrom: var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
> +  call foo(var3%R(2), var4%R(3))
> +!$omp end target
> +
> +if (var4%Q%A /= 45) stop 13
> +if (any (var4%Q%B /= [1,2,3])) stop 14
> +if (var4%Q%C%x /= 6) stop 15
> +if (var4%Q%C%y /= 5) stop 15
> +if (var4%Q%C%z /= 4) stop 15
> +block
> +  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
> +  tmp_x = reshape([1, 4, 11, 14], [2,2])
> +  tmp_y = reshape([2, 5, 12, 15], [2,2])
> +  tmp_z = reshape([3, 6, 13, 16], [2,2])
> +  do j = 1, 2
> +    do i = 1, 2
> +      if (var4%Q%D(i,j)%x /= tmp_x(i,j)) stop 16
> +      if (var4%Q%D(i,j)%y /= tmp_y(i,j)) stop 16
> +      if (var4%Q%D(i,j)%z /= tmp_z(i,j)) stop 16
> +    end do
> +  end do
> +end block
> +
> +! Cf. PR fortran/s104696
> +! { dg-output "valid mapping, OK" { xfail { offload_device_nonshared_as } } }

For both GCN and nvptx offloading with 'offload_device_nonshared_as', I
see:

    +PASS: libgomp.fortran/map-alloc-comp-6.f90   -O  (test for excess errors)
    +PASS: libgomp.fortran/map-alloc-comp-6.f90   -O  execution test
    +XPASS: libgomp.fortran/map-alloc-comp-6.f90   -O  output pattern test

    spawn [open ...]
     valid mapping, OK


Grüße
 Thomas


> +if (iptr /= loc(var3%R(2)%A)) then
> +  print *, "invalid mapping, cf. PR fortran/104696"
> +else
> +
> +if (var4%R(3)%A /= 45) stop 17
> +if (any (var4%R(3)%B /= [1,2,3])) stop 18
> +if (var4%R(3)%C%x /= 6) stop 19
> +if (var4%R(3)%C%y /= 5) stop 19
> +if (var4%R(3)%C%z /= 4) stop 19
> +block
> +  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
> +  tmp_x = reshape([1, 4, 11, 14], [2,2])
> +  tmp_y = reshape([2, 5, 12, 15], [2,2])
> +  tmp_z = reshape([3, 6, 13, 16], [2,2])
> +  do j = 1, 2
> +    do i = 1, 2
> +      if (var4%R(3)%D(i,j)%x /= tmp_x(i,j)) stop 20
> +      if (var4%R(3)%D(i,j)%y /= tmp_y(i,j)) stop 20
> +      if (var4%R(3)%D(i,j)%z /= tmp_z(i,j)) stop 20
> +    end do
> +  end do
> +end block
> +
> +! Extra deallocates due to PR fortran/104697
> +deallocate(var3%Q%C%x, var3%Q%D(1,1)%x, var3%Q%D(2,1)%x, var3%Q%D(1,2)%x, var3%Q%D(2,2)%x)
> +deallocate(var3%Q%C%y, var3%Q%D(1,1)%y, var3%Q%D(2,1)%y, var3%Q%D(1,2)%y, var3%Q%D(2,2)%y)
> +deallocate(var3%Q%C%z, var3%Q%D(1,1)%z, var3%Q%D(2,1)%z, var3%Q%D(1,2)%z, var3%Q%D(2,2)%z)
> +deallocate(var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D)
> +
> +deallocate(var4%Q%C%x, var4%Q%D(1,1)%x, var4%Q%D(2,1)%x, var4%Q%D(1,2)%x, var4%Q%D(2,2)%x)
> +deallocate(var4%Q%C%y, var4%Q%D(1,1)%y, var4%Q%D(2,1)%y, var4%Q%D(1,2)%y, var4%Q%D(2,2)%y)
> +deallocate(var4%Q%C%z, var4%Q%D(1,1)%z, var4%Q%D(2,1)%z, var4%Q%D(1,2)%z, var4%Q%D(2,2)%z)
> +deallocate(var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
> +
> +deallocate(var3%R(2)%C%x, var3%R(2)%D(1,1)%x, var3%R(2)%D(2,1)%x, var3%R(2)%D(1,2)%x, var3%R(2)%D(2,2)%x)
> +deallocate(var3%R(2)%C%y, var3%R(2)%D(1,1)%y, var3%R(2)%D(2,1)%y, var3%R(2)%D(1,2)%y, var3%R(2)%D(2,2)%y)
> +deallocate(var3%R(2)%C%z, var3%R(2)%D(1,1)%z, var3%R(2)%D(2,1)%z, var3%R(2)%D(1,2)%z, var3%R(2)%D(2,2)%z)
> +deallocate(var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D)
> +
> +deallocate(var4%R(3)%C%x, var4%R(3)%D(1,1)%x, var4%R(3)%D(2,1)%x, var4%R(3)%D(1,2)%x, var4%R(3)%D(2,2)%x)
> +deallocate(var4%R(3)%C%y, var4%R(3)%D(1,1)%y, var4%R(3)%D(2,1)%y, var4%R(3)%D(1,2)%y, var4%R(3)%D(2,2)%y)
> +deallocate(var4%R(3)%C%z, var4%R(3)%D(1,1)%z, var4%R(3)%D(2,1)%z, var4%R(3)%D(1,2)%z, var4%R(3)%D(2,2)%z)
> +deallocate(var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
> +
> +  print *, "valid mapping, OK"
> +endif
> +
> +contains
> +  subroutine foo(x, y)
> +    type(t) :: x, y
> +    intent(in) :: x
> +    intent(inout) :: y
> +    integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
> +    if (x%A /= 45) stop 1
> +    if (any (x%B /= [1,2,3])) stop 2
> +    if (x%C%x /= 6) stop 3
> +    if (x%C%y /= 5) stop 3
> +    if (x%C%z /= 4) stop 3
> +
> +    tmp_x = reshape([1, 4, 11, 14], [2,2])
> +    tmp_y = reshape([2, 5, 12, 15], [2,2])
> +    tmp_z = reshape([3, 6, 13, 16], [2,2])
> +    do j = 1, 2
> +      do i = 1, 2
> +        if (x%D(i,j)%x /= tmp_x(i,j)) stop 4
> +        if (x%D(i,j)%y /= tmp_y(i,j)) stop 4
> +        if (x%D(i,j)%z /= tmp_z(i,j)) stop 4
> +      end do
> +    end do
> +
> +    if (y%A /= 145) stop 5
> +    if (any (y%B /= [991,992,993])) stop 6
> +    if (y%C%x /= 996) stop 7
> +    if (y%C%y /= 995) stop 7
> +    if (y%C%z /= 994) stop 7
> +    tmp_x = reshape([199, 499, 1199, 1499], [2,2])
> +    tmp_y = reshape([299, 599, 1299, 1599], [2,2])
> +    tmp_z = reshape([399, 699, 1399, 1699], [2,2])
> +    do j = 1, 2
> +      do i = 1, 2
> +        if (y%D(i,j)%x /= tmp_x(i,j)) stop 8
> +        if (y%D(i,j)%y /= tmp_y(i,j)) stop 8
> +        if (y%D(i,j)%z /= tmp_z(i,j)) stop 8
> +      end do
> +    end do
> +
> +    y%A = x%A
> +    y%B(:) = x%B
> +    y%C%x = x%C%x
> +    y%C%y = x%C%y
> +    y%C%z = x%C%z
> +    do j = 1, 2
> +      do i = 1, 2
> +        y%D(i,j)%x = x%D(i,j)%x
> +        y%D(i,j)%y = x%D(i,j)%y
> +        y%D(i,j)%z = x%D(i,j)%z
> +      end do
> +    end do
> +  end
> +end
diff mbox series

Patch

Fortran/OpenMP: Support automatic mapping allocatable components (deep mapping)

When mapping an allocatable variable (or derived-type component), explicitly
or implicitly, all its allocated allocatable components will automatically be
mapped. The patch implements the target hooks, added for this feature to
omp-low.cc with commit r15-3895-ge4a58b6f28383c.

Namely, there is a check whether there are allocatable components at all:
gfc_omp_deep_mapping_p. Then gfc_omp_deep_mapping_cnt, counting the number
of required mappings; this is a dynamic value as it depends on array
bounds and whether an allocatable is allocated or not.
And, finally, the actual mapping: gfc_omp_deep_mapping.

Polymorphic variables are partially supported: the mapping of the _data
component is fully supported, but only components of the declared type
are processed for additional allocatables. Additionally, _vptr is not
touched. This means that everything needing _vtab information requires
unified shared memory; in particular, _size data is required when
accessing elements of polymorphic arrays.
However, for scalar arrays, accessing components of the declare type
should work just fine.

As polymorphic variables are not (really) supported and OpenMP 6
explicitly disallows them, there is now a warning (-Wopenmp) when
they are encountered. Unlimited polymorphics are rejected (error).

Additionally, PRIVATE and FIRSTPRIVATE are not quite supported for
allocatable components, polymorphic components and as polymorphic
variable. Thus, those are now rejected as well.


gcc/fortran/ChangeLog:

	* f95-lang.cc (LANG_HOOKS_OMP_DEEP_MAPPING,
	LANG_HOOKS_OMP_DEEP_MAPPING_P, LANG_HOOKS_OMP_DEEP_MAPPING_CNT):
	Define.
	* openmp.cc (gfc_match_omp_clause_reduction): Fix location setting.
	(resolve_omp_clauses): Permit allocatable components, reject
	them and polymorphic variables in PRIVATE/FIRSTPRIVATE.
	* trans-decl.cc (add_clause): Set clause location.
	* trans-openmp.cc (gfc_has_alloc_comps): Add ptr_ok and
	shallow_alloc_only Boolean arguments.
	(gfc_omp_replace_alloc_by_to_mapping): New.
	(gfc_omp_private_outer_ref, gfc_walk_alloc_comps,
	gfc_omp_clause_default_ctor, gfc_omp_clause_copy_ctor,
	gfc_omp_clause_assign_op, gfc_omp_clause_dtor): Update call to it.
	(gfc_omp_finish_clause): Minor cleanups, improve location data,
	handle allocatable components.
	(gfc_omp_deep_mapping_map, gfc_omp_deep_mapping_item,
	gfc_omp_deep_mapping_comps, gfc_omp_gen_simple_loop,
	gfc_omp_get_array_size, gfc_omp_elmental_loop,
	gfc_omp_deep_map_kind_p, gfc_omp_deep_mapping_int_p,
	gfc_omp_deep_mapping_p, gfc_omp_deep_mapping_do,
	gfc_omp_deep_mapping_cnt, gfc_omp_deep_mapping): New.
	(gfc_trans_omp_array_section): Save array descriptor in case
	deep-mapping lang hook will need it.
	(gfc_trans_omp_clauses): Likewise; use better clause location data.
	* trans.h (gfc_omp_deep_mapping_p, gfc_omp_deep_mapping_cnt,
	gfc_omp_deep_mapping): Add function prototypes.

libgomp/ChangeLog:

	* libgomp.texi (5.0 Impl. Status): Mark mapping alloc comps as 'Y'.
	* testsuite/libgomp.fortran/allocatable-comp.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-3.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-4.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-5.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-6.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-7.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-8.f90: New test.
	* testsuite/libgomp.fortran/map-alloc-comp-9.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/map-alloc-comp-1.f90: Remove dg-error.
	* gfortran.dg/gomp/polymorphic-mapping-2.f90: Update warn wording.
	* gfortran.dg/gomp/polymorphic-mapping.f90: Change expected
	diagnostic; some tests moved to ...
	* gfortran.dg/gomp/polymorphic-mapping-1.f90: ... here as new test.
	* gfortran.dg/gomp/polymorphic-mapping-3.f90: New test.
	* gfortran.dg/gomp/polymorphic-mapping-4.f90: New test.
	* gfortran.dg/gomp/polymorphic-mapping-5.f90: New test.

 gcc/fortran/f95-lang.cc                            |    6 +
 gcc/fortran/openmp.cc                              |   42 +-
 gcc/fortran/trans-decl.cc                          |    1 +
 gcc/fortran/trans-openmp.cc                        | 1007 ++++++++++++++++++--
 gcc/fortran/trans.h                                |    4 +
 .../gfortran.dg/gomp/map-alloc-comp-1.f90          |    2 +-
 .../gfortran.dg/gomp/polymorphic-mapping-1.f90     |   30 +
 .../gfortran.dg/gomp/polymorphic-mapping-2.f90     |    2 +-
 .../gfortran.dg/gomp/polymorphic-mapping-3.f90     |   23 +
 .../gfortran.dg/gomp/polymorphic-mapping-4.f90     |    9 +
 .../gfortran.dg/gomp/polymorphic-mapping-5.f90     |    9 +
 .../gfortran.dg/gomp/polymorphic-mapping.f90       |   24 +-
 libgomp/libgomp.texi                               |    2 +-
 .../testsuite/libgomp.fortran/allocatable-comp.f90 |   53 ++
 .../testsuite/libgomp.fortran/map-alloc-comp-3.f90 |  121 +++
 .../testsuite/libgomp.fortran/map-alloc-comp-4.f90 |  124 +++
 .../testsuite/libgomp.fortran/map-alloc-comp-5.f90 |   53 ++
 .../testsuite/libgomp.fortran/map-alloc-comp-6.f90 |  308 ++++++
 .../testsuite/libgomp.fortran/map-alloc-comp-7.f90 |  672 +++++++++++++
 .../testsuite/libgomp.fortran/map-alloc-comp-8.f90 |  268 ++++++
 .../testsuite/libgomp.fortran/map-alloc-comp-9.f90 |  559 +++++++++++
 21 files changed, 3208 insertions(+), 111 deletions(-)

diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 124d62f4529..1f09553142d 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -148,6 +148,9 @@  gfc_get_sarif_source_language (const char *)
 #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
+#undef LANG_HOOKS_OMP_DEEP_MAPPING
+#undef LANG_HOOKS_OMP_DEEP_MAPPING_P
+#undef LANG_HOOKS_OMP_DEEP_MAPPING_CNT
 #undef LANG_HOOKS_OMP_ALLOCATABLE_P
 #undef LANG_HOOKS_OMP_SCALAR_TARGET_P
 #undef LANG_HOOKS_OMP_SCALAR_P
@@ -188,6 +191,9 @@  gfc_get_sarif_source_language (const char *)
 #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR	gfc_omp_clause_linear_ctor
 #define LANG_HOOKS_OMP_CLAUSE_DTOR		gfc_omp_clause_dtor
 #define LANG_HOOKS_OMP_FINISH_CLAUSE		gfc_omp_finish_clause
+#define LANG_HOOKS_OMP_DEEP_MAPPING		gfc_omp_deep_mapping
+#define LANG_HOOKS_OMP_DEEP_MAPPING_P		gfc_omp_deep_mapping_p
+#define LANG_HOOKS_OMP_DEEP_MAPPING_CNT		gfc_omp_deep_mapping_cnt
 #define LANG_HOOKS_OMP_ALLOCATABLE_P		gfc_omp_allocatable_p
 #define LANG_HOOKS_OMP_SCALAR_P			gfc_omp_scalar_p
 #define LANG_HOOKS_OMP_SCALAR_TARGET_P		gfc_omp_scalar_target_p
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index ded80b7977e..df829403c34 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -1588,7 +1588,7 @@  gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
 	  {
 	    gfc_omp_namelist *p = gfc_get_omp_namelist (), **tl;
 	    p->sym = n->sym;
-	    p->where = p->where;
+	    p->where = n->where;
 	    p->u.map.op = OMP_MAP_ALWAYS_TOFROM;
 
 	    tl = &c->lists[OMP_LIST_MAP];
@@ -9681,22 +9681,6 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			 && n->sym->as->type == AS_ASSUMED_SIZE)
 		  gfc_error ("Assumed size array %qs in %s clause at %L",
 			     n->sym->name, name, &n->where);
-		if (!openacc
-		    && list == OMP_LIST_MAP
-		    && n->sym->ts.type == BT_DERIVED
-		    && n->sym->ts.u.derived->attr.alloc_comp)
-		  gfc_error ("List item %qs with allocatable components is not "
-			     "permitted in map clause at %L", n->sym->name,
-			     &n->where);
-		if (!openacc
-		    && (list == OMP_LIST_MAP
-			|| list == OMP_LIST_FROM
-			|| list == OMP_LIST_TO)
-		    && ((n->expr && n->expr->ts.type == BT_CLASS)
-			|| (!n->expr && n->sym->ts.type == BT_CLASS)))
-		  gfc_warning (OPT_Wopenmp,
-			       "Mapping polymorphic list item at %L is "
-			       "unspecified behavior", &n->where);
 		if (list == OMP_LIST_MAP && !openacc)
 		  switch (code->op)
 		    {
@@ -10008,9 +9992,11 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			     n->sym->name, name, &n->where);
 
 		if (!openacc
-		    && list == OMP_LIST_FIRSTPRIVATE
-		    && ((n->expr && n->expr->ts.type == BT_CLASS)
-			|| (!n->expr && n->sym->ts.type == BT_CLASS)))
+		    && (list == OMP_LIST_PRIVATE
+			|| list == OMP_LIST_FIRSTPRIVATE)
+		    && ((n->sym->ts.type == BT_DERIVED
+			 && n->sym->ts.u.derived->attr.alloc_comp)
+			|| n->sym->ts.type == BT_CLASS))
 		  switch (code->op)
 		    {
 		    case EXEC_OMP_TARGET:
@@ -10025,9 +10011,19 @@  resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 		    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
 		    case EXEC_OMP_TARGET_TEAMS_LOOP:
-		      gfc_warning (OPT_Wopenmp,
-				   "FIRSTPRIVATE with polymorphic list item at "
-				   "%L is unspecified behavior", &n->where);
+		      if (n->sym->ts.type == BT_DERIVED
+			  && n->sym->ts.u.derived->attr.alloc_comp)
+			gfc_error ("Sorry, list item %qs at %L with allocatable"
+				   " components is not yet supported in %s "
+				   "clause", n->sym->name, &n->where,
+				   list == OMP_LIST_PRIVATE ? "PRIVATE"
+							    : "FIRSTPRIVATE");
+		      else
+			gfc_error ("Polymorphic list item %qs at %L in %s "
+				   "clause has unspecified behavior and "
+				   "unsupported", n->sym->name, &n->where,
+				   list == OMP_LIST_PRIVATE ? "PRIVATE"
+							    : "FIRSTPRIVATE");
 		      break;
 		    default:
 		      break;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index aea132ded13..ddc4960b6ff 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -6920,6 +6920,7 @@  add_clause (gfc_symbol *sym, gfc_omp_map_op map_op)
 
   n = gfc_get_omp_namelist ();
   n->sym = sym;
+  n->where = sym->declared_at;
   n->u.map.op = map_op;
 
   if (!module_oacc_clauses)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 03d94326bc8..0b8150fb977 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -25,6 +25,10 @@  along with GCC; see the file COPYING3.  If not see
 #include "options.h"
 #include "tree.h"
 #include "gfortran.h"
+#include "basic-block.h"
+#include "tree-ssa.h"
+#include "function.h"
+#include "gimple.h"
 #include "gimple-expr.h"
 #include "trans.h"
 #include "stringpool.h"
@@ -41,6 +45,8 @@  along with GCC; see the file COPYING3.  If not see
 #include "omp-low.h"
 #include "memmodel.h"  /* For MEMMODEL_ enums.  */
 #include "dependency.h"
+#include "gimple-iterator.h" /* For gsi_iterator_update.  */
+#include "gimplify-me.h"  /* For force_gimple_operand.  */
 
 #undef GCC_DIAG_STYLE
 #define GCC_DIAG_STYLE __gcc_tdiag__
@@ -375,22 +381,28 @@  gfc_omp_report_decl (tree decl)
   return decl;
 }
 
-/* Return true if TYPE has any allocatable components.  */
+/* Return true if TYPE has any allocatable components;
+   if ptr_ok, the decl itself is permitted to have the POINTER attribute.
+   if shallow_alloc_only, returns only true if any of the fields is an
+   allocatable; called with true by gfc_omp_replace_alloc_by_to_mapping.  */
 
 static bool
-gfc_has_alloc_comps (tree type, tree decl)
+gfc_has_alloc_comps (tree type, tree decl, bool ptr_ok,
+		     bool shallow_alloc_only=false)
 {
   tree field, ftype;
 
   if (POINTER_TYPE_P (type))
     {
-      if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
+      if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+	  || (ptr_ok && GFC_DECL_GET_SCALAR_POINTER (decl)))
 	type = TREE_TYPE (type);
       else if (GFC_DECL_GET_SCALAR_POINTER (decl))
 	return false;
     }
 
-  if (GFC_DESCRIPTOR_TYPE_P (type)
+  if (!ptr_ok
+      && GFC_DESCRIPTOR_TYPE_P (type)
       && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
 	  || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
     return false;
@@ -409,12 +421,51 @@  gfc_has_alloc_comps (tree type, tree decl)
       if (GFC_DESCRIPTOR_TYPE_P (ftype)
 	  && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
 	return true;
-      if (gfc_has_alloc_comps (ftype, field))
+      if (!shallow_alloc_only
+	  && gfc_has_alloc_comps (ftype, field, false))
 	return true;
     }
   return false;
 }
 
+/* gfc_omp_replace_alloc_by_to_mapping is used with gfc_omp_deep_mapping... to
+   handle the following:
+
+   For map(alloc: dt), the array descriptors of allocatable components should
+   be mapped as 'to'; this could be done by (A) adding 'map(to: dt%alloc_comp)'
+   for each component (and avoiding to increment the reference count).
+   Or (B) by just mapping all of 'dt' as 'to'.
+
+   If 'dt' contains several allocatable components and not much other data,
+   (A) is more efficient. If 'dt' contains a large const-size array, (A) will
+   copy it to the device instead of only 'alloc'ating it.
+
+   IMPLEMENTATION CHOICE: We do (A). It avoids the ref-count issue and it is
+   expected that, for real-world code, derived types with allocatable
+   components only have few other components and either no const-size arrays.
+   This copying is done irrespectively whether the allocatables are allocated.
+
+   If users wanted to save memory, they have to use 'map(alloc:dt%comp)' as
+   also with 'map(alloc:dt)' all components get copied.
+
+   For the copy to the device, only allocatable arrays are relevant as their
+   the bounds are required; the pointer is set separately (GOMP_MAP_ATTACH)
+   and the only setting required for scalars. However, when later copying out
+   of the device, an unallocated allocatable must remain unallocated/NULL on
+   the host; to achieve this we also must have it set to NULL on the device
+   to avoid issues with uninitialized memory being copied back for the pointer
+   address. If we could set the pointer to NULL, gfc_has_alloc_comps's
+   shallow_alloc_only could be restricted to return true only for arrays.
+
+   We only need to return true if there are allocatable-array components. */
+
+static bool
+gfc_omp_replace_alloc_by_to_mapping (tree type, tree decl, bool ptr_ok)
+{
+  return gfc_has_alloc_comps (type, decl, ptr_ok, true);
+}
+
+
 /* Return true if TYPE is polymorphic but not with pointer attribute.  */
 
 static bool
@@ -487,7 +538,7 @@  gfc_omp_private_outer_ref (tree decl)
   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
     return true;
 
-  if (gfc_has_alloc_comps (type, decl))
+  if (gfc_has_alloc_comps (type, decl, false))
     return true;
 
   return false;
@@ -627,7 +678,7 @@  gfc_walk_alloc_comps (tree decl, tree dest, tree var,
     {
       tree ftype = TREE_TYPE (field);
       tree declf, destf = NULL_TREE;
-      bool has_alloc_comps = gfc_has_alloc_comps (ftype, field);
+      bool has_alloc_comps = gfc_has_alloc_comps (ftype, field, false);
       if ((!GFC_DESCRIPTOR_TYPE_P (ftype)
 	   || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE)
 	  && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
@@ -751,7 +802,7 @@  gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
 	  || !POINTER_TYPE_P (type)))
     {
-      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
 	{
 	  gcc_assert (outer);
 	  gfc_start_block (&block);
@@ -804,7 +855,7 @@  gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
   else
     gfc_add_modify (&cond_block, unshare_expr (decl),
 		    fold_convert (TREE_TYPE (decl), ptr));
-  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
     {
       tree tem = gfc_walk_alloc_comps (outer, decl,
 				       OMP_CLAUSE_DECL (clause),
@@ -945,7 +996,7 @@  gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
 	  || !POINTER_TYPE_P (type)))
     {
-      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
 	{
 	  gfc_start_block (&block);
 	  gfc_add_modify (&block, dest, src);
@@ -1004,7 +1055,7 @@  gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 			      builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
 			      srcptr, size);
   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
-  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
     {
       tree tem = gfc_walk_alloc_comps (src, dest,
 				       OMP_CLAUSE_DECL (clause),
@@ -1049,7 +1100,7 @@  gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
 	  || !POINTER_TYPE_P (type)))
     {
-      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
 	{
 	  gfc_start_block (&block);
 	  /* First dealloc any allocatable components in DEST.  */
@@ -1071,7 +1122,7 @@  gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
 
   gfc_start_block (&block);
 
-  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
     {
       then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause),
 				     WALK_ALLOC_COMPS_DTOR);
@@ -1186,7 +1237,7 @@  gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
 			      builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
 			      srcptr, size);
   gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
-  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
     {
       tree tem = gfc_walk_alloc_comps (src, dest,
 				       OMP_CLAUSE_DECL (clause),
@@ -1438,7 +1489,7 @@  gfc_omp_clause_dtor (tree clause, tree decl)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
 	  || !POINTER_TYPE_P (type)))
     {
-      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+      if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
 	return gfc_walk_alloc_comps (decl, NULL_TREE,
 				     OMP_CLAUSE_DECL (clause),
 				     WALK_ALLOC_COMPS_DTOR);
@@ -1458,7 +1509,7 @@  gfc_omp_clause_dtor (tree clause, tree decl)
     tem = gfc_call_free (decl);
   tem = gfc_omp_unshare_expr (tem);
 
-  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
+  if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause), false))
     {
       stmtblock_t block;
       tree then_b;
@@ -1538,6 +1589,7 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
     return;
 
   tree decl = OMP_CLAUSE_DECL (c);
+  location_t loc = OMP_CLAUSE_LOCATION (c);
 
   /* Assumed-size arrays can't be mapped implicitly, they have to be
      mapped explicitly using array sections.  */
@@ -1553,13 +1605,9 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
       return;
     }
 
-  if (!openacc && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
-    warning_at (OMP_CLAUSE_LOCATION (c), OPT_Wopenmp,
-		"Implicit mapping of polymorphic variable %qD is "
-		"unspecified behavior", decl);
-
   tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
   tree present = gfc_omp_check_optional_argument (decl, true);
+  tree orig_decl = NULL_TREE;
   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     {
       if (!gfc_omp_privatize_by_reference (decl)
@@ -1568,7 +1616,7 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 	  && !GFC_DECL_CRAY_POINTEE (decl)
 	  && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
 	return;
-      tree orig_decl = decl;
+      orig_decl = decl;
 
       c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
       OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
@@ -1579,16 +1627,16 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 	  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
 	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
 	{
-	  c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+	  c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
 	  OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
-	  OMP_CLAUSE_DECL (c2) = decl;
+	  OMP_CLAUSE_DECL (c2) = unshare_expr (decl);
 	  OMP_CLAUSE_SIZE (c2) = size_int (0);
 
 	  stmtblock_t block;
 	  gfc_start_block (&block);
-	  tree ptr = decl;
-	  ptr = gfc_build_cond_assign_expr (&block, present, decl,
-					    null_pointer_node);
+	  tree ptr = gfc_build_cond_assign_expr (&block, present,
+						 unshare_expr (decl),
+						 null_pointer_node);
 	  gimplify_and_add (gfc_finish_block (&block), pre_p);
 	  ptr = build_fold_indirect_ref (ptr);
 	  OMP_CLAUSE_DECL (c) = ptr;
@@ -1605,10 +1653,10 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 	{
 	  c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
 	  OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
-	  OMP_CLAUSE_DECL (c3) = unshare_expr (decl);
+	  OMP_CLAUSE_DECL (c3) = decl;
 	  OMP_CLAUSE_SIZE (c3) = size_int (0);
 	  decl = build_fold_indirect_ref (decl);
-	  OMP_CLAUSE_DECL (c) = decl;
+	  OMP_CLAUSE_DECL (c) = unshare_expr (decl);
 	}
     }
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
@@ -1634,7 +1682,7 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
       gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
       ptr = build_fold_indirect_ref (ptr);
       OMP_CLAUSE_DECL (c) = ptr;
-      c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+      c2 = build_omp_clause (loc, OMP_CLAUSE_MAP);
       OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
       if (present)
 	{
@@ -1651,7 +1699,7 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 						   : GOMP_MAP_POINTER);
       if (present)
 	{
-	  ptr = gfc_conv_descriptor_data_get (decl);
+	  ptr = gfc_conv_descriptor_data_get (unshare_expr (decl));
 	  ptr = gfc_build_addr_expr (NULL, ptr);
 	  ptr = gfc_build_cond_assign_expr (&block, present,
 					    ptr, null_pointer_node);
@@ -1664,6 +1712,17 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
       tree size = create_tmp_var (gfc_array_index_type);
       tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
       elemsz = fold_convert (gfc_array_index_type, elemsz);
+
+      if (orig_decl == NULL_TREE)
+	orig_decl = decl;
+      if (!openacc
+	  && gfc_has_alloc_comps (type, orig_decl, true))
+	{
+	  /* Save array descriptor for use in gfc_omp_deep_mapping{,_p,_cnt};
+	     force evaluate to ensure that it is not gimplified + is a decl.  */
+	  gfc_allocate_lang_decl (size);
+	  GFC_DECL_SAVED_DESCRIPTOR (size) = orig_decl;
+	}
       enum gfc_array_kind akind = GFC_TYPE_ARRAY_AKIND (type);
       if (akind == GFC_ARRAY_ALLOCATABLE
 	  || akind == GFC_ARRAY_POINTER
@@ -1692,14 +1751,14 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 	  else_b = gfc_finish_block (&cond_block);
 	  tem = gfc_conv_descriptor_data_get (unshare_expr (decl));
 	  tem = fold_convert (pvoid_type_node, tem);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
+	  cond = fold_build2_loc (loc, NE_EXPR,
 				  boolean_type_node, tem, null_pointer_node);
 	  if (present)
 	    {
-	      cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+	      cond = fold_build2_loc (loc, TRUTH_ANDIF_EXPR,
 				      boolean_type_node, present, cond);
 	    }
-	  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+	  gfc_add_expr_to_block (&block, build3_loc (loc, COND_EXPR,
 						     void_type_node, cond,
 						     then_b, else_b));
 	}
@@ -1739,11 +1798,30 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
       tree stmt = gfc_finish_block (&block);
       gimplify_and_add (stmt, pre_p);
     }
+  else
+    {
+      if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
+	OMP_CLAUSE_SIZE (c)
+	  = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
+			  : TYPE_SIZE_UNIT (TREE_TYPE (decl));
+
+      tree type = TREE_TYPE (decl);
+      if (POINTER_TYPE_P (type) && POINTER_TYPE_P (TREE_TYPE (type)))
+	type = TREE_TYPE (type);
+      if (!openacc
+	  && orig_decl != NULL_TREE
+	  && gfc_has_alloc_comps (type, orig_decl, true))
+	{
+	  /* Save array descriptor for use in gfc_omp_deep_mapping{,_p,_cnt};
+	     force evaluate to ensure that it is not gimplified + is a decl.  */
+	  tree size = create_tmp_var (TREE_TYPE (OMP_CLAUSE_SIZE (c)));
+	  gfc_allocate_lang_decl (size);
+	  GFC_DECL_SAVED_DESCRIPTOR (size) = orig_decl;
+	  gimplify_assign (size, OMP_CLAUSE_SIZE (c), pre_p);
+	  OMP_CLAUSE_SIZE (c) = size;
+	}
+    }
   tree last = c;
-  if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
-    OMP_CLAUSE_SIZE (c)
-      = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
-		      : TYPE_SIZE_UNIT (TREE_TYPE (decl));
   if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
 		     NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
     OMP_CLAUSE_SIZE (c) = size_int (0);
@@ -1767,6 +1845,715 @@  gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 }
 
 
+/* map(<flag>: data [len: <size>])
+   map(attach: &data [bias: <bias>])
+   offset += 2; offset_data += 2 */
+static void
+gfc_omp_deep_mapping_map (tree data, tree size, unsigned HOST_WIDE_INT tkind,
+			  location_t loc, tree data_array, tree sizes_array,
+			  tree kinds_array, tree offset_data, tree offset,
+			  gimple_seq *seq, const gimple *ctx)
+{
+  tree one = build_int_cst (size_type_node, 1);
+
+  STRIP_NOPS (data);
+  if (!POINTER_TYPE_P (TREE_TYPE (data)))
+    {
+      gcc_assert (TREE_CODE (data) == INDIRECT_REF);
+      data = TREE_OPERAND (data, 0);
+    }
+
+  /* data_array[offset_data] = data; */
+  tree tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)),
+		     unshare_expr (data_array), offset_data,
+		     NULL_TREE, NULL_TREE);
+  gimplify_assign (tmp, data, seq);
+
+  /* offset_data++ */
+  tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one);
+  gimplify_assign (offset_data, tmp, seq);
+
+  /* data_array[offset_data] = &data; */
+  tmp = build4 (ARRAY_REF, TREE_TYPE (TREE_TYPE (data_array)),
+		unshare_expr (data_array),
+		offset_data, NULL_TREE, NULL_TREE);
+  gimplify_assign (tmp, build_fold_addr_expr (data), seq);
+
+  /* offset_data++ */
+  tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset_data, one);
+  gimplify_assign (offset_data, tmp, seq);
+
+  /* sizes_array[offset] = size */
+  tmp = build2_loc (loc, MULT_EXPR, size_type_node,
+		    TYPE_SIZE_UNIT (size_type_node), offset);
+  tmp = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (sizes_array),
+		    sizes_array, tmp);
+  gimple_seq seq2 = NULL;
+  tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
+  gimple_seq_add_seq (seq, seq2);
+  tmp = build_fold_indirect_ref_loc (loc, tmp);
+  gimplify_assign (tmp, size, seq);
+
+  /* FIXME: tkind |= talign << talign_shift; */
+  /* kinds_array[offset] = tkind. */
+  tmp = build2_loc (loc, MULT_EXPR, size_type_node,
+		    TYPE_SIZE_UNIT (short_unsigned_type_node), offset);
+  tmp = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (kinds_array),
+		    kinds_array, tmp);
+  seq2 = NULL;
+  tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
+  gimple_seq_add_seq (seq, seq2);
+  tmp = build_fold_indirect_ref_loc (loc, tmp);
+  gimplify_assign (tmp, build_int_cst (short_unsigned_type_node, tkind), seq);
+
+  /* offset++ */
+  tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset, one);
+  gimplify_assign (offset, tmp, seq);
+
+  /* sizes_array[offset] = bias (= 0).  */
+  tmp = build2_loc (loc, MULT_EXPR, size_type_node,
+		    TYPE_SIZE_UNIT (size_type_node), offset);
+  tmp = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (sizes_array),
+		    sizes_array, tmp);
+  seq2 = NULL;
+  tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
+  gimple_seq_add_seq (seq, seq2);
+  tmp = build_fold_indirect_ref_loc (loc, tmp);
+  gimplify_assign (tmp, build_zero_cst (size_type_node), seq);
+
+  gcc_assert (gimple_code (ctx) == GIMPLE_OMP_TARGET);
+  tkind = (gimple_omp_target_kind (ctx) == GF_OMP_TARGET_KIND_EXIT_DATA
+	   ? GOMP_MAP_DETACH : GOMP_MAP_ATTACH);
+
+  /* kinds_array[offset] = tkind. */
+  tmp = build2_loc (loc, MULT_EXPR, size_type_node,
+		    TYPE_SIZE_UNIT (short_unsigned_type_node), offset);
+  tmp = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (kinds_array),
+		    kinds_array, tmp);
+  seq2 = NULL;
+  tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
+  gimple_seq_add_seq (seq, seq2);
+  tmp = build_fold_indirect_ref_loc (loc, tmp);
+  gimplify_assign (tmp, build_int_cst (short_unsigned_type_node, tkind), seq);
+
+  /* offset++ */
+  tmp = build2_loc (loc, PLUS_EXPR, size_type_node, offset, one);
+  gimplify_assign (offset, tmp, seq);
+}
+
+static void gfc_omp_deep_mapping_item (bool, bool, bool, location_t, tree,
+				       tree *, unsigned HOST_WIDE_INT, tree,
+				       tree, tree, tree, tree, tree,
+				       gimple_seq *, const gimple *, bool *);
+
+/* Map allocatable components.  */
+static void
+gfc_omp_deep_mapping_comps (bool is_cnt, location_t loc, tree decl,
+			    tree *token, unsigned HOST_WIDE_INT tkind,
+			    tree data_array, tree sizes_array, tree kinds_array,
+			    tree offset_data, tree offset, tree num,
+			    gimple_seq *seq, const gimple *ctx,
+			    bool *poly_warned)
+{
+  tree type = TREE_TYPE (decl);
+  if (TREE_CODE (type) != RECORD_TYPE)
+    return;
+  for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
+    {
+      type = TREE_TYPE (field);
+      if (gfc_is_polymorphic_nonptr (type)
+	  || GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
+	  || (GFC_DESCRIPTOR_TYPE_P (type)
+	      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE))
+	{
+	  tree tmp = fold_build3_loc (loc, COMPONENT_REF, TREE_TYPE (field),
+				      decl, field, NULL_TREE);
+	  gfc_omp_deep_mapping_item (is_cnt, true, true, loc, tmp, token,
+				     tkind, data_array, sizes_array,
+				     kinds_array, offset_data, offset, num,
+				     seq, ctx, poly_warned);
+	}
+      else if (GFC_DECL_GET_SCALAR_POINTER (field)
+	       || GFC_DESCRIPTOR_TYPE_P (type))
+	continue;
+      else if (gfc_has_alloc_comps (TREE_TYPE (field), field, false))
+	{
+	  tree tmp = fold_build3_loc (loc, COMPONENT_REF, TREE_TYPE (field),
+				      decl, field, NULL_TREE);
+	  if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
+	    gfc_omp_deep_mapping_item (is_cnt, false, false, loc, tmp,
+				       token, tkind, data_array, sizes_array,
+				       kinds_array, offset_data, offset, num,
+				       seq, ctx, poly_warned);
+	  else
+	    gfc_omp_deep_mapping_comps (is_cnt, loc, tmp, token, tkind,
+					data_array, sizes_array, kinds_array,
+					offset_data, offset, num, seq, ctx,
+					poly_warned);
+	}
+    }
+}
+
+static void
+gfc_omp_gen_simple_loop (tree var, tree begin, tree end, enum tree_code cond,
+			 tree step, location_t loc, gimple_seq *seq1,
+			 gimple_seq *seq2)
+{
+  tree tmp;
+
+  /* var = begin. */
+  gimplify_assign (var, begin, seq1);
+
+  /* Loop: for (var = begin; var <cond> end; var += step).  */
+  tree label_loop = create_artificial_label (loc);
+  tree label_cond = create_artificial_label (loc);
+
+  gimplify_and_add (fold_build1_loc (loc, GOTO_EXPR, void_type_node,
+				     label_cond), seq1);
+  gimple_seq_add_stmt (seq1, gimple_build_label (label_loop));
+
+  /* Everything above is seq1; place loop body here.  */
+
+  /* End of loop body -> put into seq2.  */
+  tmp = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (var), var, step);
+  gimplify_assign (var, tmp, seq2);
+  gimple_seq_add_stmt (seq2, gimple_build_label (label_cond));
+  tmp = fold_build2_loc (loc, cond, boolean_type_node, var, end);
+  tmp = build3_v (COND_EXPR, tmp, build1_v (GOTO_EXPR, label_loop),
+		  build_empty_stmt (loc));
+  gimplify_and_add (tmp, seq2);
+}
+
+/* Return size variable with the size of an array.  */
+static tree
+gfc_omp_get_array_size (location_t loc, tree desc, gimple_seq *seq)
+{
+  tree tmp;
+  gimple_seq seq1 = NULL, seq2 = NULL;
+  tree size = build_decl (loc, VAR_DECL, create_tmp_var_name ("size"),
+			  size_type_node);
+  tree extent = build_decl (loc, VAR_DECL, create_tmp_var_name ("extent"),
+			    gfc_array_index_type);
+  tree idx = build_decl (loc, VAR_DECL, create_tmp_var_name ("idx"),
+			 signed_char_type_node);
+
+  tree begin = build_zero_cst (signed_char_type_node);
+  tree end;
+  if (GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE_CONT
+      || GFC_TYPE_ARRAY_AKIND (TREE_TYPE (desc)) == GFC_ARRAY_ASSUMED_SHAPE)
+    end = gfc_conv_descriptor_rank (desc);
+  else
+    end = build_int_cst (signed_char_type_node,
+			 GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc)));
+  tree step = build_int_cst (signed_char_type_node, 1);
+
+  /* size = 0
+     for (idx = 0; idx < rank; idx++)
+       extent = gfc->dim[i].ubound - gfc->dim[i].lbound + 1
+       if (extent < 0) extent = 0
+	 size *= extent.  */
+  gimplify_assign (size, build_int_cst (size_type_node, 1), seq);
+
+  gfc_omp_gen_simple_loop (idx, begin, end, LT_EXPR, step, loc, &seq1, &seq2);
+  gimple_seq_add_seq (seq, seq1);
+
+  tmp = fold_build2_loc (loc, MINUS_EXPR, gfc_array_index_type,
+			 gfc_conv_descriptor_ubound_get (desc, idx),
+			 gfc_conv_descriptor_lbound_get (desc, idx));
+  tmp = fold_build2_loc (loc, PLUS_EXPR, gfc_array_index_type,
+			 tmp, gfc_index_one_node);
+  gimplify_assign (extent, tmp, seq);
+  tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node,
+			 extent, gfc_index_zero_node);
+  tmp = build3_v (COND_EXPR, tmp,
+		  fold_build2_loc (loc, MODIFY_EXPR,
+				   gfc_array_index_type,
+				   extent, gfc_index_zero_node),
+		  build_empty_stmt (loc));
+  gimplify_and_add (tmp, seq);
+  /* size *= extent.  */
+  gimplify_assign (size, fold_build2_loc (loc, MULT_EXPR, size_type_node, size,
+					  fold_convert (size_type_node,
+							extent)), seq);
+  gimple_seq_add_seq (seq, seq2);
+  return size;
+}
+
+/* Generate loop to access every array element; takes addr of first element
+   (decl's data comp); returns loop code in seq1 + seq2
+   and the pointer to the element as return value.  */
+static tree
+gfc_omp_elmental_loop (location_t loc, tree decl, tree size, tree elem_len,
+		       gimple_seq *seq1, gimple_seq *seq2)
+{
+  tree idx = build_decl (loc, VAR_DECL, create_tmp_var_name ("idx"),
+			 size_type_node);
+  tree begin = build_zero_cst (size_type_node);
+  tree end = size;
+  tree step = build_int_cst (size_type_node, 1);
+  tree ptr;
+
+  gfc_omp_gen_simple_loop (idx, begin, end, LT_EXPR, step, loc, seq1, seq2);
+
+  tree type = TREE_TYPE (decl);
+  if (POINTER_TYPE_P (type))
+    {
+      type = TREE_TYPE (type);
+      gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+      decl = fold_convert (build_pointer_type (TREE_TYPE (type)), decl);
+    }
+  else
+    {
+      gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
+      decl = build_fold_addr_expr_loc (loc, decl);
+    }
+  decl = fold_convert (build_pointer_type (TREE_TYPE (type)), decl);
+  tree tmp = build2_loc (loc, MULT_EXPR, size_type_node, idx,
+			 fold_convert (size_type_node, elem_len));
+  ptr = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (decl), decl, tmp);
+  gimple_seq seq3 = NULL;
+  ptr = force_gimple_operand (ptr, &seq3, true, NULL_TREE);
+  gimple_seq_add_seq (seq1, seq3);
+
+  return ptr;
+}
+
+
+/* If do_copy, copy data pointer and vptr (if applicable) as well.
+   Otherwise, only handle allocatable components.
+   do_copy == false can happen only with nonpolymorphic arguments
+   to a copy clause.
+   if (is_cnt) token ... offset is ignored and num is used, otherwise
+   num is NULL_TREE and unused.  */
+
+static void
+gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
+			   location_t loc, tree decl, tree *token,
+			   unsigned HOST_WIDE_INT tkind, tree data_array,
+			   tree sizes_array, tree kinds_array, tree offset_data,
+			   tree offset, tree num, gimple_seq *seq,
+			   const gimple *ctx, bool *poly_warned)
+{
+  tree tmp;
+  tree type = TREE_TYPE (decl);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  tree end_label = NULL_TREE;
+  tree size = NULL_TREE, elem_len = NULL_TREE;
+
+  bool poly = gfc_is_polymorphic_nonptr (type);
+  if (poly && is_cnt && !*poly_warned)
+    {
+      if (gfc_is_unlimited_polymorphic_nonptr (type))
+	error_at (loc,
+		  "Mapping of unlimited polymorphic list item %qD is "
+		  "unspecified behavior and unsupported", decl);
+
+      else
+	warning_at (loc, OPT_Wopenmp,
+		    "Mapping of polymorphic list item %qD is "
+		    "unspecified behavior", decl);
+      *poly_warned = true;
+    }
+  if (do_alloc_check)
+    {
+      tree then_label = create_artificial_label (loc);
+      end_label = create_artificial_label (loc);
+      tmp = decl;
+      if (TREE_CODE (TREE_TYPE (tmp)) == REFERENCE_TYPE
+	  || (POINTER_TYPE_P (TREE_TYPE (tmp))
+	      && (POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (tmp)))
+		  || GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (tmp))))))
+	tmp = build_fold_indirect_ref_loc (loc, tmp);
+      if (poly)
+	tmp = gfc_class_data_get (tmp);
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	tmp = gfc_conv_descriptor_data_get (tmp);
+      gimple_seq seq2 = NULL;
+      tmp = force_gimple_operand (tmp, &seq2, true, NULL_TREE);
+      gimple_seq_add_seq (seq, seq2);
+
+      gimple_seq_add_stmt (seq,
+			   gimple_build_cond (NE_EXPR, tmp, null_pointer_node,
+					      then_label, end_label));
+      gimple_seq_add_stmt (seq, gimple_build_label (then_label));
+    }
+  tree class_decl = decl;
+  if (poly)
+    {
+      decl = gfc_class_data_get (decl);
+      type = TREE_TYPE (decl);
+    }
+  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+    {
+      decl = build_fold_indirect_ref (decl);
+      type = TREE_TYPE (decl);
+    }
+
+  if (is_cnt && do_copy)
+    {
+      tree tmp = fold_build2_loc (loc, PLUS_EXPR, size_type_node,
+				  num, build_int_cst (size_type_node, 1));
+      gimplify_assign (num, tmp, seq);
+    }
+  else if (do_copy)
+    {
+      /* copy data pointer  */
+      tree bytesize;
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+	{
+	  /* TODO: Optimization: Shouldn't this be an expr. const, except for
+	     deferred-length strings. (Cf. also below).  */
+	  elem_len = (poly ? gfc_class_vtab_size_get (class_decl)
+			   : gfc_conv_descriptor_elem_len (decl));
+	  tmp = (POINTER_TYPE_P (TREE_TYPE (decl))
+		 ? build_fold_indirect_ref (decl) : decl);
+	  size = gfc_omp_get_array_size (loc, tmp, seq);
+	  bytesize = fold_build2_loc (loc, MULT_EXPR, size_type_node,
+				      fold_convert (size_type_node, size),
+				      fold_convert (size_type_node, elem_len));
+	  tmp = gfc_conv_descriptor_data_get (decl);
+	}
+      else if (poly)
+	{
+	  tmp = decl;
+	  bytesize = fold_convert (size_type_node,
+				   gfc_class_vtab_size_get (class_decl));
+	}
+      else
+	{
+	  tmp = decl;
+	  bytesize = TYPE_SIZE_UNIT (TREE_TYPE (decl));
+	}
+      unsigned HOST_WIDE_INT tkind2 = tkind;
+      if (!is_cnt
+	  && (tkind == GOMP_MAP_ALLOC
+	      || (tkind == GOMP_MAP_FROM
+		  && (gimple_omp_target_kind (ctx)
+		      != GF_OMP_TARGET_KIND_EXIT_DATA)))
+	  && gfc_omp_replace_alloc_by_to_mapping (TREE_TYPE (decl), decl, true))
+	tkind2 = tkind == GOMP_MAP_ALLOC ? GOMP_MAP_TO : GOMP_MAP_TOFROM;
+
+      gfc_omp_deep_mapping_map (tmp, bytesize, tkind2, loc, data_array,
+				sizes_array, kinds_array, offset_data,
+				offset, seq, ctx);
+    }
+
+  tmp = decl;
+  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+    while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
+      tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+  if (poly || gfc_has_alloc_comps (type, tmp, true))
+    {
+      gimple_seq seq2 = NULL;
+      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+	{
+	  if (elem_len == NULL_TREE)
+	    {
+	      elem_len = gfc_conv_descriptor_elem_len (decl);
+	      size = fold_convert (size_type_node,
+				   gfc_omp_get_array_size (loc, decl, seq));
+	    }
+	  decl = gfc_conv_descriptor_data_get (decl);
+	  decl = gfc_omp_elmental_loop (loc, decl, size, elem_len, seq, &seq2);
+	  decl = build_fold_indirect_ref_loc (loc, decl);
+	}
+      else if (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE)
+	{
+	  type = TREE_TYPE (tmp);
+	  /* FIXME: PR95868 - for var%str of deferred length, elem_len == 0;
+	     len is stored as var%_str_length, but not in GFC_DECL_STRING_LEN
+	     nor in TYPE_SIZE_UNIT as expression. */
+	  elem_len = TYPE_SIZE_UNIT (TREE_TYPE (type));
+	  size = fold_convert (size_type_node, GFC_TYPE_ARRAY_SIZE (type));
+	  decl = gfc_omp_elmental_loop (loc, decl, size, elem_len, seq, &seq2);
+	  decl = build_fold_indirect_ref_loc (loc, decl);
+	}
+      else if (POINTER_TYPE_P (TREE_TYPE (decl)))
+	decl = build_fold_indirect_ref (decl);
+
+      gfc_omp_deep_mapping_comps (is_cnt, loc, decl, token, tkind,
+				  data_array, sizes_array, kinds_array,
+				  offset_data, offset, num, seq, ctx,
+				  poly_warned);
+      gimple_seq_add_seq (seq, seq2);
+    }
+  if (end_label)
+    gimple_seq_add_stmt (seq, gimple_build_label (end_label));
+}
+
+
+/* Which map types to check/handle for deep mapping.  */
+static bool
+gfc_omp_deep_map_kind_p (tree clause)
+{
+  switch (OMP_CLAUSE_CODE (clause))
+    {
+    case OMP_CLAUSE_MAP:
+      break;
+    case OMP_CLAUSE_FIRSTPRIVATE:
+    case OMP_CLAUSE_TO:
+    case OMP_CLAUSE_FROM:
+      return true;
+    default:
+      gcc_unreachable ();
+    }
+
+  switch (OMP_CLAUSE_MAP_KIND (clause))
+    {
+    case GOMP_MAP_TO:
+    case GOMP_MAP_FROM:
+    case GOMP_MAP_TOFROM:
+    case GOMP_MAP_ALWAYS_TO:
+    case GOMP_MAP_ALWAYS_FROM:
+    case GOMP_MAP_ALWAYS_TOFROM:
+    case GOMP_MAP_ALWAYS_PRESENT_FROM:
+    case GOMP_MAP_ALWAYS_PRESENT_TO:
+    case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
+    case GOMP_MAP_FIRSTPRIVATE:
+    case GOMP_MAP_ALLOC:
+      return true;
+    case GOMP_MAP_POINTER:
+    case GOMP_MAP_TO_PSET:
+    case GOMP_MAP_FORCE_PRESENT:
+    case GOMP_MAP_DELETE:
+    case GOMP_MAP_FORCE_DEVICEPTR:
+    case GOMP_MAP_DEVICE_RESIDENT:
+    case GOMP_MAP_LINK:
+    case GOMP_MAP_IF_PRESENT:
+    case GOMP_MAP_PRESENT_ALLOC:
+    case GOMP_MAP_PRESENT_FROM:
+    case GOMP_MAP_PRESENT_TO:
+    case GOMP_MAP_PRESENT_TOFROM:
+    case GOMP_MAP_FIRSTPRIVATE_INT:
+    case GOMP_MAP_USE_DEVICE_PTR:
+    case GOMP_MAP_ZERO_LEN_ARRAY_SECTION:
+    case GOMP_MAP_FORCE_ALLOC:
+    case GOMP_MAP_FORCE_TO:
+    case GOMP_MAP_FORCE_FROM:
+    case GOMP_MAP_FORCE_TOFROM:
+    case GOMP_MAP_USE_DEVICE_PTR_IF_PRESENT:
+    case GOMP_MAP_STRUCT:
+    case GOMP_MAP_STRUCT_UNORD:
+    case GOMP_MAP_ALWAYS_POINTER:
+    case GOMP_MAP_POINTER_TO_ZERO_LENGTH_ARRAY_SECTION:
+    case GOMP_MAP_DELETE_ZERO_LEN_ARRAY_SECTION:
+    case GOMP_MAP_RELEASE:
+    case GOMP_MAP_ATTACH:
+    case GOMP_MAP_DETACH:
+    case GOMP_MAP_FORCE_DETACH:
+    case GOMP_MAP_ATTACH_ZERO_LENGTH_ARRAY_SECTION:
+    case GOMP_MAP_FIRSTPRIVATE_POINTER:
+    case GOMP_MAP_FIRSTPRIVATE_REFERENCE:
+    case GOMP_MAP_ATTACH_DETACH:
+      break;
+    default:
+      gcc_unreachable ();
+    }
+  return false;
+}
+
+/* Three OpenMP deep-mapping lang hooks: gfc_omp_deep_mapping{_p,_cnt,}.  */
+
+/* Common check for gfc_omp_deep_mapping_p and gfc_omp_deep_mapping_do. */
+
+static tree
+gfc_omp_deep_mapping_int_p (const gimple *ctx, tree clause)
+{
+  if (is_gimple_omp_oacc (ctx) || !gfc_omp_deep_map_kind_p (clause))
+    return NULL_TREE;
+  tree decl = OMP_CLAUSE_DECL (clause);
+  if (OMP_CLAUSE_SIZE (clause) != NULL_TREE
+      && DECL_P (OMP_CLAUSE_SIZE (clause))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_SIZE (clause))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_SIZE (clause)))
+    /* Saved decl. */
+    decl = GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_SIZE (clause));
+  else if (TREE_CODE (decl) == MEM_REF || TREE_CODE (decl) == INDIRECT_REF)
+    /* The following can happen for, e.g., class(t) :: var(..)  */
+    decl = TREE_OPERAND (decl, 0);
+  if (TREE_CODE (decl) == INDIRECT_REF)
+    /* The following can happen for, e.g., class(t) :: var(..)  */
+    decl = TREE_OPERAND (decl, 0);
+  if (DECL_P (decl)
+      && DECL_LANG_SPECIFIC (decl)
+      && GFC_DECL_SAVED_DESCRIPTOR (decl))
+    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+  /* Handle map(to: var.desc) map([to/from/tofrom:] var.desc.data)
+     to get proper map kind by skipping to the next item. */
+  tree tmp = OMP_CLAUSE_CHAIN (clause);
+  if (tmp != NULL_TREE
+      && OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_CODE (clause)
+      && OMP_CLAUSE_SIZE (tmp) != NULL_TREE
+      && DECL_P (OMP_CLAUSE_SIZE (tmp))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_SIZE (tmp))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_SIZE (tmp)) == decl)
+    return NULL_TREE;
+  if (DECL_P (decl)
+      && DECL_LANG_SPECIFIC (decl)
+      && GFC_DECL_SAVED_DESCRIPTOR (decl))
+    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+  tree type = TREE_TYPE (decl);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  tmp = decl;
+  while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
+    tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+  if (!gfc_is_polymorphic_nonptr (type)
+      && !gfc_has_alloc_comps (type, tmp, true))
+    return NULL_TREE;
+  return decl;
+}
+
+/* Return true if there is deep mapping, even if the number of mapping is known
+   at compile time. */
+bool
+gfc_omp_deep_mapping_p (const gimple *ctx, tree clause)
+{
+  tree decl = gfc_omp_deep_mapping_int_p (ctx, clause);
+  if (decl == NULL_TREE)
+    return false;
+  return true;
+}
+
+/* Handle gfc_omp_deep_mapping{,_cnt} */
+static tree
+gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
+			 unsigned HOST_WIDE_INT tkind, tree data, tree sizes,
+			 tree kinds, tree offset_data, tree offset,
+			 gimple_seq *seq)
+{
+  tree num = NULL_TREE;
+  location_t loc = OMP_CLAUSE_LOCATION (clause);
+  tree decl = gfc_omp_deep_mapping_int_p (ctx, clause);
+  bool poly_warned = false;
+  if (decl == NULL_TREE)
+    return NULL_TREE;
+  /* Handle: map(alloc:dt%cmp [len: ptr_size]) map(tofrom: D.0123...),
+     where GFC_DECL_SAVED_DESCRIPTOR(D.0123) is the same (here: dt%cmp).  */
+  if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP
+      && (OMP_CLAUSE_MAP_KIND (clause) == GOMP_MAP_ALLOC
+	  || OMP_CLAUSE_MAP_KIND (clause) == GOMP_MAP_PRESENT_ALLOC))
+    {
+      tree c = clause;
+      while ((c = OMP_CLAUSE_CHAIN (c)) != NULL_TREE)
+	{
+	  if (!gfc_omp_deep_map_kind_p (c))
+	    continue;
+	  tree d = gfc_omp_deep_mapping_int_p (ctx, c);
+	  if (d != NULL_TREE && operand_equal_p (decl, d, 0))
+	    return NULL_TREE;
+	}
+    }
+  tree type = TREE_TYPE (decl);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  bool poly = gfc_is_polymorphic_nonptr (type);
+
+  if (is_cnt)
+    {
+      num = build_decl (loc, VAR_DECL,
+			create_tmp_var_name ("n_deepmap"), size_type_node);
+      tree tmp = fold_build2_loc (loc, MODIFY_EXPR, size_type_node, num,
+				  build_int_cst (size_type_node, 0));
+      gimple_add_tmp_var (num);
+      gimplify_and_add (tmp, seq);
+    }
+  else
+    gcc_assert (short_unsigned_type_node == TREE_TYPE (TREE_TYPE (kinds)));
+
+  bool do_copy = poly;
+  bool do_alloc_check = false;
+  tree token = NULL_TREE;
+  tree tmp = decl;
+  if (poly)
+    {
+      tmp = TYPE_FIELDS (type);
+      type = TREE_TYPE (tmp);
+    }
+  else
+    while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
+      tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+  /* If the clause argument is nonallocatable, skip is-allocate check. */
+  if (GFC_DECL_GET_SCALAR_ALLOCATABLE (tmp)
+      || GFC_DECL_GET_SCALAR_POINTER (tmp)
+      || (GFC_DESCRIPTOR_TYPE_P (type)
+	  && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE
+	      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
+	      || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)))
+    do_alloc_check = true;
+
+  if (!is_cnt
+      && OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_MAP
+      && (tkind == GOMP_MAP_ALLOC
+	  || (tkind == GOMP_MAP_FROM
+	      && (gimple_omp_target_kind (ctx)
+		  != GF_OMP_TARGET_KIND_EXIT_DATA)))
+      && (poly || gfc_omp_replace_alloc_by_to_mapping (type, tmp, true)))
+    OMP_CLAUSE_SET_MAP_KIND (clause, tkind == GOMP_MAP_ALLOC ? GOMP_MAP_TO
+							     : GOMP_MAP_TOFROM);
+
+  /* TODO: For map(a(:)), we know it is present & allocated.  */
+
+  tree present = (DECL_P (decl) ? gfc_omp_check_optional_argument (decl, true)
+				: NULL_TREE);
+  if (POINTER_TYPE_P (TREE_TYPE (decl))
+      && POINTER_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
+    decl = build_fold_indirect_ref (decl);
+  if (present)
+    {
+      tree then_label = create_artificial_label (loc);
+      tree end_label = create_artificial_label (loc);
+      gimple_seq seq2 = NULL;
+      tmp = force_gimple_operand (present, &seq2, true, NULL_TREE);
+      gimple_seq_add_seq (seq, seq2);
+      gimple_seq_add_stmt (seq,
+			   gimple_build_cond_from_tree (present,
+							then_label, end_label));
+      gimple_seq_add_stmt (seq, gimple_build_label (then_label));
+      gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl,
+				 &token, tkind, data, sizes, kinds,
+				 offset_data, offset, num, seq, ctx,
+				 &poly_warned);
+      gimple_seq_add_stmt (seq, gimple_build_label (end_label));
+    }
+  else
+    gfc_omp_deep_mapping_item (is_cnt, do_copy, do_alloc_check, loc, decl,
+			       &token, tkind, data, sizes, kinds, offset_data,
+			       offset, num, seq, ctx, &poly_warned);
+  /* Multiply by 2 as there are two mappings: data + pointer assign.  */
+  if (is_cnt)
+    gimplify_assign (num,
+		     fold_build2_loc (loc, MULT_EXPR,
+				      size_type_node, num,
+				      build_int_cst (size_type_node, 2)), seq);
+  return num;
+}
+
+/* Return tree with a variable which contains the count of deep-mappyings
+   (value depends, e.g., on allocation status)  */
+tree
+gfc_omp_deep_mapping_cnt (const gimple *ctx, tree clause, gimple_seq *seq)
+{
+  return gfc_omp_deep_mapping_do (true, ctx, clause, 0, NULL_TREE, NULL_TREE,
+				  NULL_TREE, NULL_TREE, NULL_TREE, seq);
+}
+
+/* Does the actual deep mapping. */
+void
+gfc_omp_deep_mapping (const gimple *ctx, tree clause,
+		      unsigned HOST_WIDE_INT tkind, tree data,
+		      tree sizes, tree kinds, tree offset_data, tree offset,
+		      gimple_seq *seq)
+{
+  (void) gfc_omp_deep_mapping_do (false, ctx, clause, tkind, data, sizes, kinds,
+				  offset_data, offset, seq);
+}
+
 /* Return true if DECL is a scalar variable (for the purpose of
    implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
    is true, allocatables and pointers are permitted. */
@@ -2478,6 +3265,18 @@  gfc_trans_omp_array_section (stmtblock_t *block, gfc_exec_op op,
       elemsz = fold_convert (gfc_array_index_type, elemsz);
       OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
 					    OMP_CLAUSE_SIZE (node), elemsz);
+      if (n->expr->ts.type == BT_DERIVED
+	  && n->expr->ts.u.derived->attr.alloc_comp)
+	{
+	  /* Save array descriptor for use in gfc_omp_deep_mapping{,_p,_cnt};
+	     force evaluate to ensure that it is not gimplified + is a decl.  */
+	  tree tmp = OMP_CLAUSE_SIZE (node);
+	  tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
+	  gfc_add_modify_loc (input_location, block, var, tmp);
+	  OMP_CLAUSE_SIZE (node) = var;
+	  gfc_allocate_lang_decl (var);
+	  GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr;
+	}
     }
   gcc_assert (se.post.head == NULL_TREE);
   gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
@@ -3213,8 +4012,9 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (!n->sym->attr.referenced)
 		continue;
 
+	      location_t map_loc = gfc_get_location (&n->where);
 	      bool always_modifier = false;
-	      tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+	      tree node = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 	      tree node2 = NULL_TREE;
 	      tree node3 = NULL_TREE;
 	      tree node4 = NULL_TREE;
@@ -3361,7 +4161,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      && n->u.map.op != OMP_MAP_RELEASE)
 		    {
 		      gcc_assert (n->sym->ts.u.cl->backend_decl);
-		      node5 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+		      node5 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_SET_MAP_KIND (node5, GOMP_MAP_ALWAYS_TO);
 		      OMP_CLAUSE_DECL (node5) = n->sym->ts.u.cl->backend_decl;
 		      OMP_CLAUSE_SIZE (node5)
@@ -3378,7 +4178,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
 		      OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl);
-		      node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+		      node2 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_ATTACH_DETACH);
 		      OMP_CLAUSE_DECL (node2) = gfc_class_data_get (decl);
 		      OMP_CLAUSE_SIZE (node2) = size_int (0);
@@ -3434,8 +4234,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    size = TYPE_SIZE_UNIT (TREE_TYPE (decl));
 			  else
 			    size = size_int (0);
-			  node4 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node4 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_SET_MAP_KIND (node4, gmk);
 			  OMP_CLAUSE_DECL (node4) = decl;
 			  OMP_CLAUSE_SIZE (node4) = size;
@@ -3459,8 +4258,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    size = TYPE_SIZE_UNIT (TREE_TYPE (decl));
 			  else
 			    size = size_int (0);
-			  node3 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node3 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_SET_MAP_KIND (node3, gmk);
 			  OMP_CLAUSE_DECL (node3) = decl;
 			  OMP_CLAUSE_SIZE (node3) = size;
@@ -3477,7 +4275,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
 		      ptr = build_fold_indirect_ref (ptr);
 		      OMP_CLAUSE_DECL (node) = ptr;
-		      node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+		      node2 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_DECL (node2) = decl;
 		      OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
 		      if (n->u.map.op == OMP_MAP_DELETE)
@@ -3493,8 +4291,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  && n->u.map.op != OMP_MAP_DELETE
 			  && n->u.map.op != OMP_MAP_RELEASE)
 			{
-			  node3 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node3 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  if (present)
 			    {
 			      ptr = gfc_conv_descriptor_data_get (decl);
@@ -3634,10 +4431,10 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      /* A single indirectref is handled by the middle end.  */
 		      gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
-		      decl = TREE_OPERAND (decl, 0);
-		      decl = gfc_build_cond_assign_expr (block, present, decl,
+		      tree tmp = TREE_OPERAND (decl, 0);
+		      tmp = gfc_build_cond_assign_expr (block, present, tmp,
 							 null_pointer_node);
-		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
+		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (tmp);
 		    }
 		  else
 		    OMP_CLAUSE_DECL (node) = decl;
@@ -3672,6 +4469,33 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      size = gfc_evaluate_now (size, block);
 		      OMP_CLAUSE_SIZE (node) = size;
 		    }
+		  if ((TREE_CODE (decl) != PARM_DECL
+		       || DECL_ARTIFICIAL (OMP_CLAUSE_DECL (node)))
+		      && n->sym->ts.type == BT_DERIVED
+		      && n->sym->ts.u.derived->attr.alloc_comp)
+		    {
+		      /* Save array descriptor for use in
+			 gfc_omp_deep_mapping{,_p,_cnt}; force evaluate
+			 to ensure that it is not gimplified + is a decl.  */
+		      tree tmp = OMP_CLAUSE_SIZE (node);
+		      if (tmp == NULL_TREE)
+			tmp = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
+					    : TYPE_SIZE_UNIT (TREE_TYPE (decl));
+		      tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
+		      gfc_add_modify_loc (input_location, block, var, tmp);
+		      OMP_CLAUSE_SIZE (node) = var;
+		      gfc_allocate_lang_decl (var);
+		      if (TREE_CODE (decl) == INDIRECT_REF)
+			decl = TREE_OPERAND (decl, 0);
+		      if (TREE_CODE (decl) == INDIRECT_REF)
+			decl = TREE_OPERAND (decl, 0);
+		      if (DECL_LANG_SPECIFIC (decl)
+			  && GFC_DECL_SAVED_DESCRIPTOR (decl))
+			GFC_DECL_SAVED_DESCRIPTOR (var)
+			  = GFC_DECL_SAVED_DESCRIPTOR (decl);
+		      else
+			GFC_DECL_SAVED_DESCRIPTOR (var) = decl;
+		    }
 		}
 	      else if (n->expr
 		       && n->expr->expr_type == EXPR_VARIABLE
@@ -3727,8 +4551,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  goto finalize_map_clause;
 			}
 
-		      node2 = build_omp_clause (input_location,
-						OMP_CLAUSE_MAP);
+		      node2 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_ATTACH_DETACH);
 		      OMP_CLAUSE_DECL (node2)
 			= POINTER_TYPE_P (TREE_TYPE (se.expr))
@@ -3754,13 +4577,37 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    kind = GOMP_MAP_RELEASE;
 			  else
 			    kind = GOMP_MAP_TO;
-			  node3 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node3 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_SET_MAP_KIND (node3, kind);
 			  OMP_CLAUSE_DECL (node3) = se.string_length;
 			  OMP_CLAUSE_SIZE (node3)
 			    = TYPE_SIZE_UNIT (gfc_charlen_type_node);
 			}
+		      if (!openacc
+			  && n->expr->ts.type == BT_DERIVED
+			  && n->expr->ts.u.derived->attr.alloc_comp)
+			{
+			  /* Save array descriptor for use in
+			     gfc_omp_deep_mapping{,_p,_cnt}; force evaluate
+			     to ensure that it is not gimplified + is a decl.  */
+			  tree tmp = OMP_CLAUSE_SIZE (node);
+			  if (tmp == NULL_TREE)
+			    tmp = (DECL_P (se.expr)
+				   ? DECL_SIZE_UNIT (se.expr)
+				   : TYPE_SIZE_UNIT (TREE_TYPE (se.expr)));
+			  tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
+			  gfc_add_modify_loc (input_location, block, var, tmp);
+			  OMP_CLAUSE_SIZE (node) = var;
+			  gfc_allocate_lang_decl (var);
+			  if (TREE_CODE (se.expr) == INDIRECT_REF)
+			    se.expr = TREE_OPERAND (se.expr, 0);
+			  if (DECL_LANG_SPECIFIC (se.expr)
+			      && GFC_DECL_SAVED_DESCRIPTOR (se.expr))
+			    GFC_DECL_SAVED_DESCRIPTOR (var)
+			      = GFC_DECL_SAVED_DESCRIPTOR (se.expr);
+			  else
+			    GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr;
+			}
 		    }
 		}
 	      else if (n->expr
@@ -3800,7 +4647,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      && (lastref->u.c.component->ts.type == BT_DERIVED
 			  || lastref->u.c.component->ts.type == BT_CLASS))
 		    {
-		      if (pointer || (openacc && allocatable))
+		      if (pointer || allocatable)
 			{
 			  /* If it's a bare attach/detach clause, we just want
 			     to perform a single attach/detach operation, of the
@@ -3880,8 +4727,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
 			  OMP_CLAUSE_DECL (node) = data;
 			  OMP_CLAUSE_SIZE (node) = size;
-			  node2 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node2 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_SET_MAP_KIND (node2,
 						   GOMP_MAP_ATTACH_DETACH);
 			  OMP_CLAUSE_DECL (node2) = build_fold_addr_expr (data);
@@ -3893,6 +4739,22 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_SIZE (node)
 			    = TYPE_SIZE_UNIT (TREE_TYPE (inner));
 			}
+		      if (!openacc
+			  && n->expr->ts.type == BT_DERIVED
+			  && n->expr->ts.u.derived->attr.alloc_comp)
+			{
+			  /* Save array descriptor for use in
+			     gfc_omp_deep_mapping{,_p,_cnt}; force evaluate
+			     to ensure that it is not gimplified + is a decl.  */
+			  tree tmp = OMP_CLAUSE_SIZE (node);
+			  tree var = gfc_create_var (TREE_TYPE (tmp), NULL);
+			  gfc_add_modify_loc (input_location, block, var, tmp);
+			  OMP_CLAUSE_SIZE (node) = var;
+			  gfc_allocate_lang_decl (var);
+			  if (TREE_CODE (inner) == INDIRECT_REF)
+			    inner = TREE_OPERAND (inner, 0);
+			  GFC_DECL_SAVED_DESCRIPTOR (var) = inner;
+			}
 		    }
 		  else if (lastref->type == REF_ARRAY
 			   && lastref->u.ar.type == AR_FULL)
@@ -3952,8 +4814,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      elemsz = TYPE_SIZE_UNIT (elemsz);
 			      elemsz = fold_build2 (MULT_EXPR, size_type_node,
 						    len, elemsz);
-			      node4 = build_omp_clause (input_location,
-							OMP_CLAUSE_MAP);
+			      node4 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			      OMP_CLAUSE_SET_MAP_KIND (node4, map_kind);
 			      OMP_CLAUSE_DECL (node4) = se.string_length;
 			      OMP_CLAUSE_SIZE (node4)
@@ -3963,8 +4824,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_SIZE (node)
 			    = fold_build2 (MULT_EXPR, gfc_array_index_type,
 					   OMP_CLAUSE_SIZE (node), elemsz);
-			  node2 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node2 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  if (map_kind == GOMP_MAP_RELEASE
 			      || map_kind == GOMP_MAP_DELETE)
 			    {
@@ -3978,6 +4838,23 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
 			  if (!openacc)
 			    {
+			      if (n->expr->ts.type == BT_DERIVED
+				  && n->expr->ts.u.derived->attr.alloc_comp)
+				{
+				  /* Save array descriptor for use
+				     in gfc_omp_deep_mapping{,_p,_cnt}; force
+				     evaluate to ensure that it is
+				     not gimplified + is a decl.  */
+				  tree tmp = OMP_CLAUSE_SIZE (node);
+				  tree var = gfc_create_var (TREE_TYPE (tmp),
+							     NULL);
+				  gfc_add_modify_loc (map_loc, block,
+						      var, tmp);
+				  OMP_CLAUSE_SIZE (node) = var;
+				  gfc_allocate_lang_decl (var);
+				  GFC_DECL_SAVED_DESCRIPTOR (var) = inner;
+				}
+
 			      gfc_omp_namelist *n2
 				= clauses->lists[OMP_LIST_MAP];
 
@@ -4035,8 +4912,7 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			      if (drop_mapping)
 				continue;
 			    }
-			  node3 = build_omp_clause (input_location,
-						    OMP_CLAUSE_MAP);
+			  node3 = build_omp_clause (map_loc, OMP_CLAUSE_MAP);
 			  OMP_CLAUSE_SET_MAP_KIND (node3,
 						   GOMP_MAP_ATTACH_DETACH);
 			  OMP_CLAUSE_DECL (node3)
@@ -4107,7 +4983,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		default:
 		  gcc_unreachable ();
 		}
-	      tree node = build_omp_clause (input_location, clause_code);
+	      tree node = build_omp_clause (gfc_get_location (&n->where),
+					    clause_code);
 	      if (n->expr == NULL
 		  || (n->expr->ref->type == REF_ARRAY
 		      && n->expr->ref->u.ar.type == AR_FULL
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 63a566ada22..ae7be9f81a8 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -839,6 +839,10 @@  tree gfc_omp_clause_assign_op (tree, tree, tree);
 tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 tree gfc_omp_clause_dtor (tree, tree);
 void gfc_omp_finish_clause (tree, gimple_seq *, bool);
+bool gfc_omp_deep_mapping_p (const gimple *, tree);
+tree gfc_omp_deep_mapping_cnt (const gimple *, tree, gimple_seq *);
+void gfc_omp_deep_mapping (const gimple *, tree, unsigned HOST_WIDE_INT, tree,
+			   tree, tree, tree, tree, gimple_seq *);
 bool gfc_omp_allocatable_p (tree);
 bool gfc_omp_scalar_p (tree, bool);
 bool gfc_omp_scalar_target_p (tree);
diff --git a/gcc/testsuite/gfortran.dg/gomp/map-alloc-comp-1.f90 b/gcc/testsuite/gfortran.dg/gomp/map-alloc-comp-1.f90
index 0c4429677bd..f48addcbcf5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/map-alloc-comp-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/map-alloc-comp-1.f90
@@ -10,5 +10,5 @@  type sct
 end type
 type(sct) var
 
-!$omp target enter data map(to:var)  ! { dg-error "allocatable components is not permitted in map clause" }
+!$omp target enter data map(to:var)
 end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-1.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-1.f90
new file mode 100644
index 00000000000..750cec93806
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-1.f90
@@ -0,0 +1,30 @@ 
+type t
+  integer :: t
+end type t
+class(t), target, allocatable :: c, ca(:)
+class(t), pointer :: p, pa(:)
+integer :: x
+allocate( t :: c, ca(5))
+p => c
+pa => ca
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target enter data map(c, ca, p, pa)
+! { dg-warning "29:Mapping of polymorphic list item 'c' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "32:Mapping of polymorphic list item 'ca' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping of polymorphic list item 'p' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "39:Mapping of polymorphic list item 'pa' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+
+!        11111111112222222222333333333344
+!2345678901234567890123456789012345678901
+!$omp target update from(c,ca), to(p,pa)
+! { dg-warning "26:Mapping of polymorphic list item 'c' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
+! { dg-warning "28:Mapping of polymorphic list item 'ca' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
+! { dg-warning "36:Mapping of polymorphic list item 'p' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
+! { dg-warning "38:Mapping of polymorphic list item 'pa' is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90
index e25db68094a..3bedc9b2461 100644
--- a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-2.f90
@@ -9,7 +9,7 @@  allocate( t :: c, ca(5))
 p => c
 pa => ca
 
-!$omp target  !  { dg-warning "Implicit mapping of polymorphic variable 'ca' is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp target  !  { dg-warning "Mapping of polymorphic list item 'ca' is unspecified behavior \\\[-Wopenmp\\\]" }
   ll = allocated(ca)
 !$omp end target 
 
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-3.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-3.f90
new file mode 100644
index 00000000000..9777ecf5156
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-3.f90
@@ -0,0 +1,23 @@ 
+subroutine sub(var, var2)
+type t
+  integer :: x
+end type t
+
+type t2
+  integer :: x
+  integer, allocatable :: y
+end type
+
+class(t) var, var2
+type(t2) :: var3, var4
+!$omp target firstprivate(var) &  ! { dg-error "Polymorphic list item 'var' at .1. in FIRSTPRIVATE clause has unspecified behavior and unsupported" }
+!$omp&       private(var2)        ! { dg-error "Polymorphic list item 'var2' at .1. in PRIVATE clause has unspecified behavior and unsupported" }
+   var%x = 5
+   var2%x = 5
+!$omp end target
+!$omp target firstprivate(var3) &  ! { dg-error "Sorry, list item 'var3' at .1. with allocatable components is not yet supported in FIRSTPRIVATE clause" }
+!$omp&       private(var4)         ! { dg-error "Sorry, list item 'var4' at .1. with allocatable components is not yet supported in PRIVATE clause" }
+   var3%x = 5
+   var4%x = 5
+!$omp end target
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-4.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-4.f90
new file mode 100644
index 00000000000..5a1a70ac918
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-4.f90
@@ -0,0 +1,9 @@ 
+subroutine one
+implicit none
+type t
+  class(*), allocatable :: ul
+end type
+
+type(t) :: var
+!$omp target enter data map(to:var)  ! { dg-error "Mapping of unlimited polymorphic list item 'var.ul' is unspecified behavior and unsupported" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-5.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-5.f90
new file mode 100644
index 00000000000..4b5814eb27d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-5.f90
@@ -0,0 +1,9 @@ 
+subroutine one
+implicit none
+type t
+  class(*), allocatable :: ul
+end type
+
+class(*), allocatable :: ul_var
+!$omp target enter data map(to: ul_var) ! { dg-error "Mapping of unlimited polymorphic list item 'ul_var' is unspecified behavior and unsupported" }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90 b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
index dd7eb3158df..752cca2ea7f 100644
--- a/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping.f90
@@ -10,37 +10,21 @@  pa => ca
 
 !        11111111112222222222333333333344
 !2345678901234567890123456789012345678901
-!$omp target enter data map(c, ca, p, pa)
-! { dg-warning "29:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
-! { dg-warning "32:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
-! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
-! { dg-warning "39:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
-
-!        11111111112222222222333333333344
-!2345678901234567890123456789012345678901
-!$omp target firstprivate(ca)  ! { dg-warning "27:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp target firstprivate(ca)  ! { dg-error "27:Polymorphic list item 'ca' at .1. in FIRSTPRIVATE clause has unspecified behavior and unsupported" }
 !$omp end target
 
-!$omp target parallel do firstprivate(ca)  ! { dg-warning "39:FIRSTPRIVATE with polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" }
+!$omp target parallel do firstprivate(ca)  ! { dg-error "39:Polymorphic list item 'ca' at .1. in FIRSTPRIVATE clause has unspecified behavior and unsupported" }
 do x = 0, 5
 end do
 
-!$omp target parallel do private(ca)  ! OK; should map declared type
+!$omp target parallel do private(ca)  ! { dg-error "34:Polymorphic list item 'ca' at .1. in PRIVATE clause has unspecified behavior and unsupported" }
 do x = 0, 5
 end do
 
-!$omp target private(ca)  ! OK; should map declared type
+!$omp target private(ca)  ! { dg-error "22:Polymorphic list item 'ca' at .1. in PRIVATE clause has unspecified behavior and unsupported" }
 block
 end block
 
-!        11111111112222222222333333333344
-!2345678901234567890123456789012345678901
-!$omp target update from(c,ca), to(p,pa)
-! { dg-warning "26:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-1 }
-! { dg-warning "28:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-2 }
-! { dg-warning "36:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-3 }
-! { dg-warning "38:Mapping polymorphic list item at .1. is unspecified behavior \\\[-Wopenmp\\\]" "" { target *-*-* } .-4 }
-
 ! -------------------------
 
 !$omp target parallel map(release: x) ! { dg-error "36:TARGET with map-type other than TO, FROM, TOFROM, or ALLOC on MAP clause" }
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index fed9d5efb6a..3d3a56cc29a 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -258,7 +258,7 @@  The OpenMP 4.5 specification is fully supported.
       device memory mapped by an array section @tab P @tab
 @item Mapping of Fortran pointer and allocatable variables, including pointer
       and allocatable components of variables
-      @tab P @tab Mapping of vars with allocatable components unsupported
+      @tab Y @tab
 @item @code{defaultmap} extensions @tab Y @tab
 @item @code{declare mapper} directive @tab N @tab
 @item @code{omp_get_supported_active_levels} routine @tab Y @tab
diff --git a/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90 b/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
new file mode 100644
index 00000000000..383ecba98b4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
@@ -0,0 +1,53 @@ 
+implicit none
+type t
+  integer, allocatable :: a, b(:)
+end type t
+type(t) :: x, y, z
+integer :: i
+
+!$omp target map(to: x)
+  if (allocated(x%a)) stop 1
+  if (allocated(x%b)) stop 2
+!$omp end target
+
+allocate(x%a, x%b(-4:6))
+x%b(:) = [(i, i=-4,6)]
+
+!$omp target map(to: x)
+  if (.not. allocated(x%a)) stop 3
+  if (.not. allocated(x%b)) stop 4
+  if (lbound(x%b,1) /= -4) stop 5
+  if (ubound(x%b,1) /= 6) stop 6
+  if (any (x%b /= [(i, i=-4,6)])) stop 7
+!$omp end target
+
+
+! The following only works with arrays due to
+! PR fortran/96668
+
+!$omp target enter data map(to: y, z)
+
+!$omp target map(to: y, z)
+  if (allocated(y%b)) stop 8
+  if (allocated(z%b)) stop 9
+!$omp end target
+
+allocate(y%b(5), z%b(3))
+y%b = 42
+z%b = 99
+
+! (implicitly) 'tofrom' mapped
+! Planned for OpenMP 6.0 (but common extension)
+! OpenMP <= 5.0 unclear
+!$omp target map(to: y)
+  if (.not.allocated(y%b)) stop 10
+  if (any (y%b /= 42)) stop 11
+!$omp end target
+
+! always map: OpenMP 5.1 (clarified)
+!$omp target map(always, tofrom: z)
+  if (.not.allocated(z%b)) stop 12
+  if (any (z%b /= 99)) stop 13
+!$omp end target
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
new file mode 100644
index 00000000000..9d48c7ca59d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
@@ -0,0 +1,121 @@ 
+type t2
+  integer x, y, z
+end type t2
+type t
+  integer, allocatable :: A
+  integer, allocatable :: B(:)
+  type(t2), allocatable :: C
+  type(t2), allocatable :: D(:,:)
+end type t
+
+type t3
+  type(t) :: Q
+  type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+
+! --------------------------------------
+! Assign + allocate
+var%A = 45
+var%B = [1,2,3]
+var%C = t2(6,5,4)
+var%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var2%A = 145
+var2%B = [991,992,993]
+var2%C = t2(996,995,994)
+var2%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+
+!$omp target map(to: var) map(tofrom: var2)
+  call foo(var, var2)
+!$omp end target
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+if (any (var2%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 12
+if (any (var2%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 12
+if (any (var2%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 12
+
+! --------------------------------------
+! Assign + allocate
+var3%Q%A = 45
+var3%Q%B = [1,2,3]
+var3%Q%C = t2(6,5,4)
+var3%Q%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+var3%R(2)%A = 45
+var3%R(2)%B = [1,2,3]
+var3%R(2)%C = t2(6,5,4)
+var3%R(2)%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var4%Q%A = 145
+var4%Q%B = [991,992,993]
+var4%Q%C = t2(996,995,994)
+var4%Q%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+var4%R(3)%A = 145
+var4%R(3)%B = [991,992,993]
+var4%R(3)%C = t2(996,995,994)
+var4%R(3)%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+!$omp target map(to: var3%Q) map(tofrom: var4%Q)
+  call foo(var3%Q, var4%Q)
+!$omp end target
+
+!$omp target map(to: var3%R(2)) map(tofrom: var4%R(3))
+  call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+if (any (var4%Q%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 16
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+if (any (var4%R(3)%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 20
+
+contains
+  subroutine foo(x, y)
+    type(t) :: x, y
+    if (x%A /= 45) stop 1
+    if (any (x%B /= [1,2,3])) stop 2
+    if (x%C%x /= 6) stop 3
+    if (x%C%y /= 5) stop 3
+    if (x%C%z /= 4) stop 3
+    if (any (x%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 4
+    if (any (x%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 4
+    if (any (x%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 4
+
+    if (y%A /= 145) stop 5
+    if (any (y%B /= [991,992,993])) stop 6
+    if (y%C%x /= 996) stop 7
+    if (y%C%y /= 995) stop 7
+    if (y%C%z /= 994) stop 7
+    if (any (y%D(:,:)%x /= reshape([199, 499, 1199, 1499], [2,2]))) stop 8
+    if (any (y%D(:,:)%y /= reshape([299, 599, 1299, 1599], [2,2]))) stop 8
+    if (any (y%D(:,:)%z /= reshape([399, 699, 1399, 1699], [2,2]))) stop 8
+
+    y%A = x%A
+    y%B(:) = x%B
+    y%C = x%C
+    y%D(:,:) = x%D(:,:)
+  end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
new file mode 100644
index 00000000000..fb9859d99a4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
@@ -0,0 +1,124 @@ 
+type t2
+  integer x, y, z
+end type t2
+type t
+  integer, allocatable :: A
+  integer, allocatable :: B(:)
+  type(t2), allocatable :: C
+  type(t2), allocatable :: D(:,:)
+end type t
+
+type t3
+  type(t) :: Q
+  type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+
+! --------------------------------------
+! Assign + allocate
+var%A = 45
+var%B = [1,2,3]
+var%C = t2(6,5,4)
+var%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var2%A = 145
+var2%B = [991,992,993]
+var2%C = t2(996,995,994)
+var2%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+
+!$omp target map(to: var%A, var%B, var%C, var%D) &
+!$omp&       map(tofrom: var2%A, var2%B, var2%C, var2%D)
+  call foo(var, var2)
+!$omp end target
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+if (any (var2%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 12
+if (any (var2%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 12
+if (any (var2%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 12
+
+! --------------------------------------
+! Assign + allocate
+var3%Q%A = 45
+var3%Q%B = [1,2,3]
+var3%Q%C = t2(6,5,4)
+var3%Q%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+var3%R(2)%A = 45
+var3%R(2)%B = [1,2,3]
+var3%R(2)%C = t2(6,5,4)
+var3%R(2)%D = reshape([t2(1,2,3), t2(4,5,6), t2(11,12,13), t2(14,15,16)], [2,2])
+
+! Assign + allocate
+var4%Q%A = 145
+var4%Q%B = [991,992,993]
+var4%Q%C = t2(996,995,994)
+var4%Q%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+var4%R(3)%A = 145
+var4%R(3)%B = [991,992,993]
+var4%R(3)%C = t2(996,995,994)
+var4%R(3)%D = reshape([t2(199,299,399), t2(499,599,699), t2(1199,1299,1399), t2(1499,1599,1699)], [2,2])
+
+!$omp target map(to: var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D) &
+!$omp&       map(tofrom: var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+  call foo(var3%Q, var4%Q)
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+if (any (var4%Q%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 16
+if (any (var4%Q%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 16
+
+!$omp target map(to: var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D) &
+!$omp&       map(tofrom: var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+  call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+if (any (var4%R(3)%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 20
+if (any (var4%R(3)%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 20
+
+contains
+  subroutine foo(x, y)
+    type(t) :: x, y
+    if (x%A /= 45) stop 1
+    if (any (x%B /= [1,2,3])) stop 2
+    if (x%C%x /= 6) stop 3
+    if (x%C%y /= 5) stop 3
+    if (x%C%z /= 4) stop 3
+    if (any (x%D(:,:)%x /= reshape([1, 4, 11, 14], [2,2]))) stop 4
+    if (any (x%D(:,:)%y /= reshape([2, 5, 12, 15], [2,2]))) stop 4
+    if (any (x%D(:,:)%z /= reshape([3, 6, 13, 16], [2,2]))) stop 4
+
+    if (y%A /= 145) stop 5
+    if (any (y%B /= [991,992,993])) stop 6
+    if (y%C%x /= 996) stop 7
+    if (y%C%y /= 995) stop 7
+    if (y%C%z /= 994) stop 7
+    if (any (y%D(:,:)%x /= reshape([199, 499, 1199, 1499], [2,2]))) stop 8
+    if (any (y%D(:,:)%y /= reshape([299, 599, 1299, 1599], [2,2]))) stop 8
+    if (any (y%D(:,:)%z /= reshape([399, 699, 1399, 1699], [2,2]))) stop 8
+
+    y%A = x%A
+    y%B(:) = x%B
+    y%C = x%C
+    y%D(:,:) = x%D(:,:)
+  end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
new file mode 100644
index 00000000000..b2e36b2a4b8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
@@ -0,0 +1,53 @@ 
+implicit none
+type t
+  integer, allocatable :: a, b(:)
+end type t
+type(t) :: x, y, z
+integer :: i
+
+!$omp target
+  if (allocated(x%a)) stop 1
+  if (allocated(x%b)) stop 2
+!$omp end target
+
+allocate(x%a, x%b(-4:6))
+x%b(:) = [(i, i=-4,6)]
+
+!$omp target
+  if (.not. allocated(x%a)) stop 3
+  if (.not. allocated(x%b)) stop 4
+  if (lbound(x%b,1) /= -4) stop 5
+  if (ubound(x%b,1) /= 6) stop 6
+  if (any (x%b /= [(i, i=-4,6)])) stop 7
+!$omp end target
+
+
+! The following only works with arrays due to
+! PR fortran/96668
+
+!$omp target enter data map(to: y, z)
+
+!$omp target
+  if (allocated(y%b)) stop 8
+  if (allocated(z%b)) stop 9
+!$omp end target
+
+allocate(y%b(5), z%b(3))
+y%b = 42
+z%b = 99
+
+! (implicitly) 'tofrom' mapped
+! Planned for OpenMP 6.0 (but common extension)
+! OpenMP <= 5.0 unclear
+!$omp target
+  if (.not.allocated(y%b)) stop 10
+  if (any (y%b /= 42)) stop 11
+!$omp end target
+
+! always map: OpenMP 5.1 (clarified)
+!$omp target map(always, tofrom: z)
+  if (.not.allocated(z%b)) stop 12
+  if (any (z%b /= 99)) stop 13
+!$omp end target
+
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
new file mode 100644
index 00000000000..48d4aea2124
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
@@ -0,0 +1,308 @@ 
+! NOTE: This code uses POINTER.
+! While map(p, var%p) etc. maps the ptr/ptr comp p / var%p (incl. allocatable comps),
+! map(var) does not map var%p.
+
+use iso_c_binding
+implicit none
+type t2
+  integer, allocatable :: x, y, z
+end type t2
+type t
+  integer, pointer :: A => null()
+  integer, pointer :: B(:) => null()
+  type(t2), pointer :: C => null()
+  type(t2), pointer :: D(:,:) => null()
+end type t
+
+type t3
+  type(t) :: Q
+  type(t) :: R(5)
+end type
+
+type(t) :: var, var2
+type(t3) :: var3, var4
+integer(c_intptr_t) :: iptr
+
+! --------------------------------------
+! Assign + allocate
+allocate (var%A, source=45)
+allocate (var%B(3), source=[1,2,3])
+allocate (var%C)
+var%C%x = 6; var%C%y = 5; var%C%z = 4
+allocate (var%D(2,2))
+var%D(1,1)%x = 1
+var%D(1,1)%y = 2
+var%D(1,1)%z = 3
+var%D(2,1)%x = 4
+var%D(2,1)%y = 5
+var%D(2,1)%z = 6
+var%D(1,2)%x = 11
+var%D(1,2)%y = 12
+var%D(1,2)%z = 13
+var%D(2,2)%x = 14
+var%D(2,2)%y = 15
+var%D(2,2)%z = 16
+
+! Assign + allocate
+allocate (var2%A, source=145)
+allocate (var2%B, source=[991,992,993])
+allocate (var2%C)
+var2%C%x = 996; var2%C%y = 995; var2%C%z = 994
+allocate (var2%D(2,2))
+var2%D(1,1)%x = 199
+var2%D(1,1)%y = 299
+var2%D(1,1)%z = 399
+var2%D(2,1)%x = 499
+var2%D(2,1)%y = 599
+var2%D(2,1)%z = 699
+var2%D(1,2)%x = 1199
+var2%D(1,2)%y = 1299
+var2%D(1,2)%z = 1399
+var2%D(2,2)%x = 1499
+var2%D(2,2)%y = 1599
+var2%D(2,2)%z = 1699
+
+block
+  integer(c_intptr_t) :: loc_a, loc_b, loc_c, loc_d, loc2_a, loc2_b, loc2_c, loc2_d
+  loc_a = loc (var%a)
+  loc_b = loc (var%b)
+  loc_c = loc (var%d)
+  loc_d = loc (var%d)
+  loc2_a = loc (var2%a)
+  loc2_b = loc (var2%b)
+  loc2_c = loc (var2%c)
+  loc2_d = loc (var2%d)
+  ! var/var2 are mapped, but the pointer components aren't
+  !$omp target map(to: var) map(tofrom: var2)
+    if (loc_a /= loc (var%a)) stop 31
+    if (loc_b /= loc (var%b)) stop 32
+    if (loc_c /= loc (var%d)) stop 33
+    if (loc_d /= loc (var%d)) stop 34
+    if (loc2_a /= loc (var2%a)) stop 35
+    if (loc2_b /= loc (var2%b)) stop 36
+    if (loc2_c /= loc (var2%c)) stop 37
+    if (loc2_d /= loc (var2%d)) stop 38
+  !$omp end target
+  if (loc_a /= loc (var%a)) stop 41
+  if (loc_b /= loc (var%b)) stop 42
+  if (loc_c /= loc (var%d)) stop 43
+  if (loc_d /= loc (var%d)) stop 44
+  if (loc2_a /= loc (var2%a)) stop 45
+  if (loc2_b /= loc (var2%b)) stop 46
+  if (loc2_c /= loc (var2%c)) stop 47
+  if (loc2_d /= loc (var2%d)) stop 48
+end block
+
+block
+  ! Map only (all) components, but this maps also the alloc comps
+  !$omp target map(to: var%a, var%b, var%c, var%d) map(tofrom: var2%a, var2%b, var2%c, var2%d)
+    call foo (var,var2)
+  !$omp end target
+end block
+
+if (var2%A /= 45) stop 9
+if (any (var2%B /= [1,2,3])) stop 10
+if (var2%C%x /= 6) stop 11
+if (var2%C%y /= 5) stop 11
+if (var2%C%z /= 4) stop 11
+block
+  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+  tmp_x = reshape([1, 4, 11, 14], [2,2])
+  tmp_y = reshape([2, 5, 12, 15], [2,2])
+  tmp_z = reshape([3, 6, 13, 16], [2,2])
+  do j = 1, 2
+    do i = 1, 2
+      if (var2%D(i,j)%x /= tmp_x(i,j)) stop 12
+      if (var2%D(i,j)%y /= tmp_y(i,j)) stop 12
+      if (var2%D(i,j)%z /= tmp_z(i,j)) stop 12
+    end do
+  end do
+end block
+
+! Extra deallocates due to PR fortran/104697
+deallocate(var%C%x, var%C%y, var%C%z)
+deallocate(var%D(1,1)%x, var%D(1,1)%y, var%D(1,1)%z)
+deallocate(var%D(2,1)%x, var%D(2,1)%y, var%D(2,1)%z)
+deallocate(var%D(1,2)%x, var%D(1,2)%y, var%D(1,2)%z)
+deallocate(var%D(2,2)%x, var%D(2,2)%y, var%D(2,2)%z)
+deallocate(var%A, var%B, var%C, var%D)
+
+deallocate(var2%C%x, var2%C%y, var2%C%z)
+deallocate(var2%D(1,1)%x, var2%D(1,1)%y, var2%D(1,1)%z)
+deallocate(var2%D(2,1)%x, var2%D(2,1)%y, var2%D(2,1)%z)
+deallocate(var2%D(1,2)%x, var2%D(1,2)%y, var2%D(1,2)%z)
+deallocate(var2%D(2,2)%x, var2%D(2,2)%y, var2%D(2,2)%z)
+deallocate(var2%A, var2%B, var2%C, var2%D)
+
+! --------------------------------------
+! Assign + allocate
+allocate (var3%Q%A, source=45)
+allocate (var3%Q%B, source=[1,2,3])
+allocate (var3%Q%C, source=t2(6,5,4))
+allocate (var3%Q%D(2,2))
+var3%Q%D(1,1) = t2(1,2,3)
+var3%Q%D(2,1) = t2(4,5,6)
+var3%Q%D(1,2) = t2(11,12,13)
+var3%Q%D(2,2) = t2(14,15,16)
+
+allocate (var3%R(2)%A, source=45)
+allocate (var3%R(2)%B, source=[1,2,3])
+allocate (var3%R(2)%C, source=t2(6,5,4))
+allocate (var3%R(2)%D(2,2))
+var3%R(2)%D(1,1) = t2(1,2,3)
+var3%R(2)%D(2,1) = t2(4,5,6)
+var3%R(2)%D(1,2) = t2(11,12,13)
+var3%R(2)%D(2,2) = t2(14,15,16)
+
+! Assign + allocate
+allocate (var4%Q%A, source=145)
+allocate (var4%Q%B, source=[991,992,993])
+allocate (var4%Q%C, source=t2(996,995,994))
+allocate (var4%Q%D(2,2))
+var4%Q%D(1,1) = t2(199,299,399)
+var4%Q%D(2,1) = t2(499,599,699)
+var4%Q%D(1,2) = t2(1199,1299,1399)
+var4%Q%D(2,2) = t2(1499,1599,1699)
+
+allocate (var4%R(3)%A, source=145)
+allocate (var4%R(3)%B, source=[991,992,993])
+allocate (var4%R(3)%C, source=t2(996,995,994))
+allocate (var4%R(3)%D(2,2))
+var4%R(3)%D(1,1) = t2(199,299,399)
+var4%R(3)%D(2,1) = t2(499,599,699)
+var4%R(3)%D(1,2) = t2(1199,1299,1399)
+var4%R(3)%D(2,2) = t2(1499,1599,1699)
+
+!$omp target map(to: var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D) &
+!$omp&       map(tofrom: var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+  call foo(var3%Q, var4%Q)
+!$omp end target
+
+iptr = loc(var3%R(2)%A)
+
+!$omp target map(to: var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D) &
+!$omp&       map(tofrom: var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+  call foo(var3%R(2), var4%R(3))
+!$omp end target
+
+if (var4%Q%A /= 45) stop 13
+if (any (var4%Q%B /= [1,2,3])) stop 14
+if (var4%Q%C%x /= 6) stop 15
+if (var4%Q%C%y /= 5) stop 15
+if (var4%Q%C%z /= 4) stop 15
+block
+  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+  tmp_x = reshape([1, 4, 11, 14], [2,2])
+  tmp_y = reshape([2, 5, 12, 15], [2,2])
+  tmp_z = reshape([3, 6, 13, 16], [2,2])
+  do j = 1, 2
+    do i = 1, 2
+      if (var4%Q%D(i,j)%x /= tmp_x(i,j)) stop 16
+      if (var4%Q%D(i,j)%y /= tmp_y(i,j)) stop 16
+      if (var4%Q%D(i,j)%z /= tmp_z(i,j)) stop 16
+    end do
+  end do
+end block
+
+! Cf. PR fortran/104696
+! { dg-output "valid mapping, OK" { xfail { offload_device_nonshared_as } } }
+if (iptr /= loc(var3%R(2)%A)) then
+  print *, "invalid mapping, cf. PR fortran/104696"
+else
+
+if (var4%R(3)%A /= 45) stop 17
+if (any (var4%R(3)%B /= [1,2,3])) stop 18
+if (var4%R(3)%C%x /= 6) stop 19
+if (var4%R(3)%C%y /= 5) stop 19
+if (var4%R(3)%C%z /= 4) stop 19
+block
+  integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+  tmp_x = reshape([1, 4, 11, 14], [2,2])
+  tmp_y = reshape([2, 5, 12, 15], [2,2])
+  tmp_z = reshape([3, 6, 13, 16], [2,2])
+  do j = 1, 2
+    do i = 1, 2
+      if (var4%R(3)%D(i,j)%x /= tmp_x(i,j)) stop 20
+      if (var4%R(3)%D(i,j)%y /= tmp_y(i,j)) stop 20
+      if (var4%R(3)%D(i,j)%z /= tmp_z(i,j)) stop 20
+    end do
+  end do
+end block
+
+! Extra deallocates due to PR fortran/104697
+deallocate(var3%Q%C%x, var3%Q%D(1,1)%x, var3%Q%D(2,1)%x, var3%Q%D(1,2)%x, var3%Q%D(2,2)%x)
+deallocate(var3%Q%C%y, var3%Q%D(1,1)%y, var3%Q%D(2,1)%y, var3%Q%D(1,2)%y, var3%Q%D(2,2)%y)
+deallocate(var3%Q%C%z, var3%Q%D(1,1)%z, var3%Q%D(2,1)%z, var3%Q%D(1,2)%z, var3%Q%D(2,2)%z)
+deallocate(var3%Q%A, var3%Q%B, var3%Q%C, var3%Q%D)
+
+deallocate(var4%Q%C%x, var4%Q%D(1,1)%x, var4%Q%D(2,1)%x, var4%Q%D(1,2)%x, var4%Q%D(2,2)%x)
+deallocate(var4%Q%C%y, var4%Q%D(1,1)%y, var4%Q%D(2,1)%y, var4%Q%D(1,2)%y, var4%Q%D(2,2)%y)
+deallocate(var4%Q%C%z, var4%Q%D(1,1)%z, var4%Q%D(2,1)%z, var4%Q%D(1,2)%z, var4%Q%D(2,2)%z)
+deallocate(var4%Q%A, var4%Q%B, var4%Q%C, var4%Q%D)
+
+deallocate(var3%R(2)%C%x, var3%R(2)%D(1,1)%x, var3%R(2)%D(2,1)%x, var3%R(2)%D(1,2)%x, var3%R(2)%D(2,2)%x)
+deallocate(var3%R(2)%C%y, var3%R(2)%D(1,1)%y, var3%R(2)%D(2,1)%y, var3%R(2)%D(1,2)%y, var3%R(2)%D(2,2)%y)
+deallocate(var3%R(2)%C%z, var3%R(2)%D(1,1)%z, var3%R(2)%D(2,1)%z, var3%R(2)%D(1,2)%z, var3%R(2)%D(2,2)%z)
+deallocate(var3%R(2)%A, var3%R(2)%B, var3%R(2)%C, var3%R(2)%D)
+
+deallocate(var4%R(3)%C%x, var4%R(3)%D(1,1)%x, var4%R(3)%D(2,1)%x, var4%R(3)%D(1,2)%x, var4%R(3)%D(2,2)%x)
+deallocate(var4%R(3)%C%y, var4%R(3)%D(1,1)%y, var4%R(3)%D(2,1)%y, var4%R(3)%D(1,2)%y, var4%R(3)%D(2,2)%y)
+deallocate(var4%R(3)%C%z, var4%R(3)%D(1,1)%z, var4%R(3)%D(2,1)%z, var4%R(3)%D(1,2)%z, var4%R(3)%D(2,2)%z)
+deallocate(var4%R(3)%A, var4%R(3)%B, var4%R(3)%C, var4%R(3)%D)
+
+  print *, "valid mapping, OK"
+endif
+
+contains
+  subroutine foo(x, y)
+    type(t) :: x, y
+    intent(in) :: x
+    intent(inout) :: y
+    integer :: tmp_x(2,2), tmp_y(2,2), tmp_z(2,2), i, j
+    if (x%A /= 45) stop 1
+    if (any (x%B /= [1,2,3])) stop 2
+    if (x%C%x /= 6) stop 3
+    if (x%C%y /= 5) stop 3
+    if (x%C%z /= 4) stop 3
+
+    tmp_x = reshape([1, 4, 11, 14], [2,2])
+    tmp_y = reshape([2, 5, 12, 15], [2,2])
+    tmp_z = reshape([3, 6, 13, 16], [2,2])
+    do j = 1, 2
+      do i = 1, 2
+        if (x%D(i,j)%x /= tmp_x(i,j)) stop 4
+        if (x%D(i,j)%y /= tmp_y(i,j)) stop 4
+        if (x%D(i,j)%z /= tmp_z(i,j)) stop 4
+      end do
+    end do
+
+    if (y%A /= 145) stop 5
+    if (any (y%B /= [991,992,993])) stop 6
+    if (y%C%x /= 996) stop 7
+    if (y%C%y /= 995) stop 7
+    if (y%C%z /= 994) stop 7
+    tmp_x = reshape([199, 499, 1199, 1499], [2,2])
+    tmp_y = reshape([299, 599, 1299, 1599], [2,2])
+    tmp_z = reshape([399, 699, 1399, 1699], [2,2])
+    do j = 1, 2
+      do i = 1, 2
+        if (y%D(i,j)%x /= tmp_x(i,j)) stop 8
+        if (y%D(i,j)%y /= tmp_y(i,j)) stop 8
+        if (y%D(i,j)%z /= tmp_z(i,j)) stop 8
+      end do
+    end do
+
+    y%A = x%A
+    y%B(:) = x%B
+    y%C%x = x%C%x
+    y%C%y = x%C%y
+    y%C%z = x%C%z
+    do j = 1, 2
+      do i = 1, 2
+        y%D(i,j)%x = x%D(i,j)%x
+        y%D(i,j)%y = x%D(i,j)%y
+        y%D(i,j)%z = x%D(i,j)%z
+      end do
+    end do
+  end
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
new file mode 100644
index 00000000000..1493c5fb031
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
@@ -0,0 +1,672 @@ 
+module m
+  implicit none (type, external)
+  type t
+    integer, allocatable :: arr(:,:)
+    integer :: var
+    integer, allocatable :: slr
+  end type t
+
+contains
+
+  subroutine check_it (is_present, dummy_alloced, inner_alloc, &
+                       scalar, array, a_scalar, a_array, &
+                       l_scalar, l_array, la_scalar, la_array, &
+                       opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+    type(t), intent(inout) :: &
+            scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
+            a_opt_scalar, a_opt_array(:,:), &
+            l_scalar, l_array(:,:), la_scalar, la_array(:,:)
+    optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+    allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+    logical, value :: is_present, dummy_alloced, inner_alloc
+    integer :: i, j, k, l
+
+    ! CHECK VALUE
+    if (scalar%var /= 42) stop 1
+    if (l_scalar%var /= 42) stop 1
+    if (is_present) then
+      if (opt_scalar%var /= 42) stop 2
+    end if
+    if (any (shape(array) /= [3,2])) stop 1
+    if (any (shape(l_array) /= [3,2])) stop 1
+    if (is_present) then
+      if (any (shape(opt_array) /= [3,2])) stop 1
+    end if
+    do j = 1, 2
+      do i = 1, 3
+        if (array(i,j)%var /= i*97 + 100*41*j) stop 3
+        if (l_array(i,j)%var /= i*97 + 100*41*j) stop 3
+        if (is_present) then
+          if (opt_array(i,j)%var /= i*97 + 100*41*j) stop 4
+        end if
+      end do
+    end do
+
+    if (dummy_alloced) then
+      if (a_scalar%var /= 42) stop 1
+      if (la_scalar%var /= 42) stop 1
+      if (is_present) then
+        if (a_opt_scalar%var /= 42) stop 1
+      end if
+      if (any (shape(a_array) /= [3,2])) stop 1
+      if (any (shape(la_array) /= [3,2])) stop 1
+      if (is_present) then
+        if (any (shape(a_opt_array) /= [3,2])) stop 1
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          if (a_array(i,j)%var /= i*97 + 100*41*j) stop 1
+          if (la_array(i,j)%var /= i*97 + 100*41*j) stop 1
+          if (is_present) then
+            if (a_opt_array(i,j)%var /= i*97 + 100*41*j) stop 1
+          end if
+        end do
+      end do
+    else
+      if (allocated (a_scalar)) stop 1
+      if (allocated (la_scalar)) stop 1
+      if (allocated (a_array)) stop 1
+      if (allocated (la_array)) stop 1
+      if (is_present) then
+        if (allocated (a_opt_scalar)) stop 1
+        if (allocated (a_opt_array)) stop 1
+      end if
+    end if
+
+    if (inner_alloc) then
+      if (scalar%slr /= 467) stop 5
+      if (l_scalar%slr /= 467) stop 5
+      if (a_scalar%slr /= 467) stop 6
+      if (la_scalar%slr /= 467) stop 6
+      if (is_present) then
+        if (opt_scalar%slr /= 467) stop 7
+        if (a_opt_scalar%slr /= 467) stop 8
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          if (array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 9
+          if (l_array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 9
+          if (a_array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 10
+          if (la_array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 10
+          if (is_present) then
+            if (opt_array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 11
+            if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j)  + 467) stop 12
+          end if
+        end do
+      end do
+
+      do l = 1, 5
+        do k = 1, 4
+          if (any (shape(scalar%arr) /= [4,5])) stop 1
+          if (any (shape(l_scalar%arr) /= [4,5])) stop 1
+          if (any (shape(a_scalar%arr) /= [4,5])) stop 1
+          if (any (shape(la_scalar%arr) /= [4,5])) stop 1
+          if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
+          if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 13
+          if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
+          if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 14
+          if (is_present) then
+            if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
+            if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
+            if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 15
+            if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467) stop 16
+          end if
+        end do
+      end do
+      do j = 1, 2
+        do i = 1, 3
+          if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
+          if (is_present) then
+            if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
+            if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
+          endif
+          do l = 1, j
+            do k = 1, i
+              if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
+              if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 17
+              if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
+              if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 18
+              if (is_present) then
+                if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 19
+                if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l) stop 20
+              end if
+            end do
+          end do
+        end do
+      end do
+    else if (dummy_alloced) then
+      if (allocated (scalar%slr)) stop 1
+      if (allocated (l_scalar%slr)) stop 1
+      if (allocated (a_scalar%slr)) stop 1
+      if (allocated (la_scalar%slr)) stop 1
+      if (is_present) then
+        if (allocated (opt_scalar%slr)) stop 1
+        if (allocated (a_opt_scalar%slr)) stop 1
+      endif
+      if (allocated (scalar%arr)) stop 1
+      if (allocated (l_scalar%arr)) stop 1
+      if (allocated (a_scalar%arr)) stop 1
+      if (allocated (la_scalar%arr)) stop 1
+      if (is_present) then
+        if (allocated (opt_scalar%arr)) stop 1
+        if (allocated (a_opt_scalar%arr)) stop 1
+      endif
+    end if
+
+    ! SET VALUE
+    scalar%var = 42 + 13
+    l_scalar%var = 42 + 13
+    if (is_present) then
+      opt_scalar%var = 42 + 13
+    endif
+    do j = 1, 2
+      do i = 1, 3
+        array(i,j)%var = i*97 + 100*41*j + 13
+        l_array(i,j)%var = i*97 + 100*41*j + 13
+        if (is_present) then
+          opt_array(i,j)%var = i*97 + 100*41*j + 13
+        end if
+      end do
+    end do
+
+    if (dummy_alloced) then
+      a_scalar%var = 42 + 13
+      la_scalar%var = 42 + 13
+      if (is_present) then
+        a_opt_scalar%var = 42 + 13
+      endif
+      do j = 1, 2
+        do i = 1, 3
+          a_array(i,j)%var = i*97 + 100*41*j + 13
+          la_array(i,j)%var = i*97 + 100*41*j + 13
+          if (is_present) then
+            a_opt_array(i,j)%var = i*97 + 100*41*j + 13
+          endif
+        end do
+      end do
+    end if
+
+    if (inner_alloc) then
+      scalar%slr = 467 + 13
+      l_scalar%slr = 467 + 13
+      a_scalar%slr = 467 + 13
+      la_scalar%slr = 467 + 13
+      if (is_present) then
+        opt_scalar%slr = 467 + 13
+        a_opt_scalar%slr = 467 + 13
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+          l_array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+          a_array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+          la_array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+          if (is_present) then
+            opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+            a_opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467 + 13
+          end if
+        end do
+      end do
+
+      do l = 1, 5
+        do k = 1, 4
+          scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+          l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+          a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+          la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+          if (is_present) then
+            opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+            a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467 + 13
+          end if
+        end do
+      end do
+      do j = 1, 2
+        do i = 1, 3
+          do l = 1, j
+            do k = 1, i
+              array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+              l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+              a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+              la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+              if (is_present) then
+                opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+                a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l + 13
+              end if
+            end do
+          end do
+        end do
+      end do
+    end if
+
+  end subroutine
+  subroutine check_reset (is_present, dummy_alloced, inner_alloc, &
+                          scalar, array, a_scalar, a_array, &
+                          l_scalar, l_array, la_scalar, la_array, &
+                          opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+    type(t), intent(inout) :: &
+            scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:), &
+            a_opt_scalar, a_opt_array(:,:), &
+            l_scalar, l_array(:,:), la_scalar, la_array(:,:)
+    optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+    allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+    logical, value :: is_present, dummy_alloced, inner_alloc
+    integer :: i, j, k, l
+
+    ! CHECK VALUE
+    if (scalar%var /= 42 + 13) stop 1
+    if (l_scalar%var /= 42 + 13) stop 1
+    if (is_present) then
+      if (opt_scalar%var /= 42 + 13) stop 2
+    end if
+    if (any (shape(array) /= [3,2])) stop 1
+    if (any (shape(l_array) /= [3,2])) stop 1
+    if (is_present) then
+      if (any (shape(opt_array) /= [3,2])) stop 1
+    end if
+    do j = 1, 2
+      do i = 1, 3
+        if (array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
+        if (l_array(i,j)%var /= i*97 + 100*41*j + 13) stop 3
+        if (is_present) then
+          if (opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 4
+        end if
+      end do
+    end do
+
+    if (dummy_alloced) then
+      if (a_scalar%var /= 42 + 13) stop 1
+      if (la_scalar%var /= 42 + 13) stop 1
+      if (is_present) then
+        if (a_opt_scalar%var /= 42 + 13) stop 1
+      end if
+      if (any (shape(a_array) /= [3,2])) stop 1
+      if (any (shape(la_array) /= [3,2])) stop 1
+      if (is_present) then
+        if (any (shape(a_opt_array) /= [3,2])) stop 1
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          if (a_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+          if (la_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+          if (is_present) then
+            if (a_opt_array(i,j)%var /= i*97 + 100*41*j + 13) stop 1
+          end if
+        end do
+      end do
+    else
+      if (allocated (a_scalar)) stop 1
+      if (allocated (la_scalar)) stop 1
+      if (allocated (a_array)) stop 1
+      if (allocated (la_array)) stop 1
+      if (is_present) then
+        if (allocated (a_opt_scalar)) stop 1
+        if (allocated (a_opt_array)) stop 1
+      end if
+    end if
+
+    if (inner_alloc) then
+      if (scalar%slr /= 467 + 13) stop 5
+      if (l_scalar%slr /= 467 + 13) stop 5
+      if (a_scalar%slr /= 467 + 13) stop 6
+      if (la_scalar%slr /= 467 + 13) stop 6
+      if (is_present) then
+        if (opt_scalar%slr /= 467 + 13) stop 7
+        if (a_opt_scalar%slr /= 467 + 13) stop 8
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          if (array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 9
+          if (l_array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 9
+          if (a_array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 10
+          if (la_array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 10
+          if (is_present) then
+            if (opt_array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 11
+            if (a_opt_array(i,j)%slr /= (i*97 + 100*41*j)  + 467 + 13) stop 12
+          end if
+        end do
+      end do
+
+      do l = 1, 5
+        do k = 1, 4
+          if (any (shape(scalar%arr) /= [4,5])) stop 1
+          if (any (shape(l_scalar%arr) /= [4,5])) stop 1
+          if (any (shape(a_scalar%arr) /= [4,5])) stop 1
+          if (any (shape(la_scalar%arr) /= [4,5])) stop 1
+          if (scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
+          if (l_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 13
+          if (a_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
+          if (la_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 14
+          if (is_present) then
+            if (any (shape(opt_scalar%arr) /= [4,5])) stop 1
+            if (any (shape(a_opt_scalar%arr) /= [4,5])) stop 1
+            if (opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 15
+            if (a_opt_scalar%arr(k,l) /= (i*27 + 1000*11*j) + 467 + 13) stop 16
+          end if
+        end do
+      end do
+      do j = 1, 2
+        do i = 1, 3
+          if (any (shape(array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(l_array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(a_array(i,j)%arr) /= [i,j])) stop 1
+          if (any (shape(la_array(i,j)%arr) /= [i,j])) stop 1
+          if (is_present) then
+            if (any (shape(opt_array(i,j)%arr) /= [i,j])) stop 1
+            if (any (shape(a_opt_array(i,j)%arr) /= [i,j])) stop 1
+          endif
+          do l = 1, j
+            do k = 1, i
+              if (array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
+              if (l_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 17
+              if (a_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
+              if (la_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 18
+              if (is_present) then
+                if (opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 19
+                if (a_opt_array(i,j)%arr(k,l) /= i*27 + 1000*11*j + 467 + 3*k +53*l + 13) stop 20
+              end if
+            end do
+          end do
+        end do
+      end do
+    else if (dummy_alloced) then
+      if (allocated (scalar%slr)) stop 1
+      if (allocated (l_scalar%slr)) stop 1
+      if (allocated (a_scalar%slr)) stop 1
+      if (allocated (la_scalar%slr)) stop 1
+      if (is_present) then
+        if (allocated (opt_scalar%slr)) stop 1
+        if (allocated (a_opt_scalar%slr)) stop 1
+      endif
+      if (allocated (scalar%arr)) stop 1
+      if (allocated (l_scalar%arr)) stop 1
+      if (allocated (a_scalar%arr)) stop 1
+      if (allocated (la_scalar%arr)) stop 1
+      if (is_present) then
+        if (allocated (opt_scalar%arr)) stop 1
+        if (allocated (a_opt_scalar%arr)) stop 1
+      endif
+    end if
+
+    ! (RE)SET VALUE
+    scalar%var = 42
+    l_scalar%var = 42
+    if (is_present) then
+      opt_scalar%var = 42
+    endif
+    do j = 1, 2
+      do i = 1, 3
+        array(i,j)%var = i*97 + 100*41*j
+        l_array(i,j)%var = i*97 + 100*41*j
+        if (is_present) then
+          opt_array(i,j)%var = i*97 + 100*41*j
+        end if
+      end do
+    end do
+
+    if (dummy_alloced) then
+      a_scalar%var = 42
+      la_scalar%var = 42
+      if (is_present) then
+        a_opt_scalar%var = 42
+      endif
+      do j = 1, 2
+        do i = 1, 3
+          a_array(i,j)%var = i*97 + 100*41*j
+          la_array(i,j)%var = i*97 + 100*41*j
+          if (is_present) then
+            a_opt_array(i,j)%var = i*97 + 100*41*j
+          endif
+        end do
+      end do
+    end if
+
+    if (inner_alloc) then
+      scalar%slr = 467
+      l_scalar%slr = 467
+      a_scalar%slr = 467
+      la_scalar%slr = 467
+      if (is_present) then
+        opt_scalar%slr = 467
+        a_opt_scalar%slr = 467
+      end if
+      do j = 1, 2
+        do i = 1, 3
+          array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          l_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          a_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          la_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          if (is_present) then
+            opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+            a_opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          end if
+        end do
+      end do
+
+      do l = 1, 5
+        do k = 1, 4
+          scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          if (is_present) then
+            opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+            a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          end if
+        end do
+      end do
+      do j = 1, 2
+        do i = 1, 3
+          do l = 1, j
+            do k = 1, i
+              array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              if (is_present) then
+                opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+                a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              end if
+            end do
+          end do
+        end do
+      end do
+    end if
+  end subroutine
+
+  subroutine test(scalar, array, a_scalar, a_array, opt_scalar, opt_array, &
+                  a_opt_scalar, a_opt_array)
+    type(t) :: scalar, array(:,:), opt_scalar, opt_array(:,:), a_scalar, a_array(:,:)
+    type(t) :: a_opt_scalar, a_opt_array(:,:)
+    type(t) :: l_scalar, l_array(3,2), la_scalar, la_array(:,:)
+    allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array, la_scalar, la_array
+    optional :: opt_scalar, opt_array, a_opt_scalar, a_opt_array
+
+    integer :: i, j, k, l
+    logical :: is_present, dummy_alloced, local_alloced, inner_alloc
+    is_present = present(opt_scalar)
+    dummy_alloced = allocated(a_scalar)
+    inner_alloc = allocated(scalar%slr)
+
+    l_scalar%var = 42
+    do j = 1, 2
+      do i = 1, 3
+        l_array(i,j)%var = i*97 + 100*41*j
+      end do
+    end do
+
+    if (dummy_alloced) then
+      allocate(la_scalar, la_array(3,2))
+      a_scalar%var = 42
+      la_scalar%var = 42
+      do j = 1, 2
+        do i = 1, 3
+          l_array(i,j)%var = i*97 + 100*41*j
+          la_array(i,j)%var = i*97 + 100*41*j
+        end do
+      end do
+    end if
+
+    if (inner_alloc) then
+      l_scalar%slr = 467
+      la_scalar%slr = 467
+      do j = 1, 2
+        do i = 1, 3
+          l_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+          la_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+        end do
+      end do
+
+      allocate(l_scalar%arr(4,5), la_scalar%arr(4,5))
+      do l = 1, 5
+        do k = 1, 4
+          l_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+          la_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+        end do
+      end do
+      do j = 1, 2
+        do i = 1, 3
+          allocate(l_array(i,j)%arr(i,j), la_array(i,j)%arr(i,j))
+          do l = 1, j
+            do k = 1, i
+              l_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+              la_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+            end do
+          end do
+        end do
+      end do
+    end if
+
+    ! implicit mapping
+    !$omp target
+      if (is_present) then
+        call check_it (is_present, dummy_alloced, inner_alloc, &
+                       scalar, array, a_scalar, a_array, &
+                       l_scalar, l_array, la_scalar, la_array, &
+                       opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+      else
+        call check_it (is_present, dummy_alloced, inner_alloc, &
+                       scalar, array, a_scalar, a_array, &
+                       l_scalar, l_array, la_scalar, la_array)
+      end if
+    !$omp end target
+
+    if (is_present) then
+      call check_reset (is_present, dummy_alloced, inner_alloc, &
+                        scalar, array, a_scalar, a_array, &
+                        l_scalar, l_array, la_scalar, la_array, &
+                        opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+    else
+      call check_reset (is_present, dummy_alloced, inner_alloc, &
+                        scalar, array, a_scalar, a_array, &
+                        l_scalar, l_array, la_scalar, la_array)
+    endif
+
+    ! explicit mapping
+    !$omp target map(scalar, array, opt_scalar, opt_array, a_scalar, a_array) &
+    !$omp&       map(a_opt_scalar, a_opt_array) &
+    !$omp&       map(l_scalar, l_array, la_scalar, la_array)
+      if (is_present) then
+        call check_it (is_present, dummy_alloced, inner_alloc, &
+                       scalar, array, a_scalar, a_array, &
+                       l_scalar, l_array, la_scalar, la_array, &
+                       opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+      else
+        call check_it (is_present, dummy_alloced, inner_alloc, &
+                       scalar, array, a_scalar, a_array, &
+                       l_scalar, l_array, la_scalar, la_array)
+      endif
+    !$omp end target
+
+    if (is_present) then
+      call check_reset (is_present, dummy_alloced, inner_alloc, &
+                        scalar, array, a_scalar, a_array, &
+                        l_scalar, l_array, la_scalar, la_array, &
+                        opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+    else
+      call check_reset (is_present, dummy_alloced, inner_alloc, &
+                        scalar, array, a_scalar, a_array, &
+                        l_scalar, l_array, la_scalar, la_array)
+    endif
+  end subroutine
+end module
+
+program main
+  use m
+  implicit none (type, external)
+  type(t) :: scalar, array(3,2), opt_scalar, opt_array(3,2), a_scalar, a_array(:,:)
+  type(t) :: a_opt_scalar, a_opt_array(:,:)
+  allocatable :: a_scalar, a_array, a_opt_scalar, a_opt_array
+  integer :: i, j, k, l, n
+
+  scalar%var = 42
+  opt_scalar%var = 42
+  do j = 1, 2
+    do i = 1, 3
+      array(i,j)%var = i*97 + 100*41*j
+      opt_array(i,j)%var = i*97 + 100*41*j
+    end do
+  end do
+
+  ! unallocated
+  call test (scalar, array, a_scalar, a_array)
+  call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+  ! allocated
+  allocate(a_scalar, a_opt_scalar, a_array(3,2), a_opt_array(3,2))
+  a_scalar%var = 42
+  a_opt_scalar%var = 42
+  do j = 1, 2
+    do i = 1, 3
+      a_array(i,j)%var = i*97 + 100*41*j
+      a_opt_array(i,j)%var = i*97 + 100*41*j
+    end do
+  end do
+
+  call test (scalar, array, a_scalar, a_array)
+  call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+  ! comps allocated
+  scalar%slr = 467
+  a_scalar%slr = 467
+  opt_scalar%slr = 467
+  a_opt_scalar%slr = 467
+  do j = 1, 2
+    do i = 1, 3
+      array(i,j)%slr = (i*97 + 100*41*j)  + 467
+      a_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+      opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+      a_opt_array(i,j)%slr = (i*97 + 100*41*j)  + 467
+    end do
+  end do
+
+  allocate(scalar%arr(4,5), a_scalar%arr(4,5), opt_scalar%arr(4,5), a_opt_scalar%arr(4,5))
+  do l = 1, 5
+    do k = 1, 4
+      scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+      a_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+      opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+      a_opt_scalar%arr(k,l) = (i*27 + 1000*11*j) + 467
+    end do
+  end do
+  do j = 1, 2
+    do i = 1, 3
+      allocate(array(i,j)%arr(i,j), a_array(i,j)%arr(i,j), opt_array(i,j)%arr(i,j), a_opt_array(i,j)%arr(i,j))
+      do l = 1, j
+        do k = 1, i
+          array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+          a_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+          opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+          a_opt_array(i,j)%arr(k,l) = i*27 + 1000*11*j + 467 + 3*k +53*l
+        end do
+      end do
+    end do
+  end do
+
+  call test (scalar, array, a_scalar, a_array)
+  call test (scalar, array, a_scalar, a_array, opt_scalar, opt_array, a_opt_scalar, a_opt_array)
+
+  deallocate(a_scalar, a_opt_scalar, a_array, a_opt_array)
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
new file mode 100644
index 00000000000..f5a286ef0b7
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
@@ -0,0 +1,268 @@ 
+module m
+  implicit none (type, external)
+  type t
+    integer, allocatable :: A(:)
+  end type t
+  type t2
+    type(t), allocatable :: vT
+    integer, allocatable :: x
+  end type t2
+
+contains
+
+  subroutine test_alloc()
+    type(t) :: var
+    type(t), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%A(4), var2%A(5))
+
+    !$omp target enter data map(alloc: var, var2)
+    !$omp target
+      if (.not. allocated(Var2)) stop 1
+      if (.not. allocated(Var%A)) stop 2
+      if (.not. allocated(Var2%A)) stop 3
+      if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+      if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+      var%A = [1,2,3,4]
+      var2%A = [11,22,33,44,55]
+    !$omp end target
+    !$omp target exit data map(from: var, var2)
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%A)) error stop
+    if (.not. allocated(Var2%A)) error stop
+    if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+    if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+    if (any(var%A /= [1,2,3,4])) error stop
+    if (any(var2%A /= [11,22,33,44,55])) error stop
+  end subroutine test_alloc
+
+  subroutine test2_alloc()
+    type(t2) :: var
+    type(t2), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%x, var2%x)
+
+    !$omp target enter data map(alloc: var, var2)
+    !$omp target
+      if (.not. allocated(Var2)) stop 6
+      if (.not. allocated(Var%x)) stop 7
+      if (.not. allocated(Var2%x)) stop 8
+      var%x = 42
+      var2%x = 43
+    !$omp end target
+    !$omp target exit data map(from: var, var2)
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+    if (var%x /= 42) error stop
+    if (var2%x /= 43) error stop
+
+    allocate(var%vt, var2%vt)
+    allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+    !$omp target enter data map(alloc: var, var2)
+    !$omp target
+      if (.not. allocated(Var2)) stop 11
+      if (.not. allocated(Var%x)) stop 12
+      if (.not. allocated(Var2%x)) stop 13
+      if (.not. allocated(Var%vt)) stop 14
+      if (.not. allocated(Var2%vt)) stop 15
+      if (.not. allocated(Var%vt%a)) stop 16
+      if (.not. allocated(Var2%vt%a)) stop 17
+      var%x = 42
+      var2%x = 43
+      if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+      if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+      var%vt%A = [1,2,3,4,5]
+      var2%vt%A = [11,22,33,44,55]
+    !$omp end target
+    !$omp target exit data map(from: var, var2)
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+    if (.not. allocated(Var%vt)) error stop
+    if (.not. allocated(Var2%vt)) error stop
+    if (.not. allocated(Var%vt%a)) error stop
+    if (.not. allocated(Var2%vt%a)) error stop
+    if (var%x /= 42) error stop
+    if (var2%x /= 43) error stop
+    if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+    if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+    if (any(var%vt%A /= [1,2,3,4,5])) error stop
+    if (any(var2%vt%A /= [11,22,33,44,55])) error stop
+  end subroutine test2_alloc
+
+
+  subroutine test_alloc_target()
+    type(t) :: var
+    type(t), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%A(4), var2%A(5))
+
+    !$omp target map(alloc: var, var2)
+      if (.not. allocated(Var2)) stop 1
+      if (.not. allocated(Var%A)) stop 2
+      if (.not. allocated(Var2%A)) stop 3
+      if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+      if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+      var%A = [1,2,3,4]
+      var2%A = [11,22,33,44,55]
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%A)) error stop
+    if (.not. allocated(Var2%A)) error stop
+    if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+    if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+  end subroutine test_alloc_target
+
+  subroutine test2_alloc_target()
+    type(t2) :: var
+    type(t2), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%x, var2%x)
+
+    !$omp target map(alloc: var, var2)
+      if (.not. allocated(Var2)) stop 6
+      if (.not. allocated(Var%x)) stop 7
+      if (.not. allocated(Var2%x)) stop 8
+      var%x = 42
+      var2%x = 43
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+
+    allocate(var%vt, var2%vt)
+    allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+    !$omp target map(alloc: var, var2)
+      if (.not. allocated(Var2)) stop 11
+      if (.not. allocated(Var%x)) stop 12
+      if (.not. allocated(Var2%x)) stop 13
+      if (.not. allocated(Var%vt)) stop 14
+      if (.not. allocated(Var2%vt)) stop 15
+      if (.not. allocated(Var%vt%a)) stop 16
+      if (.not. allocated(Var2%vt%a)) stop 17
+      var%x = 42
+      var2%x = 43
+      if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+      if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+      var%vt%A = [1,2,3,4,5]
+      var2%vt%A = [11,22,33,44,55]
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+    if (.not. allocated(Var%vt)) error stop
+    if (.not. allocated(Var2%vt)) error stop
+    if (.not. allocated(Var%vt%a)) error stop
+    if (.not. allocated(Var2%vt%a)) error stop
+    if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+    if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+  end subroutine test2_alloc_target
+
+
+
+  subroutine test_from()
+    type(t) :: var
+    type(t), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%A(4), var2%A(5))
+
+    !$omp target map(from: var, var2)
+      if (.not. allocated(Var2)) stop 1
+      if (.not. allocated(Var%A)) stop 2
+      if (.not. allocated(Var2%A)) stop 3
+      if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) stop 4
+      if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) stop 5
+      var%A = [1,2,3,4]
+      var2%A = [11,22,33,44,55]
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%A)) error stop
+    if (.not. allocated(Var2%A)) error stop
+    if (lbound(var%A, 1) /= 1 .or. ubound(var%A, 1) /= 4) error stop
+    if (lbound(var2%A, 1) /= 1 .or. ubound(var2%A, 1) /= 5) error stop
+    if (any(var%A /= [1,2,3,4])) error stop
+    if (any(var2%A /= [11,22,33,44,55])) error stop
+  end subroutine test_from
+
+  subroutine test2_from()
+    type(t2) :: var
+    type(t2), allocatable :: var2
+
+    allocate(var2)
+    allocate(var%x, var2%x)
+
+    !$omp target map(from: var, var2)
+      if (.not. allocated(Var2)) stop 6
+      if (.not. allocated(Var%x)) stop 7
+      if (.not. allocated(Var2%x)) stop 8
+      var%x = 42
+      var2%x = 43
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+    if (var%x /= 42) error stop
+    if (var2%x /= 43) error stop
+
+    allocate(var%vt, var2%vt)
+    allocate(var%vt%A(-1:3), var2%vt%A(0:4))
+
+    !$omp target map(from: var, var2)
+      if (.not. allocated(Var2)) stop 11
+      if (.not. allocated(Var%x)) stop 12
+      if (.not. allocated(Var2%x)) stop 13
+      if (.not. allocated(Var%vt)) stop 14
+      if (.not. allocated(Var2%vt)) stop 15
+      if (.not. allocated(Var%vt%a)) stop 16
+      if (.not. allocated(Var2%vt%a)) stop 17
+      var%x = 42
+      var2%x = 43
+      if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) stop 4
+      if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) stop 5
+      var%vt%A = [1,2,3,4,5]
+      var2%vt%A = [11,22,33,44,55]
+    !$omp end target
+
+    if (.not. allocated(Var2)) error stop
+    if (.not. allocated(Var%x)) error stop
+    if (.not. allocated(Var2%x)) error stop
+    if (.not. allocated(Var%vt)) error stop
+    if (.not. allocated(Var2%vt)) error stop
+    if (.not. allocated(Var%vt%a)) error stop
+    if (.not. allocated(Var2%vt%a)) error stop
+    if (var%x /= 42) error stop
+    if (var2%x /= 43) error stop
+    if (lbound(var%vt%A, 1) /= -1 .or. ubound(var%vt%A, 1) /= 3) error stop
+    if (lbound(var2%vt%A, 1) /= 0 .or. ubound(var2%vt%A, 1) /= 4) error stop
+    if (any(var%vt%A /= [1,2,3,4,5])) error stop
+    if (any(var2%vt%A /= [11,22,33,44,55])) error stop
+  end subroutine test2_from
+
+end module m
+
+use m
+  implicit none (type, external)
+  call test_alloc
+  call test2_alloc
+  call test_alloc_target
+  call test2_alloc_target
+
+  call test_from
+  call test2_from
+end
diff --git a/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90 b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
new file mode 100644
index 00000000000..3cec39218f5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
@@ -0,0 +1,559 @@ 
+! Ensure that polymorphic mapping is diagnosed as undefined behavior
+! Ensure that static access to polymorphic variables works
+
+subroutine test(case)
+implicit none(type, external)
+type t
+  integer :: x(4)
+end type t
+
+type ta
+  integer, allocatable :: x(:)
+end type ta
+
+type t2
+  class(t), allocatable :: x
+  class(t), allocatable :: x2(:)
+end type t2
+
+type t3
+   type(t2) :: y
+   type(t2) :: y2(2)
+end type t3
+
+type t4
+   type(t3), allocatable :: y
+   type(t3), allocatable :: y2(:)
+end type t4
+
+integer, value :: case
+
+logical :: is_shared_mem
+
+! Mangle stack addresses
+integer, volatile :: case_var(100*case)
+
+type(t), allocatable :: var1
+type(ta), allocatable :: var1a
+class(t), allocatable :: var2
+type(t2), allocatable :: var3
+type(t4), allocatable :: var4
+
+case_var(100) = 0
+!print *, 'case', case
+
+var1 = t([1,2,3,4])
+var1a = ta([-1,-2,-3,-4,-5])
+
+var2 = t([11,22,33,44])
+
+allocate(t2 :: var3)
+allocate(t  :: var3%x)
+allocate(t  :: var3%x2(2))
+var3%x%x = [111,222,333,444]
+var3%x2(1)%x = 2*[111,222,333,444]
+var3%x2(2)%x = 3*[111,222,333,444]
+
+allocate(t4 :: var4)
+allocate(t3 :: var4%y)
+allocate(t3 :: var4%y2(2))
+allocate(t :: var4%y%y%x)
+allocate(t :: var4%y%y%x2(2))
+allocate(t :: var4%y2(1)%y%x)
+allocate(t :: var4%y2(1)%y%x2(2))
+allocate(t :: var4%y2(2)%y%x)
+allocate(t :: var4%y2(2)%y%x2(2))
+var4%y%y%x%x = -1 * [1111,2222,3333,4444]
+var4%y%y%x2(1)%x = -2 * [1111,2222,3333,4444]
+var4%y%y%x2(2)%x = -3 * [1111,2222,3333,4444]
+var4%y2(1)%y%x%x = -4 * [1111,2222,3333,4444]
+var4%y2(1)%y%x2(1)%x = -5 * [1111,2222,3333,4444]
+var4%y2(1)%y%x2(2)%x = -6 * [1111,2222,3333,4444]
+var4%y2(2)%y%x%x = -7 * [1111,2222,3333,4444]
+var4%y2(2)%y%x2(1)%x = -8 * [1111,2222,3333,4444]
+var4%y2(2)%y%x2(2)%x = -9 * [1111,2222,3333,4444]
+
+is_shared_mem = .false.
+!$omp target map(to: is_shared_mem)
+  is_shared_mem = .true.
+!$omp end target
+
+if (case == 1) then
+  ! implicit mapping
+  !$omp target
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    end if
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    end if
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+else if (case == 2) then
+  ! Use target with defaultmap(TO)
+
+  !$omp target defaultmap(to : all)
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target defaultmap(to : all)
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target defaultmap(to : all) ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target defaultmap(to : all)  ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target defaultmap(to : all) firstprivate(is_shared_mem)  ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    endif
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+else if (case == 3) then
+  ! Use target with map clause
+
+  !$omp target map(tofrom: var1)
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target map(tofrom: var1a)
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target map(tofrom: var2)  ! { dg-warning "28: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target map(tofrom: var3)  ! { dg-warning "28: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target map(tofrom: var4)  ! { dg-warning "28: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    end if
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    endif
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+else if (case == 4) then
+  ! Use target with map clause -- NOTE: This uses TO not TOFROM
+
+  !$omp target map(to: var1)
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target map(to: var1a)
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target map(to: var2)  ! { dg-warning "24: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target map(to: var3)  ! { dg-warning "24: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target map(to: var4)  ! { dg-warning "24: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    endif
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+else if (case == 5) then
+  ! Use target enter/exit data + target with explicit map
+  !$omp target enter data map(to: var1)
+  !$omp target enter data map(to: var1a)
+  !$omp target enter data map(to: var2)  ! { dg-warning "35: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target enter data map(to: var3)  ! { dg-warning "35: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target enter data map(to: var4)  ! { dg-warning "35: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+  !$omp target map(to: var1)
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target map(to: var1a)
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target map(to: var2)  ! { dg-warning "24: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target map(to: var3)  ! { dg-warning "24: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target map(to: var4)  ! { dg-warning "24: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    endif
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target exit data map(from: var1)
+  !$omp target exit data map(from: var1a)
+  !$omp target exit data map(from: var2)  ! { dg-warning "36: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target exit data map(from: var3)  ! { dg-warning "36: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target exit data map(from: var4)  ! { dg-warning "36: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+else if (case == 6) then
+  ! Use target enter/exit data + target with implicit map
+
+  !$omp target enter data map(to: var1)
+  !$omp target enter data map(to: var1a)
+  !$omp target enter data map(to: var2)  ! { dg-warning "35: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target enter data map(to: var3)  ! { dg-warning "35: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target enter data map(to: var4)  ! { dg-warning "35: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+  !$omp target
+    if (any (var1%x /= [1,2,3,4])) stop 1
+    var1%x = 2 * var1%x
+  !$omp end target
+
+  !$omp target
+    if (any (var1a%x /= [-1,-2,-3,-4])) stop 2
+    var1a%x = 3 * var1a%x
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var2%x /= [11,22,33,44])) stop 3
+    var2%x = 4 * var2%x
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var3%x%x /= [111,222,333,444])) stop 4
+    var3%x%x = 5 * var3%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 4
+      if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 4
+      var3%x2(1)%x = 5 * var3%x2(1)%x
+      var3%x2(2)%x = 5 * var3%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target  ! { dg-warning "Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+    if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 5
+    endif
+    if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 5
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 5
+      if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 5
+    endif
+    var4%y%y%x%x = 6 * var4%y%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y%y%x2(1)%x = 6 * var4%y%y%x2(1)%x
+      var4%y%y%x2(2)%x = 6 * var4%y%y%x2(2)%x
+    endif
+    var4%y2(1)%y%x%x = 6 * var4%y2(1)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(1)%y%x2(1)%x = 6 * var4%y2(1)%y%x2(1)%x
+      var4%y2(1)%y%x2(2)%x = 6 * var4%y2(1)%y%x2(2)%x
+    endif
+    var4%y2(2)%y%x%x = 6 * var4%y2(2)%y%x%x
+    if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+      var4%y2(2)%y%x2(1)%x = 6 * var4%y2(2)%y%x2(1)%x
+      var4%y2(2)%y%x2(2)%x = 6 * var4%y2(2)%y%x2(2)%x
+    endif
+  !$omp end target
+
+  !$omp target exit data map(from: var1)
+  !$omp target exit data map(from: var1a)
+  !$omp target exit data map(from: var2)  ! { dg-warning "36: Mapping of polymorphic list item 'var2' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target exit data map(from: var3)  ! { dg-warning "36: Mapping of polymorphic list item 'var3->x' is unspecified behavior \\\[-Wopenmp\\\]" }
+  !$omp target exit data map(from: var4)  ! { dg-warning "36: Mapping of polymorphic list item 'var4\.\[0-9\]+->y->y\.x' is unspecified behavior \\\[-Wopenmp\\\]" }
+
+else
+  error stop
+end if
+
+if ((case /= 2 .and. case /= 4)  .or. is_shared_mem) then
+  ! The target update should have been active, check for the updated values
+  if (any (var1%x /= 2 * [1,2,3,4])) stop 11
+  if (any (var1a%x /= 3 * [-1,-2,-3,-4])) stop 22
+  if (any (var2%x /= 4 * [11,22,33,44])) stop 33
+
+  if (any (var3%x%x /= 5 * [111,222,333,444])) stop 44
+  if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+    if (any (var3%x2(1)%x /= 2 * 5 * [111,222,333,444])) stop 44
+    if (any (var3%x2(2)%x /= 3 * 5 * [111,222,333,444])) stop 44
+  endif
+
+  if (any (var4%y%y%x%x /= -1 * 6 * [1111,2222,3333,4444])) stop 55
+  if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+    if (any (var4%y%y%x2(1)%x /= -2 * 6 * [1111,2222,3333,4444])) stop 55
+    if (any (var4%y%y%x2(2)%x /= -3 * 6 * [1111,2222,3333,4444])) stop 55
+  endif
+  if (any (var4%y2(1)%y%x%x /= -4 * 6 * [1111,2222,3333,4444])) stop 55
+  if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+    if (any (var4%y2(1)%y%x2(1)%x /= -5 * 6 * [1111,2222,3333,4444])) stop 55
+    if (any (var4%y2(1)%y%x2(2)%x /= -6 * 6 * [1111,2222,3333,4444])) stop 55
+  endif
+  if (any (var4%y2(2)%y%x%x /= -7 * 6 * [1111,2222,3333,4444])) stop 55
+  if (is_shared_mem) then  ! For stride data, this accesses the host's _vtab
+    if (any (var4%y2(2)%y%x2(1)%x /= -8 * 6 * [1111,2222,3333,4444])) stop 55
+    if (any (var4%y2(2)%y%x2(2)%x /= -9 * 6 * [1111,2222,3333,4444])) stop 55
+  endif
+else
+  ! The old host values should still be there as 'to:' created a device copy
+  if (any (var1%x /= [1,2,3,4])) stop 12
+  if (any (var1a%x /= [-1,-2,-3,-4])) stop 22
+  if (any (var2%x /= [11,22,33,44])) stop 33
+
+  if (any (var3%x%x /= [111,222,333,444])) stop 44
+  ! .not. is_shared_mem:
+  ! if (any (var3%x2(1)%x /= 2*[111,222,333,444])) stop 44
+  ! if (any (var3%x2(2)%x /= 3*[111,222,333,444])) stop 44
+
+  if (any (var4%y%y%x%x /= -1 * [1111,2222,3333,4444])) stop 55
+  if (any (var4%y%y%x2(1)%x /= -2 * [1111,2222,3333,4444])) stop 55
+  if (any (var4%y%y%x2(2)%x /= -3 * [1111,2222,3333,4444])) stop 55
+  if (any (var4%y2(1)%y%x%x /= -4 * [1111,2222,3333,4444])) stop 55
+  ! .not. is_shared_mem:
+  !if (any (var4%y2(1)%y%x2(1)%x /= -5 * [1111,2222,3333,4444])) stop 55
+  !if (any (var4%y2(1)%y%x2(2)%x /= -6 * [1111,2222,3333,4444])) stop 55
+  if (any (var4%y2(2)%y%x%x /= -7 * [1111,2222,3333,4444])) stop 55
+  ! .not. is_shared_mem:
+  !if (any (var4%y2(2)%y%x2(1)%x /= -8 * [1111,2222,3333,4444])) stop 55
+  !if (any (var4%y2(2)%y%x2(2)%x /= -9 * [1111,2222,3333,4444])) stop 55
+end if
+if (case_var(100) /= 0) stop 123
+end subroutine test
+
+program main
+  use omp_lib
+  implicit none(type, external)
+  interface
+    subroutine test(case)
+      integer, value :: case
+    end
+  end interface
+  integer :: dev
+  call run_it(omp_get_default_device())
+  do dev = 0, omp_get_num_devices()
+    call run_it(dev)
+  end do
+  call run_it(omp_initial_device)
+!  print *, 'all done'
+contains
+subroutine run_it(dev)
+  integer, value :: dev
+!  print *, 'DEVICE', dev
+  call omp_set_default_device(dev)
+  call test(1)
+  call test(2)
+  call test(3)
+  call test(4)
+  call test(5)
+  call test(6)
+end
+end