diff mbox series

Fortran/OpenMP: Fix DT struct-component with 'alloc' and array descr

Message ID 9d44e561-cad7-d881-95fe-a696cdcfa531@codesourcery.com
State New
Headers
Series Fortran/OpenMP: Fix DT struct-component with 'alloc' and array descr |

Commit Message

Tobias Burnus Nov. 2, 2022, 3:57 p.m. UTC 
  This fixes some an issue with 'alloc:' found when working on the patch
'[Patch] OpenMP/Fortran: 'target update' with strides + DT components'
https://gcc.gnu.org/pipermail/gcc-patches/2022-October/604687.html
(BTW: This one is still pending review.)

OK for mainline?

  * * *

I think the patch is a great improvement.

However, again, by writing a testcase, more issues have been found:
* one generic Fortran one, worked around by adding '(:)',
   Cf. https://gcc.gnu.org/PR107508 "Invalid bounds due to bogus reallocation
   on assignment with KIND=4 characters".
* Some other string issues, some might be generic Fortran issues
* Some issue with pointers - where exit data give an error as
   0x00 and 0x01 kinds are not known by target exit data
   Those also showed up with the 'target update' patch mentioned above.

For the last two, I used '#if 0' followed by a comment with the current
error message. I do intent to look into those - or at least file a PR.
Likewise for the remaining issues mentioned in the 'tagret update' patch.

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

Patch

Fortran/OpenMP: Fix DT struct-component with 'alloc' and array descr

When using 'map(alloc: var, dt%comp)' needs to have a 'to' mapping of
the array descriptor as otherwise the bounds are not available in the
target region. - Likewise for character strings.

This patch implements this; however, some additional issues are exposed
by the testcase; those are '#if 0'ed and will be handled later.

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_trans_omp_clauses): Ensure DT struct-comp with
	array descriptor and 'alloc:' have the descriptor mapped with 'to:'.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/target-enter-data-3.f90: New test.

 gcc/fortran/trans-openmp.cc                               |    3 
 libgomp/testsuite/libgomp.fortran/target-enter-data-3.f90 |  567 ++++++++++++++
 2 files changed, 569 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 4bfdf85cd9b..4eb9d4c9edc 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -3507,7 +3507,8 @@  gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			    = gfc_full_array_size (block, inner, rank);
 			  tree elemsz
 			    = TYPE_SIZE_UNIT (gfc_get_element_type (type));
-			  if (GOMP_MAP_COPY_TO_P (OMP_CLAUSE_MAP_KIND (node)))
+			  if (GOMP_MAP_COPY_TO_P (OMP_CLAUSE_MAP_KIND (node))
+			      || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_ALLOC)
 			    map_kind = GOMP_MAP_TO;
 			  else if (n->u.map_op == OMP_MAP_RELEASE
 				   || n->u.map_op == OMP_MAP_DELETE)
diff --git a/libgomp/testsuite/libgomp.fortran/target-enter-data-3.f90 b/libgomp/testsuite/libgomp.fortran/target-enter-data-3.f90
new file mode 100644
index 00000000000..1fe3f03c7b8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-enter-data-3.f90
@@ -0,0 +1,567 @@ 
+! { dg-additional-options "-cpp" }
+
+! FIXME: Some tests do not work yet. Those are for now in '#if 0'
+
+! Check that 'map(alloc:' properly works with
+! - deferred-length character strings
+! - arrays with array descriptors
+! For those, the array descriptor / string length must be mapped with 'to:'
+
+program main
+implicit none
+
+type t
+  integer :: ic(2:5), ic2
+  character(len=11) :: ccstr(3:4), ccstr2
+  character(len=11,kind=4) :: cc4str(3:7), cc4str2
+  integer, pointer :: pc(:), pc2
+  character(len=:), pointer :: pcstr(:), pcstr2
+  character(len=:,kind=4), pointer :: pc4str(:), pc4str2
+end type t
+
+type(t) :: dt
+
+integer :: ii(5), ii2
+character(len=11) :: clstr(-1:1), clstr2
+character(len=11,kind=4) :: cl4str(0:3), cl4str2
+integer, pointer :: ip(:), ip2
+integer, allocatable :: ia(:), ia2
+character(len=:), pointer :: pstr(:), pstr2
+character(len=:), allocatable :: astr(:), astr2
+character(len=:,kind=4), pointer :: p4str(:), p4str2
+character(len=:,kind=4), allocatable :: a4str(:), a4str2
+
+
+allocate(dt%pc(5), dt%pc2)
+allocate(character(len=2) :: dt%pcstr(2))
+allocate(character(len=4) :: dt%pcstr2)
+
+allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
+allocate(character(len=5,kind=4) :: dt%pc4str2)
+
+allocate(ip(5), ip2, ia(8), ia2)
+allocate(character(len=2) :: pstr(-2:0))
+allocate(character(len=4) :: pstr2)
+allocate(character(len=6) :: astr(3:5))
+allocate(character(len=8) :: astr2)
+
+allocate(character(len=3,kind=4) :: p4str(2:4))
+allocate(character(len=5,kind=4) :: p4str2)
+allocate(character(len=7,kind=4) :: a4str(-2:3))
+allocate(character(len=9,kind=4) :: a4str2)
+
+
+! integer :: ic(2:5), ic2
+
+!$omp target enter data map(alloc: dt%ic)
+!$omp target map(alloc: dt%ic)
+  if (size(dt%ic) /= 4) error stop
+  if (lbound(dt%ic, 1) /= 2) error stop
+  if (ubound(dt%ic, 1) /= 5) error stop
+  dt%ic = [22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: dt%ic)
+if (size(dt%ic) /= 4) error stop
+if (lbound(dt%ic, 1) /= 2) error stop
+if (ubound(dt%ic, 1) /= 5) error stop
+if (any (dt%ic /= [22, 33, 44, 55])) error stop
+
+!$omp target enter data map(alloc: dt%ic2)
+!$omp target map(alloc: dt%ic2)
+  dt%ic2 = 42
+!$omp end target
+!$omp target exit data map(from: dt%ic2)
+if (dt%ic2 /= 42) error stop
+
+
+! character(len=11) :: ccstr(3:4), ccstr2
+
+!$omp target enter data map(alloc: dt%ccstr)
+!$omp target map(alloc: dt%ccstr)
+  if (len(dt%ccstr) /= 11) error stop
+  if (size(dt%ccstr) /= 2) error stop
+  if (lbound(dt%ccstr, 1) /= 3) error stop
+  if (ubound(dt%ccstr, 1) /= 4) error stop
+  dt%ccstr = ["12345678901", "abcdefghijk"]
+!$omp end target
+!$omp target exit data map(from: dt%ccstr)
+if (len(dt%ccstr) /= 11) error stop
+if (size(dt%ccstr) /= 2) error stop
+if (lbound(dt%ccstr, 1) /= 3) error stop
+if (ubound(dt%ccstr, 1) /= 4) error stop
+if (any (dt%ccstr /= ["12345678901", "abcdefghijk"])) error stop
+
+!$omp target enter data map(alloc: dt%ccstr2)
+!$omp target map(alloc: dt%ccstr2)
+  if (len(dt%ccstr2) /= 11) error stop
+  dt%ccstr2 = "ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: dt%ccstr2)
+if (len(dt%ccstr2) /= 11) error stop
+if (dt%ccstr2 /= "ABCDEFGHIJK") error stop
+
+
+! character(len=11,kind=4) :: cc4str(3:7), cc4str2
+
+#if 0
+! Value check fails
+!$omp target map(alloc: dt%cc4str)
+  if (len(dt%cc4str) /= 11) error stop
+  if (size(dt%cc4str) /= 5) error stop
+  if (lbound(dt%cc4str, 1) /= 3) error stop
+  if (ubound(dt%cc4str, 1) /= 7) error stop
+  dt%cc4str = [4_"12345678901", 4_"abcdefghijk", &
+               4_"qerftcea6ds", 4_"a1f9g37ga4.", &
+               4_"45ngwj56sj2"]
+!$omp end target
+!$omp target exit data map(from: dt%cc4str)
+if (len(dt%cc4str) /= 11) error stop
+if (size(dt%cc4str) /= 5) error stop
+if (lbound(dt%cc4str, 1) /= 3) error stop
+if (ubound(dt%cc4str, 1) /= 7) error stop
+if (dt%cc4str(3) /= 4_"12345678901") error stop
+if (dt%cc4str(4) /= 4_"abcdefghijk") error stop
+if (dt%cc4str(5) /= 4_"qerftcea6ds") error stop
+if (dt%cc4str(6) /= 4_"a1f9g37ga4.") error stop
+if (dt%cc4str(7) /= 4_"45ngwj56sj2") error stop
+#endif
+
+!$omp target enter data map(alloc: dt%cc4str2)
+!$omp target map(alloc: dt%cc4str2)
+  if (len(dt%cc4str2) /= 11) error stop
+  dt%cc4str2 = 4_"ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: dt%cc4str2)
+if (len(dt%cc4str2) /= 11) error stop
+if (dt%cc4str2 /= 4_"ABCDEFGHIJK") error stop
+
+
+! integer, pointer :: pc(:), pc2
+! allocate(dt%pc(5), dt%pc2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pc)
+!$omp target map(alloc: dt%pc)
+  if (.not. associated(dt%pc)) error stop
+  if (size(dt%pc) /= 5) error stop
+  if (lbound(dt%pc, 1) /= 1) error stop
+  if (ubound(dt%pc, 1) /= 5) error stop
+  dt%pc = [11, 22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: dt%pc)
+if (.not. associated(dt%pc)) error stop
+if (size(dt%pc) /= 5) error stop
+if (lbound(dt%pc, 1) /= 1) error stop
+if (ubound(dt%pc, 1) /= 5) error stop
+if (any (dt%pc /= [11, 22, 33, 44, 55])) error stop
+#endif
+
+!$omp target enter data map(alloc: dt%pc2)
+!$omp target map(alloc: dt%pc2)
+  if (.not. associated(dt%pc2)) error stop
+  dt%pc2 = 99
+!$omp end target
+!$omp target exit data map(from: dt%pc2)
+if (dt%pc2 /= 99) error stop
+if (.not. associated(dt%pc2)) error stop
+
+
+! character(len=:), pointer :: pcstr(:), pcstr2
+! allocate(character(len=2) :: dt%pcstr(2))
+! allocate(character(len=4) :: dt%pcstr2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pcstr)
+!$omp target map(alloc: dt%pcstr)
+  if (.not. associated(dt%pcstr)) error stop
+  if (len(dt%pcstr) /= 2) error stop
+  if (size(dt%pcstr) /= 2) error stop
+  if (lbound(dt%pcstr, 1) /= 1) error stop
+  if (ubound(dt%pcstr, 1) /= 2) error stop
+  dt%pcstr = ["01", "jk"]
+!$omp end target
+!$omp target exit data map(from: dt%pcstr)
+if (.not. associated(dt%pcstr)) error stop
+if (len(dt%pcstr) /= 2) error stop
+if (size(dt%pcstr) /= 2) error stop
+if (lbound(dt%pcstr, 1) /= 1) error stop
+if (ubound(dt%pcstr, 1) /= 2) error stop
+if (any (dt%pcstr /= ["01", "jk"])) error stop
+#endif
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x01
+
+!$omp target enter data map(alloc: dt%pcstr2)
+!$omp target map(alloc: dt%pcstr2)
+  if (.not. associated(dt%pcstr2)) error stop
+  if (len(dt%pcstr2) /= 4) error stop
+  dt%pcstr2 = "HIJK"
+!$omp end target
+!$omp target exit data map(from: dt%pcstr2)
+if (.not. associated(dt%pcstr2)) error stop
+if (len(dt%pcstr2) /= 4) error stop
+if (dt%pcstr2 /= "HIJK") error stop
+#endif
+
+
+! character(len=:,kind=4), pointer :: pc4str(:), pc4str2
+! allocate(character(len=3,kind=4) :: dt%pc4str(2:3))
+! allocate(character(len=5,kind=4) :: dt%pc4str2)
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x00
+
+!$omp target enter data map(alloc: dt%pc4str)
+!$omp target map(alloc: dt%pc4str)
+  if (.not. associated(dt%pc4str)) error stop
+  if (len(dt%pc4str) /= 3) error stop
+  if (size(dt%pc4str) /= 2) error stop
+  if (lbound(dt%pc4str, 1) /= 2) error stop
+  if (ubound(dt%pc4str, 1) /= 3) error stop
+  dt%pc4str = [4_"456", 4_"tzu"]
+!$omp end target
+!$omp target exit data map(from: dt%pc4str)
+if (.not. associated(dt%pc4str)) error stop
+if (len(dt%pc4str) /= 3) error stop
+if (size(dt%pc4str) /= 2) error stop
+if (lbound(dt%pc4str, 1) /= 2) error stop
+if (ubound(dt%pc4str, 1) /= 3) error stop
+if (dt%pc4str(2) /= 4_"456") error stop
+if (dt%pc4str(3) /= 4_"tzu") error stop
+#endif
+
+#if 0
+! libgomp: GOMP_target_enter_exit_data unhandled kind 0x01
+
+!$omp target enter data map(alloc: dt%pc4str2)
+!$omp target map(alloc: dt%pc4str2)
+  if (.not. associated(dt%pc4str2)) error stop
+  if (len(dt%pc4str2) /= 5) error stop
+  dt%pc4str2 = 4_"98765"
+!$omp end target
+!$omp target exit data map(from: dt%pc4str2)
+if (.not. associated(dt%pc4str2)) error stop
+if (len(dt%pc4str2) /= 5) error stop
+if (dt%pc4str2 /= 4_"98765") error stop
+#endif
+
+
+! integer :: ii(5), ii2
+
+!$omp target enter data map(alloc: ii)
+!$omp target map(alloc: ii)
+  if (size(ii) /= 5) error stop
+  if (lbound(ii, 1) /= 1) error stop
+  if (ubound(ii, 1) /= 5) error stop
+  ii = [-1, -2, -3, -4, -5]
+!$omp end target
+!$omp target exit data map(from: ii)
+if (size(ii) /= 5) error stop
+if (lbound(ii, 1) /= 1) error stop
+if (ubound(ii, 1) /= 5) error stop
+if (any (ii /= [-1, -2, -3, -4, -5])) error stop
+
+!$omp target enter data map(alloc: ii2)
+!$omp target map(alloc: ii2)
+  ii2 = -410
+!$omp end target
+!$omp target exit data map(from: ii2)
+if (ii2 /= -410) error stop
+
+
+! character(len=11) :: clstr(-1:1), clstr2
+
+!$omp target enter data map(alloc: clstr)
+!$omp target map(alloc: clstr)
+  if (len(clstr) /= 11) error stop
+  if (size(clstr) /= 3) error stop
+  if (lbound(clstr, 1) /= -1) error stop
+  if (ubound(clstr, 1) /= 1) error stop
+  clstr = ["12345678901", "abcdefghijk", "ABCDEFGHIJK"]
+!$omp end target
+!$omp target exit data map(from: clstr)
+if (len(clstr) /= 11) error stop
+if (size(clstr) /= 3) error stop
+if (lbound(clstr, 1) /= -1) error stop
+if (ubound(clstr, 1) /= 1) error stop
+if (any (clstr /= ["12345678901", "abcdefghijk", "ABCDEFGHIJK"])) error stop
+
+!$omp target enter data map(alloc: clstr2)
+!$omp target map(alloc: clstr2)
+  if (len(clstr2) /= 11) error stop
+  clstr2 = "ABCDEFghijk"
+!$omp end target
+!$omp target exit data map(from: clstr2)
+if (len(clstr2) /= 11) error stop
+if (clstr2 /= "ABCDEFghijk") error stop
+
+
+! character(len=11,kind=4) :: cl4str(0:3), cl4str2
+
+!$omp target enter data map(alloc: cl4str)
+!$omp target map(alloc: cl4str)
+  if (len(cl4str) /= 11) error stop
+  if (size(cl4str) /= 4) error stop
+  if (lbound(cl4str, 1) /= 0) error stop
+  if (ubound(cl4str, 1) /= 3) error stop
+  cl4str = [4_"12345678901", 4_"abcdefghijk", &
+            4_"qerftcea6ds", 4_"a1f9g37ga4."]
+!$omp end target
+!$omp target exit data map(from: cl4str)
+if (len(cl4str) /= 11) error stop
+if (size(cl4str) /= 4) error stop
+if (lbound(cl4str, 1) /= 0) error stop
+if (ubound(cl4str, 1) /= 3) error stop
+if (cl4str(0) /= 4_"12345678901") error stop
+if (cl4str(1) /= 4_"abcdefghijk") error stop
+if (cl4str(2) /= 4_"qerftcea6ds") error stop
+if (cl4str(3) /= 4_"a1f9g37ga4.") error stop
+
+!$omp target enter data map(alloc: cl4str2)
+!$omp target map(alloc: cl4str2)
+  if (len(cl4str2) /= 11) error stop
+  cl4str2 = 4_"ABCDEFGHIJK"
+!$omp end target
+!$omp target exit data map(from: cl4str2)
+if (len(cl4str2) /= 11) error stop
+if (cl4str2 /= 4_"ABCDEFGHIJK") error stop
+
+
+! allocate(ip(5), ip2, ia(8), ia2)
+
+!$omp target enter data map(alloc: ip)
+!$omp target map(alloc: ip)
+  if (.not. associated(ip)) error stop
+  if (size(ip) /= 5) error stop
+  if (lbound(ip, 1) /= 1) error stop
+  if (ubound(ip, 1) /= 5) error stop
+  ip = [11, 22, 33, 44, 55]
+!$omp end target
+!$omp target exit data map(from: ip)
+if (.not. associated(ip)) error stop
+if (size(ip) /= 5) error stop
+if (lbound(ip, 1) /= 1) error stop
+if (ubound(ip, 1) /= 5) error stop
+if (any (ip /= [11, 22, 33, 44, 55])) error stop
+
+!$omp target enter data map(alloc: ip2)
+!$omp target map(alloc: ip2)
+  if (.not. associated(ip2)) error stop
+  ip2 = 99
+!$omp end target
+!$omp target exit data map(from: ip2)
+if (ip2 /= 99) error stop
+if (.not. associated(ip2)) error stop
+
+
+! allocate(ip(5), ip2, ia(8), ia2)
+
+!$omp target enter data map(alloc: ia)
+!$omp target map(alloc: ia)
+  if (.not. allocated(ia)) error stop
+  if (size(ia) /= 8) error stop
+  if (lbound(ia, 1) /= 1) error stop
+  if (ubound(ia, 1) /= 8) error stop
+  ia = [1,2,3,4,5,6,7,8]
+!$omp end target
+!$omp target exit data map(from: ia)
+if (.not. allocated(ia)) error stop
+if (size(ia) /= 8) error stop
+if (lbound(ia, 1) /= 1) error stop
+if (ubound(ia, 1) /= 8) error stop
+if (any (ia /= [1,2,3,4,5,6,7,8])) error stop
+
+!$omp target enter data map(alloc: ia2)
+!$omp target map(alloc: ia2)
+  if (.not. allocated(ia2)) error stop
+  ia2 = 102
+!$omp end target
+!$omp target exit data map(from: ia2)
+if (ia2 /= 102) error stop
+if (.not. allocated(ia2)) error stop
+
+
+! character(len=:), pointer :: pstr(:), pstr2
+! allocate(character(len=2) :: pstr(-2:0))
+! allocate(character(len=4) :: pstr2)
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: pstr)
+!$omp target map(alloc: pstr)
+  if (.not. associated(pstr)) error stop
+  if (len(pstr) /= 2) error stop
+  if (size(pstr) /= 3) error stop
+  if (lbound(pstr, 1) /= -2) error stop
+  if (ubound(pstr, 1) /= 0) error stop
+  pstr = ["01", "jk", "aq"]
+!$omp end target
+!$omp target exit data map(from: pstr)
+if (.not. associated(pstr)) error stop
+if (len(pstr) /= 2) error stop
+if (size(pstr) /= 3) error stop
+if (lbound(pstr, 1) /= -2) error stop
+if (ubound(pstr, 1) /= 0) error stop
+if (any (pstr /= ["01", "jk", "aq"])) error stop
+#endif
+
+!$omp target enter data map(alloc: pstr2)
+!$omp target map(alloc: pstr2)
+  if (.not. associated(pstr2)) error stop
+  if (len(pstr2) /= 4) error stop
+  pstr2 = "HIJK"
+!$omp end target
+!$omp target exit data map(from: pstr2)
+if (.not. associated(pstr2)) error stop
+if (len(pstr2) /= 4) error stop
+if (pstr2 /= "HIJK") error stop
+
+
+! character(len=:), allocatable :: astr(:), astr2
+! allocate(character(len=6) :: astr(3:5))
+! allocate(character(len=8) :: astr2)
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: astr)
+!$omp target map(alloc: astr)
+  if (.not. allocated(astr)) error stop
+  if (len(astr) /= 6) error stop
+  if (size(astr) /= 3) error stop
+  if (lbound(astr, 1) /= 3) error stop
+  if (ubound(astr, 1) /= 5) error stop
+  astr = ["01db45", "jk$D%S", "zutg47"]
+!$omp end target
+!$omp target exit data map(from: astr)
+if (.not. allocated(astr)) error stop
+if (len(astr) /= 6) error stop
+if (size(astr) /= 3) error stop
+if (lbound(astr, 1) /= 3) error stop
+if (ubound(astr, 1) /= 5) error stop
+if (any (astr /= ["01db45", "jk$D%S", "zutg47"])) error stop
+#endif
+
+#if 0
+! libgomp: nvptx_alloc error: out of memory
+
+!$omp target enter data map(alloc: astr2)
+!$omp target map(alloc: astr2)
+  if (.not. allocated(astr2)) error stop
+  if (len(astr2) /= 8) error stop
+  astr2 = "HIJKhijk"
+!$omp end target
+!$omp target exit data map(from: astr2)
+if (.not. allocated(astr2)) error stop
+if (len(astr2) /= 8) error stop
+if (astr2 /= "HIJKhijk") error stop
+#endif
+
+
+! character(len=:,kind=4), pointer :: p4str(:), p4str2
+! allocate(character(len=3,kind=4) :: p4str(2:4))
+! allocate(character(len=5,kind=4) :: p4str2)
+
+#if 0
+! FAILS with value check
+
+!$omp target enter data map(alloc: p4str)
+!$omp target map(alloc: p4str)
+  if (.not. associated(p4str)) error stop
+  if (len(p4str) /= 3) error stop
+  if (size(p4str) /= 3) error stop
+  if (lbound(p4str, 1) /= 2) error stop
+  if (ubound(p4str, 1) /= 4) error stop
+  p4str(:) = [4_"f85", 4_"8af", 4_"A%F"]
+!$omp end target
+!$omp target exit data map(from: p4str)
+if (.not. associated(p4str)) error stop
+if (len(p4str) /= 3) error stop
+if (size(p4str) /= 3) error stop
+if (lbound(p4str, 1) /= 2) error stop
+if (ubound(p4str, 1) /= 4) error stop
+if (p4str(2)  /= 4_"f85") error stop
+if (p4str(3)  /= 4_"8af") error stop
+if (p4str(4)  /= 4_"A%F") error stop
+#endif
+
+!$omp target enter data map(alloc: p4str2)
+!$omp target map(alloc: p4str2)
+  if (.not. associated(p4str2)) error stop
+  if (len(p4str2) /= 5) error stop
+  p4str2 = 4_"9875a"
+!$omp end target
+!$omp target exit data map(from: p4str2)
+if (.not. associated(p4str2)) error stop
+if (len(p4str2) /= 5) error stop
+if (p4str2 /= 4_"9875a") error stop
+
+
+! character(len=:,kind=4), allocatable :: a4str(:), a4str2
+! allocate(character(len=7,kind=4) :: a4str(-2:3))
+! allocate(character(len=9,kind=4) :: a4str2)
+
+#if 0
+! libgomp: Trying to map into device [0x1027ba0..0x251050bb9c9ebba0) object when [0x7ffd026e6708..0x7ffd026e6710) is already mapped
+
+!$omp target enter data map(alloc: a4str)
+!$omp target map(alloc: a4str)
+  if (.not. allocated(a4str)) error stop
+  if (len(a4str) /= 7) error stop
+  if (size(a4str) /= 6) error stop
+  if (lbound(a4str, 1) /= -2) error stop
+  if (ubound(a4str, 1) /= 3) error stop
+  ! See PR fortran/107508 why '(:)' is required
+  a4str(:) = [4_"sf456aq", 4_"3dtzu24", 4_"_4fh7sm", 4_"=ff85s7", 4_"j=8af4d", 4_".,A%Fsz"]
+!$omp end target
+!$omp target exit data map(from: a4str)
+if (.not. allocated(a4str)) error stop
+if (len(a4str) /= 7) error stop
+if (size(a4str) /= 6) error stop
+if (lbound(a4str, 1) /= -2) error stop
+if (ubound(a4str, 1) /= 3) error stop
+if (a4str(-2) /= 4_"sf456aq") error stop
+if (a4str(-1) /= 4_"3dtzu24") error stop
+if (a4str(0)  /= 4_"_4fh7sm") error stop
+if (a4str(1)  /= 4_"=ff85s7") error stop
+if (a4str(2)  /= 4_"j=8af4d") error stop
+if (a4str(3)  /= 4_".,A%Fsz") error stop
+#endif
+
+!$omp target enter data map(alloc: a4str2)
+!$omp target map(alloc: a4str2)
+  if (.not. allocated(a4str2)) error stop
+  if (len(a4str2) /= 9) error stop
+  a4str2 = 4_"98765a23d"
+!$omp end target
+!$omp target exit data map(from: a4str2)
+if (.not. allocated(a4str2)) error stop
+if (len(a4str2) /= 9) error stop
+if (a4str2 /= 4_"98765a23d") error stop
+
+
+deallocate(dt%pc, dt%pc2)
+deallocate(dt%pcstr)
+deallocate(dt%pcstr2)
+
+deallocate(dt%pc4str)
+deallocate(dt%pc4str2)
+
+deallocate(ip, ip2, ia, ia2)
+deallocate(pstr)
+deallocate(pstr2)
+deallocate(astr)
+deallocate(astr2)
+
+deallocate(p4str)
+deallocate(p4str2)
+deallocate(a4str)
+deallocate(a4str2)
+
+end