diff mbox

[Fortran] PR53526 - Fix MOVE_ALLOC for coarrays

Message ID 4FC64C57.5060504@net-b.de
State New
Headers show

Commit Message

Tobias Burnus May 30, 2012, 4:35 p.m. UTC 
This patch is related to today's check.c patch, but independent (also 
order wise).

The patch ensures that for scalar coarrays, the array path is taken in 
trans-intrinsic. Thus, "to->data = from->data" gets replaced by "*to = 
*from" such that the array bounds (and with -fcoarray=lib the token) 
gets transferred as well.

While that also affected -fcoarray=single, the main changes are for the 
lib version:
- Call deregister instead of free
- Call sync all if TO is not deregistered. (move_alloc is an image 
control statement and, thus, implies synchronization)

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Tobias Burnus June 10, 2012, 11:45 a.m. UTC | #1 
*ping*

Ditto for: http://gcc.gnu.org/ml/fortran/2012-05/msg00171.html

On 30 May 2012 18:35, Tobias Burnus wrote:
> This patch is related to today's check.c patch, but independent (also 
> order wise).
>
> The patch ensures that for scalar coarrays, the array path is taken in 
> trans-intrinsic. Thus, "to->data = from->data" gets replaced by "*to = 
> *from" such that the array bounds (and with -fcoarray=lib the token) 
> gets transferred as well.
>
> While that also affected -fcoarray=single, the main changes are for 
> the lib version:
> - Call deregister instead of free
> - Call sync all if TO is not deregistered. (move_alloc is an image 
> control statement and, thus, implies synchronization)
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
Tobias Burnus June 16, 2012, 10:25 a.m. UTC | #2 
http://gcc.gnu.org/ml/fortran/2012-05/msg00173.html

On 30.05.2012 18:35, Tobias Burnus wrote:
> This patch is related to today's check.c patch, but independent (also 
> order wise).
>
> The patch ensures that for scalar coarrays, the array path is taken in 
> trans-intrinsic. Thus, "to->data = from->data" gets replaced by "*to = 
> *from" such that the array bounds (and with -fcoarray=lib the token) 
> gets transferred as well.
>
> While that also affected -fcoarray=single, the main changes are for 
> the lib version:
> - Call deregister instead of free
> - Call sync all if TO is not deregistered. (move_alloc is an image 
> control statement and, thus, implies synchronization)
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
Paul Richard Thomas June 18, 2012, 5:52 p.m. UTC | #3 
Dear Tobias,


>> OK for the trunk?

Yes indeed - thanks for the patch.

Cheers

Paul
diff mbox

Patch

2012-05-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/53526
	* trans-intrinsic.c (conv_intrinsic_move_alloc): Handle coarrays.

2012-05-30  Tobias Burnus  <burnus@net-b.de>

	PR fortran/53526
	* gfortran.dg/coarray_lib_move_alloc_1.f90: New.
	* gfortran.dg/coarray/move_alloc_1.f90

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 04d6caa..8cce427 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7243,6 +7243,7 @@  conv_intrinsic_move_alloc (gfc_code *code)
   gfc_se from_se, to_se;
   gfc_ss *from_ss, *to_ss;
   tree tmp;
+  bool coarray;
 
   gfc_start_block (&block);
 
@@ -7254,8 +7255,9 @@  conv_intrinsic_move_alloc (gfc_code *code)
 
   gcc_assert (from_expr->ts.type != BT_CLASS
 	      || to_expr->ts.type == BT_CLASS);
+  coarray = gfc_get_corank (from_expr) != 0;
 
-  if (from_expr->rank == 0)
+  if (from_expr->rank == 0 && !coarray)
     {
       if (from_expr->ts.type != BT_CLASS)
 	from_expr2 = from_expr;
@@ -7366,15 +7368,50 @@  conv_intrinsic_move_alloc (gfc_code *code)
     }
 
   /* Deallocate "to".  */
