OpenMP/Fortran: Fix allocatable-component mapping of derived-type array comps

The check whether the location expression in map clause has allocatable
components was failing for some derived-type array expressions such as
  map(var%tiles(1))
as the compiler produced
  _4 = var.tiles;
  MEMREF(_4, _5);
This commit now also handles this case.

gcc/fortran/ChangeLog:

	* trans-openmp.cc (gfc_omp_deep_mapping_do): Handle SSA_NAME if
	a def_stmt is available.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/alloc-comp-4.f90: New test.

diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 0b8150fb9777595ea3ed82732db86a9ccc98160a..2a48d4af5276706b03c92dcbd5cab2e199c81147 100644 (file)
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -2478,6 +2478,26 @@ gfc_omp_deep_mapping_do (bool is_cnt, const gimple *ctx, tree clause,
   else
     while (TREE_CODE (tmp) == COMPONENT_REF || TREE_CODE (tmp) == ARRAY_REF)
       tmp = TREE_OPERAND (tmp, TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+  if (TREE_CODE (tmp) == MEM_REF)
+    tmp = TREE_OPERAND (tmp, 0);
+  if (TREE_CODE (tmp) == SSA_NAME)
+    {
+      gimple *def_stmt = SSA_NAME_DEF_STMT (tmp);
+      if (gimple_code (def_stmt) == GIMPLE_ASSIGN)
+       {
+         tmp = gimple_assign_rhs1 (def_stmt);
+         if (poly)
+           {
+             tmp = TYPE_FIELDS (type);
+             type = TREE_TYPE (tmp);
+           }
+         else
+           while (TREE_CODE (tmp) == COMPONENT_REF
+                  || TREE_CODE (tmp) == ARRAY_REF)
+             tmp = TREE_OPERAND (tmp,
+                                 TREE_CODE (tmp) == COMPONENT_REF ? 1 : 0);
+       }
+    }
   /* If the clause argument is nonallocatable, skip is-allocate check. */
   if (GFC_DECL_GET_SCALAR_ALLOCATABLE (tmp)
       || GFC_DECL_GET_SCALAR_POINTER (tmp)

diff --git a/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90 b/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
new file mode 100644 (file)
index 0000000..d5e982b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/alloc-comp-4.f90
@@ -0,0 +1,75 @@
+!
+! Check that mapping with map(var%tiles(1)) works.
+!
+! This uses deep mapping to handle the allocatable
+! derived-type components
+!
+! The tricky part is that GCC generates intermittently
+! an SSA_NAME that needs to be resolved.
+!
+module m
+type t
+ integer, allocatable :: den1(:,:), den2(:,:)
+end type t
+
+type t2
+ type(t), allocatable :: tiles(:)
+end type t2
+end
+
+use m
+use iso_c_binding
+implicit none (type, external)
+type(t2), target :: var
+logical :: is_self_map
+type(C_ptr) :: pden1, pden2, ptiles, ptiles1
+
+allocate(var%tiles(1))
+var%tiles(1)%den1 = reshape([1,2,3,4],[2,2])
+var%tiles(1)%den2 = reshape([11,22,33,44],[2,2])
+
+ptiles = c_loc(var%tiles)
+ptiles1 = c_loc(var%tiles(1))
+pden1 = c_loc(var%tiles(1)%den1)
+pden2 = c_loc(var%tiles(1)%den2)
+
+
+is_self_map = .false.
+!$omp target map(to: is_self_map)
+  is_self_map = .true.
+!$omp end target
+
+!$omp target enter data map(var%tiles(1))
+
+!$omp target firstprivate(ptiles, ptiles1, pden1, pden2)
+ if (any (var%tiles(1)%den1 /= reshape([1,2,3,4],[2,2]))) stop 1
+ if (any (var%tiles(1)%den2 /= reshape([11,22,33,44],[2,2]))) stop 2
+ var%tiles(1)%den1 = var%tiles(1)%den1 + 5
+ var%tiles(1)%den2 = var%tiles(1)%den2 + 7
+
+ if (is_self_map) then
+   if (.not. c_associated (ptiles, c_loc(var%tiles))) stop 3
+   if (.not. c_associated (ptiles1, c_loc(var%tiles(1)))) stop 4
+   if (.not. c_associated (pden1, c_loc(var%tiles(1)%den1))) stop 5
+   if (.not. c_associated (pden2, c_loc(var%tiles(1)%den2))) stop 6
+ else
+   if (c_associated (ptiles, c_loc(var%tiles))) stop 3
+   if (c_associated (ptiles1, c_loc(var%tiles(1)))) stop 4
+   if (c_associated (pden1, c_loc(var%tiles(1)%den1))) stop 5
+   if (c_associated (pden2, c_loc(var%tiles(1)%den2))) stop 6
+ endif
+!$omp end target
+
+if (is_self_map) then
+  if (any (var%tiles(1)%den1 /= 5 + reshape([1,2,3,4],[2,2]))) stop 7
+  if (any (var%tiles(1)%den2 /= 7 + reshape([11,22,33,44],[2,2]))) stop 8
+else
+  if (any (var%tiles(1)%den1 /= reshape([1,2,3,4],[2,2]))) stop 7
+  if (any (var%tiles(1)%den2 /= reshape([11,22,33,44],[2,2]))) stop 8
+endif
+
+!$omp target exit data map(var%tiles(1))
+
+if (any (var%tiles(1)%den1 /= 5 + reshape([1,2,3,4],[2,2]))) stop 7
+if (any (var%tiles(1)%den2 /= 7 + reshape([11,22,33,44],[2,2]))) stop 8
+end