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.
This commit is contained in:
Tobias Burnus
parent
6d9fdf4bf5
commit
99cd28c473
21 changed files with 3208 additions and 111 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
30
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-1.f90
Normal file
30
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-1.f90
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
23
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-3.f90
Normal file
23
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-3.f90
Normal file
|
|
@ -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
|
||||
9
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-4.f90
Normal file
9
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-4.f90
Normal file
|
|
@ -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
|
||||
9
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-5.f90
Normal file
9
gcc/testsuite/gfortran.dg/gomp/polymorphic-mapping-5.f90
Normal file
|
|
@ -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
|
||||
|
|
@ -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" }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
53
libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
Normal file
53
libgomp/testsuite/libgomp.fortran/allocatable-comp.f90
Normal file
|
|
@ -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
|
||||
121
libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
Normal file
121
libgomp/testsuite/libgomp.fortran/map-alloc-comp-3.f90
Normal file
|
|
@ -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
|
||||
124
libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
Normal file
124
libgomp/testsuite/libgomp.fortran/map-alloc-comp-4.f90
Normal file
|
|
@ -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
|
||||
53
libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
Normal file
53
libgomp/testsuite/libgomp.fortran/map-alloc-comp-5.f90
Normal file
|
|
@ -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
|
||||
308
libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
Normal file
308
libgomp/testsuite/libgomp.fortran/map-alloc-comp-6.f90
Normal file
|
|
@ -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
|
||||
672
libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
Normal file
672
libgomp/testsuite/libgomp.fortran/map-alloc-comp-7.f90
Normal file
|
|
@ -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
|
||||
268
libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
Normal file
268
libgomp/testsuite/libgomp.fortran/map-alloc-comp-8.f90
Normal file
|
|
@ -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
|
||||
559
libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
Normal file
559
libgomp/testsuite/libgomp.fortran/map-alloc-comp-9.f90
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue