* [OG12][committed] Fortran/OpenMP: Fix 'alloc' and 'from' mapping for allocatable components
@ 2023-03-23 19:57 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2023-03-23 19:57 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 2103 bytes --]
This is about OpenMP's "deep mapping" of allocatable components of derived types.
The basic feature is on OG12 (and OG11) but yet in GCC mainline. The old
submissions are at https://gcc.gnu.org/pipermail/gcc-patches/2022-April/593704.html
My plan is to get the whole feature into GCC 14 once trunk has opened (and
after some simpler pending patches have been merged). It requires some
re-diffing to be more digestible.
* * *
OG12: This patch as been committed to the devel/omp/gcc-12 branch as
https://gcc.gnu.org/g:a63735b8034db65a33c359633462accd9d71d3b5
* * *
This patch fixes an issue with 'map(alloc:' and 'map(from:' with
deep mapping of allocatable components - namely:
* For unmapping/coping to the host, the state of unallocated allocatables
needs to be preservered.
* For mapping to the device ('alloc' and 'from'), we still need to copy
data to the device to have the array bounds correctly set.
The data pointer (of allocated allocatables) is set as part of allocating
memory on the device ('attach'); thus, this part works.
As described in the patch (cf. comment above the checking function), we
could either copy only the descriptor data (and the NULL for pointers)
or we copy everything (shallowly) which includes this data. As there is
no means to do the former (without changing the refcount), we do the latter.
NOTE: The actual data to which the scalar/array allocatable points to is
not 'to' mapped but only 'alloc'. As that is supposed to be the large data,
copying everything should™ not cause a large performance penalty with real-world
code; it could be even faster than, let's say, copying 5 descriptors separately.
OpenMP spec side: It is not completely clear how the OpenMP spec expects
the copy out to work. Hence, I filed OpenMP Spec Issue #3545.
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 19866 bytes --]
commit a63735b8034db65a33c359633462accd9d71d3b5
Author: Tobias Burnus <tobias@codesourcery.com>
Date: Thu Mar 23 18:04:17 2023 +0100
Fortran/OpenMP: Fix 'alloc' and 'from' mapping for allocatable components
Even with 'alloc' and map-entering 'from' mapping, the following should hold.
For explicit mapping, that's already the case, this handles the automatical
deep mapping of allocatable components. Namely:
* On the device, the array bounds (of allocated allocatables) must match the
host, implying 'to' (or 'tofrom') mapping.
* On map exiting, the copying out shall not destroy the unallocated allocation
status (nor the pointer address of allocated allocatables).
The latter was not a problem for allocated allocatables as for those a pointer
was GOMP_MAP_ATTACHed; however, for unallocated allocatables, before it copied
back device-allocated memory which might not be nullified.
While 'alloc' was not deep-mapped at all, for map-entering 'from', the array
bounds were not set, making allocated derived-type components inaccessible on
the device (and wrong on the host on copy back).
The solution is, first, to deep-map 'alloc' as well and to copy to the device
even with 'alloc' and (map-entering) 'from'. This copying is only done if there
is a scalar (for the unallocated case) or array allocatable directly in the
derived type and then it is shallowly copied; the data pointed to is then again
only alloc'ed, unless it contains in turn allocatables.
gcc/fortran/
* trans-openmp.cc (gfc_has_alloc_comps): Add 'bool
shallow_alloc_only=false' arg.
(gfc_omp_replace_alloc_by_to_mapping): New, call it.
(gfc_omp_deep_map_kind_p): Return 'true' also for '(present,)alloc'.
(gfc_omp_deep_mapping_item, gfc_omp_deep_mapping_do): On map entering,
replace shallowly 'alloc'/'from' by '(from)to' mapping if there are
allocatable components.
libgomp/
* testsuite/libgomp.fortran/map-alloc-comp-8.f90: New test.
---
gcc/fortran/ChangeLog.omp | 10 +
gcc/fortran/trans-openmp.cc | 96 +++++++-
libgomp/ChangeLog.omp | 4 +
.../testsuite/libgomp.fortran/map-alloc-comp-8.f90 | 268 +++++++++++++++++++++
4 files changed, 371 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index f7d1f91f178..e3ab2254215 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,13 @@
+2023-03-23 Tobias Burnus <tobias@codesourcery.com>
+
+ * trans-openmp.cc (gfc_has_alloc_comps): Add 'bool
+ shallow_alloc_only=false' arg.
+ (gfc_omp_replace_alloc_by_to_mapping): New, call it.
+ (gfc_omp_deep_map_kind_p): Return 'true' also for '(present,)alloc'.
+ (gfc_omp_deep_mapping_item, gfc_omp_deep_mapping_do): On map entering,
+ replace shallowly 'alloc'/'from' by '(from)to' mapping if there are
+ allocatable components.
+
2023-03-23 Tobias Burnus <tobias@codesourcery.com>
* class.cc (generate_callback_wrapper): Add attr.class_ok check.
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 7a94bdcc870..8408d7b5274 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -379,10 +379,13 @@ gfc_omp_report_decl (tree decl)
}
/* Return true if TYPE has any allocatable components;
- if ptr_ok, the decl itself is permitted to have the POINTER attribute. */
+ 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, bool ptr_ok)
+gfc_has_alloc_comps (tree type, tree decl, bool ptr_ok,
+ bool shallow_alloc_only=false)
{
tree field, ftype;
@@ -415,12 +418,50 @@ gfc_has_alloc_comps (tree type, tree decl, bool ptr_ok)
if (GFC_DESCRIPTOR_TYPE_P (ftype)
&& GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
return true;
- if (gfc_has_alloc_comps (ftype, field, false))
+ 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
@@ -2730,7 +2771,15 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
tmp = gfc_conv_descriptor_data_get (tmp);
}
- gfc_omp_deep_mapping_map (tmp, bytesize, tkind, loc, data_array,
+ /* For polymorphic, a extended type may have allocatable components;
+ see comment before gfc_omp_replace_alloc_by_to_mapping. */
+ unsigned HOST_WIDE_INT tkind2 = tkind;
+ if (tkind == GOMP_MAP_ALLOC)
+ tkind2 = GOMP_MAP_TO;
+ else if (tkind == GOMP_MAP_FROM
+ && gimple_omp_target_kind (ctx) != GF_OMP_TARGET_KIND_EXIT_DATA)
+ tkind2 = GOMP_MAP_TOFROM;
+ gfc_omp_deep_mapping_map (tmp, bytesize, tkind2, loc, data_array,
sizes_array, kinds_array, offset_data,
offset, seq, ctx);
}
@@ -2755,7 +2804,16 @@ gfc_omp_deep_mapping_item (bool is_cnt, bool do_copy, bool do_alloc_check,
tmp = decl;
bytesize = TYPE_SIZE_UNIT (TREE_TYPE (decl));
}
- gfc_omp_deep_mapping_map (tmp, bytesize, tkind, loc, data_array,
+ 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);
}
@@ -2889,9 +2947,9 @@ gfc_omp_deep_map_kind_p (tree clause)
case GOMP_MAP_ALWAYS_PRESENT_FROM:
case GOMP_MAP_ALWAYS_PRESENT_TOFROM:
case GOMP_MAP_FIRSTPRIVATE:
- return true;
case GOMP_MAP_ALLOC:
case GOMP_MAP_PRESENT_ALLOC:
+ return true;
case GOMP_MAP_POINTER:
case GOMP_MAP_TO_PSET:
case GOMP_MAP_FORCE_PRESENT:
@@ -3004,6 +3062,21 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
tree decl = gfc_omp_deep_mapping_int_p (ctx, clause);
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_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);
@@ -3044,6 +3117,15 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
|| GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)))
do_alloc_check = true;
+ if (!is_cnt
+ && (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)
@@ -3071,7 +3153,7 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
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);
- /* Double: Map + pointer assign. */
+ /* Multiply by 2 as there are two mappings: data + pointer assign. */
if (is_cnt)
gimplify_assign (num,
fold_build2_loc (input_location, MULT_EXPR,
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 2b0b4c71e9d..ace54f2f82f 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,7 @@
+2023-03-23 Tobias Burnus <tobias@codesourcery.com>
+
+ * testsuite/libgomp.fortran/map-alloc-comp-8.f90: New test.
+
2023-03-10 Thomas Schwinge <thomas@codesourcery.com>
Backported from master:
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..9c3c6d49daa
--- /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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-03-23 19:57 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-03-23 19:57 [OG12][committed] Fortran/OpenMP: Fix 'alloc' and 'from' mapping for allocatable components Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).