OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/53526 ([Coarray] (lib) Properly handle MOVE_ALLOC for coarrays) 

2012-06-18  Tobias Burnus  <burnus@net-b.de>

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

2012-06-18  Tobias Burnus  <burnus@net-b.de>

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

From-SVN: r188748
This commit is contained in:
Tobias Burnus 2012-06-18 20:15:51 +02:00 committed by Tobias Burnus
parent 284943b022
commit c1fb34c3ae
5 changed files with 102 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/fortran/ChangeLog
View File

@ -1,3 +1,8 @@
2012-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/53526
* trans-intrinsic.c (conv_intrinsic_move_alloc): Handle coarrays.
2012-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/53526

51
gcc/fortran/trans-intrinsic.c
View File

@ -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);

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2012-06-18 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
2012-06-18 Tobias Burnus <burnus@net-b.de>
PR fortran/53526

24
gcc/testsuite/gfortran.dg/coarray/move_alloc_1.f90 Normal file
View File

@ -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

23
gcc/testsuite/gfortran.dg/coarray_lib_move_alloc_1.f90 Normal file
View File

@ -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" } }