-  to_ss = gfc_walk_expr (to_expr);
-  from_ss = gfc_walk_expr (from_expr);
+  if (from_expr->rank != 0)
+    {
+      to_ss = gfc_walk_expr (to_expr);
+      from_ss = gfc_walk_expr (from_expr);
+    }
+  else
+    {
+      to_ss = walk_coarray (to_expr);
+      from_ss = walk_coarray (from_expr);
+    }
   gfc_conv_expr_descriptor (&to_se, to_expr, to_ss);
   gfc_conv_expr_descriptor (&from_se, from_expr, from_ss);
 
-  tmp = gfc_conv_descriptor_data_get (to_se.expr);
-  tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE,
-				    NULL_TREE, true, to_expr, false);
-  gfc_add_expr_to_block (&block, tmp);
+  /* For coarrays, call SYNC ALL if TO is already deallocated as MOVE_ALLOC
+     is an image control "statement", cf. IR F08/0040 in 12-006A.  */
+  if (coarray && gfc_option.coarray == GFC_FCOARRAY_LIB)
+    {
+      tree cond;
+
+      tmp = gfc_deallocate_with_status (to_se.expr, NULL_TREE, NULL_TREE,
+					NULL_TREE, NULL_TREE, true, to_expr,
+					true);
+      gfc_add_expr_to_block (&block, tmp);
+
+      tmp = gfc_conv_descriptor_data_get (to_se.expr);
+      cond = fold_build2_loc (input_location, EQ_EXPR,
+			      boolean_type_node, tmp,
+			      fold_convert (TREE_TYPE (tmp),
+					    null_pointer_node));
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sync_all,
+				 3, null_pointer_node, null_pointer_node,
+				 build_int_cst (integer_type_node, 0));
+
+      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, cond,
+			     tmp, build_empty_stmt (input_location));
+      gfc_add_expr_to_block (&block, tmp);
+    }
+  else
+    {
+      tmp = gfc_conv_descriptor_data_get (to_se.expr);
+      tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE, NULL_TREE,
+					NULL_TREE, true, to_expr, false);
+      gfc_add_expr_to_block (&block, tmp);
+    }
 
   /* Move the pointer and update the array descriptor data.  */
   gfc_add_modify_loc (input_location, &block, to_se.expr, from_se.expr);
--- /dev/null	2012-05-29 08:59:25.267676082 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray_lib_move_alloc_1.f90	2012-05-30 17:06:30.000000000 +0200
@@ -0,0 +1,23 @@ 
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! PR fortran/53526
+!
+! Check handling of move_alloc with coarrays
+
+subroutine ma_scalar (aa, bb)
+  integer, allocatable :: aa[:], bb[:]
+  call move_alloc(aa,bb)
+end
+
+subroutine ma_array (cc, dd)
+  integer, allocatable :: cc(:)[:], dd(:)[:]
+  call move_alloc (cc, dd)
+end
+
+! { dg-final { scan-tree-dump-times "free" 0 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sync_all" 2 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } }
+! { dg-final { scan-tree-dump-times "\\*bb = \\*aa" 1 "original" } }
+! { dg-final { scan-tree-dump-times "\\*dd = \\*cc" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
--- /dev/null	2012-05-29 08:59:25.267676082 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/move_alloc_1.f90	2012-05-30 17:08:30.000000000 +0200
@@ -0,0 +1,24 @@ 
+! { dg-do run }
+!
+! PR fortran/53526
+!
+! Check handling of move_alloc with coarrays
+!
+implicit none
+integer, allocatable :: u[:], v[:], w(:)[:,:], x(:)[:,:]
+
+allocate (u[4:*])
+call move_alloc (u, v)
+if (allocated (u)) call abort ()
+if (lcobound (v, dim=1) /= 4) call abort ()
+if (ucobound (v, dim=1) /= 3 + num_images()) call abort ()
+
+allocate (w(-2:3)[4:5,-1:*])
+call move_alloc (w, x)
+if (allocated (w)) call abort ()
+if (lbound (x, dim=1) /= -2) call abort ()
+if (ubound (x, dim=1) /= 3) call abort ()
+if (any (lcobound (x) /= [4, -1])) call abort ()
+if (any (ucobound (x) /= [5, -2 + (num_images()+1)/2])) call abort ()
+
+end