* [Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing
@ 2018-04-08 12:25 Andre Vehreschild
2018-04-13 7:34 ` [Ping, Fortran, " Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2018-04-08 12:25 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 504 bytes --]
Hi all,
attached patch fixes (to my knowledge) the two PRs 81773 and 83606 where the
result of a coarray get() operation is assigned to an array using a vector as
index. It took me quite long to get it right, because I had to use the
scalarizer which I haven't use directly before. So reviewers with expertise on
using the scalarizer are especially welcome.
Bootstrapped and regtested on x86_64-linux/f27.
Ok for trunk? Backports?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr81773_1.clog --]
[-- Type: text/plain, Size: 718 bytes --]
gcc/fortran/ChangeLog:
2018-04-08 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/81773
PR fortran/83606
* dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored
during dependency computation. They define no data dependency.
* trans-array.c (conv_array_index_offset): The stride can not be set
here, prevent fail.
* trans-intrinsic.c (conv_caf_send): Add creation of temporary array
for caf_get's result and copying to the array with vectorial
indexing.
gcc/testsuite/ChangeLog:
2018-04-08 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/81773
PR fortran/83606
* gfortran.dg/coarray/get_to_indexed_array_1.f90: New test.
* gfortran.dg/coarray/get_to_indirect_array.f90: New test.
[-- Attachment #3: pr81773_1.patch --]
[-- Type: text/x-patch, Size: 9024 bytes --]
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index a0bbd584947..3e14ddc25d8 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -2238,8 +2238,9 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
break;
/* Exactly matching and forward overlapping ranges don't cause a
- dependency. */
- if (fin_dep < GFC_DEP_BACKWARD)
+ dependency, when they are not part of a coarray ref. */
+ if (fin_dep < GFC_DEP_BACKWARD
+ && lref->u.ar.codimen == 0 && rref->u.ar.codimen == 0)
return 0;
/* Keep checking. We only have a dependency if
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index bd731689031..b68e77d5281 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3215,7 +3215,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
}
/* Multiply by the stride. */
- if (!integer_onep (stride))
+ if (stride != NULL && !integer_onep (stride))
index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
index, stride);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a45aec708fb..00edd447bb2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1907,34 +1907,124 @@ conv_caf_send (gfc_code *code) {
}
else
{
- /* If has_vector, pass descriptor for whole array and the
- vector bounds separately. */
- gfc_array_ref *ar, ar2;
- bool has_vector = false;
+ bool has_vector = gfc_has_vector_subscript (lhs_expr);
- if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr))
+ if (gfc_is_coindexed (lhs_expr) || !has_vector)
{
- has_vector = true;
- ar = gfc_find_array_ref (lhs_expr);
- ar2 = *ar;
- memset (ar, '\0', sizeof (*ar));
- ar->as = ar2.as;
- ar->type = AR_FULL;
+ /* If has_vector, pass descriptor for whole array and the
+ vector bounds separately. */
+ gfc_array_ref *ar, ar2;
+ bool has_tmp_lhs_array = false;
+ if (has_vector)
+ {
+ has_tmp_lhs_array = true;
+ ar = gfc_find_array_ref (lhs_expr);
+ ar2 = *ar;
+ memset (ar, '\0', sizeof (*ar));
+ ar->as = ar2.as;
+ ar->type = AR_FULL;
+ }
+ lhs_se.want_pointer = 1;
+ gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+ /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
+ that has the wrong type if component references are done. */
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+ gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
+ if (has_tmp_lhs_array)
+ {
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
+ *ar = ar2;
+ }
}
- lhs_se.want_pointer = 1;
- gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
- /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
- has the wrong type if component references are done. */
- lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
- tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
- if (has_vector)
+ else
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
- *ar = ar2;
+ /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
+ indexed array expression. This is rewritten to:
+
+ tmp_array = arr2[...]
+ arr1 ([...]) = tmp_array
+
+ because using the standard gfc_conv_expr (lhs_expr) did the
+ assignment with lhs and rhs exchanged. */
+
+ gfc_ss *lss_for_tmparray, *lss_real;
+ gfc_loopinfo loop;
+ gfc_se se;
+ stmtblock_t body;
+ tree tmparr_desc, src;
+ tree index = gfc_index_zero_node;
+ tree stride = gfc_index_zero_node;
+ int n;
+
+ /* Walk both sides of the assignment, once to get the shape of the
+ temporary array to create right. */
+ lss_for_tmparray = gfc_walk_expr (lhs_expr);
+ /* And a second time to be able to create an assignment of the
+ temporary to the lhs_expr. gfc_trans_create_temp_array replaces
+ the tree in the descriptor with the one for the temporary
+ array. */
+ lss_real = gfc_walk_expr (lhs_expr);
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, lss_for_tmparray);
+ gfc_add_ss_to_loop (&loop, lss_real);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &lhs_expr->where);
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
+ lss_for_tmparray, lhs_type, NULL_TREE,
+ false, true, false,
+ &lhs_expr->where);
+ tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
+ gfc_start_scalarized_body (&loop, &body);
+ gfc_init_se (&se, NULL);
+ gfc_copy_loopinfo_to_se (&se, &loop);
+ se.ss = lss_real;
+ gfc_conv_expr (&se, lhs_expr);
+ gfc_add_block_to_block (&body, &se.pre);
+
+ /* Walk over all indexes of the loop. */
+ for (n = loop.dimen - 1; n > 0; --n)
+ {
+ tmp = loop.loopvar[n];
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, tmp, loop.from[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, index);
+
+ stride = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop.to[n - 1], loop.from[n - 1]);
+ stride = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ stride, gfc_index_one_node);
+
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ index, loop.from[0]);
+
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ loop.loopvar[0], index);
+
+ src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
+ src = gfc_build_array_ref (src, index, NULL);
+ /* Now create the assignment of lhs_expr = tmp_array. */
+ gfc_add_modify (&body, se.expr, src);
+ gfc_add_block_to_block (&body, &se.post);
+ lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&loop.pre, &loop.post);
+ gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
+ gfc_free_ss (lss_for_tmparray);
+ gfc_free_ss (lss_real);
}
}
diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
new file mode 100644
index 00000000000..04714711707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+! Test that index vector on lhs of caf-expression works correctly.
+
+program pr81773
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(ndim) = -1
+ integer :: res(ndim)[*] = [ (i, i=1, ndim) ]
+ type T
+ integer :: padding
+ integer :: dest(ndim)
+ integer :: src(ndim)
+ end type
+
+ type(T) :: dest
+ type(T), allocatable :: caf[:]
+
+ vec([ndim, 3, 1]) = res(1:3)[1]
+ if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1
+
+ dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )
+ dest%dest([ 4,3,2 ]) = res(3:5)[1]
+ if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2
+
+ vec(:) = -1
+ allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ))
+ vec([ 5,3,2 ]) = caf[1]%src(2:4)
+ if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3
+end
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
new file mode 100644
index 00000000000..efb78353637
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test that pr81773/fortran is fixed.
+
+program get_to_indexed_array
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(1:ndim) = 0
+ integer :: indx(1:2) = [3, 2]
+ integer :: mat(1:ndim, 1:ndim) = 0
+ integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ]
+
+ ! No sync needed, because this test always is running on single image
+ vec([ndim , 1]) = res(1:2)[1]
+ if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then
+ print *,"vec: ", vec, " on image: ", this_image()
+ stop 1
+ end if
+
+ mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2])
+ if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then
+ print *, "mat: ", mat, " on image: ", this_image()
+ stop 2
+ end if
+end
+
+! vim:ts=2:sts=2:sw=2:
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Ping, Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing
2018-04-08 12:25 [Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing Andre Vehreschild
@ 2018-04-13 7:34 ` Andre Vehreschild
2018-04-14 10:53 ` Paul Richard Thomas
0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2018-04-13 7:34 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 616 bytes --]
Ping
On Sun, 8 Apr 2018 14:25:50 +0200
Andre Vehreschild <vehre@gmx.de> wrote:
> Hi all,
>
> attached patch fixes (to my knowledge) the two PRs 81773 and 83606 where the
> result of a coarray get() operation is assigned to an array using a vector as
> index. It took me quite long to get it right, because I had to use the
> scalarizer which I haven't use directly before. So reviewers with expertise on
> using the scalarizer are especially welcome.
>
> Bootstrapped and regtested on x86_64-linux/f27.
>
> Ok for trunk? Backports?
>
> Regards,
> Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr81773_1.clog --]
[-- Type: text/plain, Size: 718 bytes --]
gcc/fortran/ChangeLog:
2018-04-08 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/81773
PR fortran/83606
* dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored
during dependency computation. They define no data dependency.
* trans-array.c (conv_array_index_offset): The stride can not be set
here, prevent fail.
* trans-intrinsic.c (conv_caf_send): Add creation of temporary array
for caf_get's result and copying to the array with vectorial
indexing.
gcc/testsuite/ChangeLog:
2018-04-08 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/81773
PR fortran/83606
* gfortran.dg/coarray/get_to_indexed_array_1.f90: New test.
* gfortran.dg/coarray/get_to_indirect_array.f90: New test.
[-- Attachment #3: pr81773_1.patch --]
[-- Type: text/x-patch, Size: 9024 bytes --]
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index a0bbd584947..3e14ddc25d8 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -2238,8 +2238,9 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
break;
/* Exactly matching and forward overlapping ranges don't cause a
- dependency. */
- if (fin_dep < GFC_DEP_BACKWARD)
+ dependency, when they are not part of a coarray ref. */
+ if (fin_dep < GFC_DEP_BACKWARD
+ && lref->u.ar.codimen == 0 && rref->u.ar.codimen == 0)
return 0;
/* Keep checking. We only have a dependency if
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index bd731689031..b68e77d5281 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3215,7 +3215,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
}
/* Multiply by the stride. */
- if (!integer_onep (stride))
+ if (stride != NULL && !integer_onep (stride))
index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
index, stride);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a45aec708fb..00edd447bb2 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -1907,34 +1907,124 @@ conv_caf_send (gfc_code *code) {
}
else
{
- /* If has_vector, pass descriptor for whole array and the
- vector bounds separately. */
- gfc_array_ref *ar, ar2;
- bool has_vector = false;
+ bool has_vector = gfc_has_vector_subscript (lhs_expr);
- if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr))
+ if (gfc_is_coindexed (lhs_expr) || !has_vector)
{
- has_vector = true;
- ar = gfc_find_array_ref (lhs_expr);
- ar2 = *ar;
- memset (ar, '\0', sizeof (*ar));
- ar->as = ar2.as;
- ar->type = AR_FULL;
+ /* If has_vector, pass descriptor for whole array and the
+ vector bounds separately. */
+ gfc_array_ref *ar, ar2;
+ bool has_tmp_lhs_array = false;
+ if (has_vector)
+ {
+ has_tmp_lhs_array = true;
+ ar = gfc_find_array_ref (lhs_expr);
+ ar2 = *ar;
+ memset (ar, '\0', sizeof (*ar));
+ ar->as = ar2.as;
+ ar->type = AR_FULL;
+ }
+ lhs_se.want_pointer = 1;
+ gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+ /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
+ that has the wrong type if component references are done. */
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+ gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
+ if (has_tmp_lhs_array)
+ {
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
+ *ar = ar2;
+ }
}
- lhs_se.want_pointer = 1;
- gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
- /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
- has the wrong type if component references are done. */
- lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
- tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
- if (has_vector)
+ else
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
- *ar = ar2;
+ /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
+ indexed array expression. This is rewritten to:
+
+ tmp_array = arr2[...]
+ arr1 ([...]) = tmp_array
+
+ because using the standard gfc_conv_expr (lhs_expr) did the
+ assignment with lhs and rhs exchanged. */
+
+ gfc_ss *lss_for_tmparray, *lss_real;
+ gfc_loopinfo loop;
+ gfc_se se;
+ stmtblock_t body;
+ tree tmparr_desc, src;
+ tree index = gfc_index_zero_node;
+ tree stride = gfc_index_zero_node;
+ int n;
+
+ /* Walk both sides of the assignment, once to get the shape of the
+ temporary array to create right. */
+ lss_for_tmparray = gfc_walk_expr (lhs_expr);
+ /* And a second time to be able to create an assignment of the
+ temporary to the lhs_expr. gfc_trans_create_temp_array replaces
+ the tree in the descriptor with the one for the temporary
+ array. */
+ lss_real = gfc_walk_expr (lhs_expr);
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, lss_for_tmparray);
+ gfc_add_ss_to_loop (&loop, lss_real);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &lhs_expr->where);
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
+ lss_for_tmparray, lhs_type, NULL_TREE,
+ false, true, false,
+ &lhs_expr->where);
+ tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
+ gfc_start_scalarized_body (&loop, &body);
+ gfc_init_se (&se, NULL);
+ gfc_copy_loopinfo_to_se (&se, &loop);
+ se.ss = lss_real;
+ gfc_conv_expr (&se, lhs_expr);
+ gfc_add_block_to_block (&body, &se.pre);
+
+ /* Walk over all indexes of the loop. */
+ for (n = loop.dimen - 1; n > 0; --n)
+ {
+ tmp = loop.loopvar[n];
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, tmp, loop.from[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, index);
+
+ stride = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop.to[n - 1], loop.from[n - 1]);
+ stride = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ stride, gfc_index_one_node);
+
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ index, loop.from[0]);
+
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ loop.loopvar[0], index);
+
+ src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
+ src = gfc_build_array_ref (src, index, NULL);
+ /* Now create the assignment of lhs_expr = tmp_array. */
+ gfc_add_modify (&body, se.expr, src);
+ gfc_add_block_to_block (&body, &se.post);
+ lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&loop.pre, &loop.post);
+ gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
+ gfc_free_ss (lss_for_tmparray);
+ gfc_free_ss (lss_real);
}
}
diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
new file mode 100644
index 00000000000..04714711707
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+! Test that index vector on lhs of caf-expression works correctly.
+
+program pr81773
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(ndim) = -1
+ integer :: res(ndim)[*] = [ (i, i=1, ndim) ]
+ type T
+ integer :: padding
+ integer :: dest(ndim)
+ integer :: src(ndim)
+ end type
+
+ type(T) :: dest
+ type(T), allocatable :: caf[:]
+
+ vec([ndim, 3, 1]) = res(1:3)[1]
+ if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1
+
+ dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )
+ dest%dest([ 4,3,2 ]) = res(3:5)[1]
+ if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2
+
+ vec(:) = -1
+ allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ))
+ vec([ 5,3,2 ]) = caf[1]%src(2:4)
+ if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3
+end
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
new file mode 100644
index 00000000000..efb78353637
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test that pr81773/fortran is fixed.
+
+program get_to_indexed_array
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(1:ndim) = 0
+ integer :: indx(1:2) = [3, 2]
+ integer :: mat(1:ndim, 1:ndim) = 0
+ integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ]
+
+ ! No sync needed, because this test always is running on single image
+ vec([ndim , 1]) = res(1:2)[1]
+ if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then
+ print *,"vec: ", vec, " on image: ", this_image()
+ stop 1
+ end if
+
+ mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2])
+ if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then
+ print *, "mat: ", mat, " on image: ", this_image()
+ stop 2
+ end if
+end
+
+! vim:ts=2:sts=2:sw=2:
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Ping, Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing
2018-04-13 7:34 ` [Ping, Fortran, " Andre Vehreschild
@ 2018-04-14 10:53 ` Paul Richard Thomas
2018-04-14 14:47 ` Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Paul Richard Thomas @ 2018-04-14 10:53 UTC (permalink / raw)
To: Andre Vehreschild; +Cc: GCC-Patches-ML, GCC-Fortran-ML
Hi Andre,
This is OK for trunk.
Thanks for the patch
Paul
On 13 April 2018 at 08:34, Andre Vehreschild <vehre@gmx.de> wrote:
> Ping
>
> On Sun, 8 Apr 2018 14:25:50 +0200
> Andre Vehreschild <vehre@gmx.de> wrote:
>
>> Hi all,
>>
>> attached patch fixes (to my knowledge) the two PRs 81773 and 83606 where the
>> result of a coarray get() operation is assigned to an array using a vector as
>> index. It took me quite long to get it right, because I had to use the
>> scalarizer which I haven't use directly before. So reviewers with expertise on
>> using the scalarizer are especially welcome.
>>
>> Bootstrapped and regtested on x86_64-linux/f27.
>>
>> Ok for trunk? Backports?
>>
>> Regards,
>> Andre
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Ping, Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing
2018-04-14 10:53 ` Paul Richard Thomas
@ 2018-04-14 14:47 ` Andre Vehreschild
2018-04-28 14:54 ` Andre Vehreschild
0 siblings, 1 reply; 5+ messages in thread
From: Andre Vehreschild @ 2018-04-14 14:47 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 1078 bytes --]
Hi Paul,
thank you for the review. Committed as r259385.
Regards,
Andre
On Sat, 14 Apr 2018 11:53:44 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Hi Andre,
>
> This is OK for trunk.
>
> Thanks for the patch
>
> Paul
>
>
> On 13 April 2018 at 08:34, Andre Vehreschild <vehre@gmx.de> wrote:
> > Ping
> >
> > On Sun, 8 Apr 2018 14:25:50 +0200
> > Andre Vehreschild <vehre@gmx.de> wrote:
> >
> >> Hi all,
> >>
> >> attached patch fixes (to my knowledge) the two PRs 81773 and 83606 where
> >> the result of a coarray get() operation is assigned to an array using a
> >> vector as index. It took me quite long to get it right, because I had to
> >> use the scalarizer which I haven't use directly before. So reviewers with
> >> expertise on using the scalarizer are especially welcome.
> >>
> >> Bootstrapped and regtested on x86_64-linux/f27.
> >>
> >> Ok for trunk? Backports?
> >>
> >> Regards,
> >> Andre
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 10215 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 259384)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,15 @@
+2018-04-14 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ * dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored
+ during dependency computation. They define no data dependency.
+ * trans-array.c (conv_array_index_offset): The stride can not be set
+ here, prevent fail.
+ * trans-intrinsic.c (conv_caf_send): Add creation of temporary array
+ for caf_get's result and copying to the array with vectorial
+ indexing.
+
2018-04-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85387
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c (Revision 259384)
+++ gcc/fortran/dependency.c (Arbeitskopie)
@@ -2238,8 +2238,9 @@
break;
/* Exactly matching and forward overlapping ranges don't cause a
- dependency. */
- if (fin_dep < GFC_DEP_BACKWARD)
+ dependency, when they are not part of a coarray ref. */
+ if (fin_dep < GFC_DEP_BACKWARD
+ && lref->u.ar.codimen == 0 && rref->u.ar.codimen == 0)
return 0;
/* Keep checking. We only have a dependency if
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 259384)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -3215,7 +3215,7 @@
}
/* Multiply by the stride. */
- if (!integer_onep (stride))
+ if (stride != NULL && !integer_onep (stride))
index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
index, stride);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 259384)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1907,34 +1907,124 @@
}
else
{
- /* If has_vector, pass descriptor for whole array and the
- vector bounds separately. */
- gfc_array_ref *ar, ar2;
- bool has_vector = false;
+ bool has_vector = gfc_has_vector_subscript (lhs_expr);
- if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr))
+ if (gfc_is_coindexed (lhs_expr) || !has_vector)
{
- has_vector = true;
- ar = gfc_find_array_ref (lhs_expr);
- ar2 = *ar;
- memset (ar, '\0', sizeof (*ar));
- ar->as = ar2.as;
- ar->type = AR_FULL;
+ /* If has_vector, pass descriptor for whole array and the
+ vector bounds separately. */
+ gfc_array_ref *ar, ar2;
+ bool has_tmp_lhs_array = false;
+ if (has_vector)
+ {
+ has_tmp_lhs_array = true;
+ ar = gfc_find_array_ref (lhs_expr);
+ ar2 = *ar;
+ memset (ar, '\0', sizeof (*ar));
+ ar->as = ar2.as;
+ ar->type = AR_FULL;
+ }
+ lhs_se.want_pointer = 1;
+ gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+ /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
+ that has the wrong type if component references are done. */
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+ gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
+ if (has_tmp_lhs_array)
+ {
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
+ *ar = ar2;
+ }
}
- lhs_se.want_pointer = 1;
- gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
- /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
- has the wrong type if component references are done. */
- lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
- tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
- if (has_vector)
+ else
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
- *ar = ar2;
+ /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
+ indexed array expression. This is rewritten to:
+
+ tmp_array = arr2[...]
+ arr1 ([...]) = tmp_array
+
+ because using the standard gfc_conv_expr (lhs_expr) did the
+ assignment with lhs and rhs exchanged. */
+
+ gfc_ss *lss_for_tmparray, *lss_real;
+ gfc_loopinfo loop;
+ gfc_se se;
+ stmtblock_t body;
+ tree tmparr_desc, src;
+ tree index = gfc_index_zero_node;
+ tree stride = gfc_index_zero_node;
+ int n;
+
+ /* Walk both sides of the assignment, once to get the shape of the
+ temporary array to create right. */
+ lss_for_tmparray = gfc_walk_expr (lhs_expr);
+ /* And a second time to be able to create an assignment of the
+ temporary to the lhs_expr. gfc_trans_create_temp_array replaces
+ the tree in the descriptor with the one for the temporary
+ array. */
+ lss_real = gfc_walk_expr (lhs_expr);
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, lss_for_tmparray);
+ gfc_add_ss_to_loop (&loop, lss_real);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &lhs_expr->where);
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
+ lss_for_tmparray, lhs_type, NULL_TREE,
+ false, true, false,
+ &lhs_expr->where);
+ tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
+ gfc_start_scalarized_body (&loop, &body);
+ gfc_init_se (&se, NULL);
+ gfc_copy_loopinfo_to_se (&se, &loop);
+ se.ss = lss_real;
+ gfc_conv_expr (&se, lhs_expr);
+ gfc_add_block_to_block (&body, &se.pre);
+
+ /* Walk over all indexes of the loop. */
+ for (n = loop.dimen - 1; n > 0; --n)
+ {
+ tmp = loop.loopvar[n];
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, tmp, loop.from[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, index);
+
+ stride = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop.to[n - 1], loop.from[n - 1]);
+ stride = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ stride, gfc_index_one_node);
+
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ index, loop.from[0]);
+
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ loop.loopvar[0], index);
+
+ src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
+ src = gfc_build_array_ref (src, index, NULL);
+ /* Now create the assignment of lhs_expr = tmp_array. */
+ gfc_add_modify (&body, se.expr, src);
+ gfc_add_block_to_block (&body, &se.post);
+ lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&loop.pre, &loop.post);
+ gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
+ gfc_free_ss (lss_for_tmparray);
+ gfc_free_ss (lss_real);
}
}
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 259384)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,10 @@
+2018-04-14 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ * gfortran.dg/coarray/get_to_indexed_array_1.f90: New test.
+ * gfortran.dg/coarray/get_to_indirect_array.f90: New test.
+
2018-04-14 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/85387
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (Arbeitskopie)
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+! Test that index vector on lhs of caf-expression works correctly.
+
+program pr81773
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(ndim) = -1
+ integer :: res(ndim)[*] = [ (i, i=1, ndim) ]
+ type T
+ integer :: padding
+ integer :: dest(ndim)
+ integer :: src(ndim)
+ end type
+
+ type(T) :: dest
+ type(T), allocatable :: caf[:]
+
+ vec([ndim, 3, 1]) = res(1:3)[1]
+ if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1
+
+ dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )
+ dest%dest([ 4,3,2 ]) = res(3:5)[1]
+ if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2
+
+ vec(:) = -1
+ allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ))
+ vec([ 5,3,2 ]) = caf[1]%src(2:4)
+ if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3
+end
+
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test that pr81773/fortran is fixed.
+
+program get_to_indexed_array
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(1:ndim) = 0
+ integer :: indx(1:2) = [3, 2]
+ integer :: mat(1:ndim, 1:ndim) = 0
+ integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ]
+
+ ! No sync needed, because this test always is running on single image
+ vec([ndim , 1]) = res(1:2)[1]
+ if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then
+ print *,"vec: ", vec, " on image: ", this_image()
+ stop 1
+ end if
+
+ mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2])
+ if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then
+ print *, "mat: ", mat, " on image: ", this_image()
+ stop 2
+ end if
+end
+
+! vim:ts=2:sts=2:sw=2:
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [Ping, Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing
2018-04-14 14:47 ` Andre Vehreschild
@ 2018-04-28 14:54 ` Andre Vehreschild
0 siblings, 0 replies; 5+ messages in thread
From: Andre Vehreschild @ 2018-04-28 14:54 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: GCC-Patches-ML, GCC-Fortran-ML
[-- Attachment #1: Type: text/plain, Size: 1392 bytes --]
Hi all,
because pr81773 is a 6-/7-/8-regression I have backported it to gcc-6 as r259741
and gcc-7 as r259742.
Regards,
Andre
On Sat, 14 Apr 2018 16:46:53 +0200
Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Paul,
>
> thank you for the review. Committed as r259385.
>
> Regards,
> Andre
>
> On Sat, 14 Apr 2018 11:53:44 +0100
> Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
>
> > Hi Andre,
> >
> > This is OK for trunk.
> >
> > Thanks for the patch
> >
> > Paul
> >
> >
> > On 13 April 2018 at 08:34, Andre Vehreschild <vehre@gmx.de> wrote:
> > > Ping
> > >
> > > On Sun, 8 Apr 2018 14:25:50 +0200
> > > Andre Vehreschild <vehre@gmx.de> wrote:
> > >
> > >> Hi all,
> > >>
> > >> attached patch fixes (to my knowledge) the two PRs 81773 and 83606 where
> > >> the result of a coarray get() operation is assigned to an array using a
> > >> vector as index. It took me quite long to get it right, because I had to
> > >> use the scalarizer which I haven't use directly before. So reviewers with
> > >> expertise on using the scalarizer are especially welcome.
> > >>
> > >> Bootstrapped and regtested on x86_64-linux/f27.
> > >>
> > >> Ok for trunk? Backports?
> > >>
> > >> Regards,
> > >> Andre
> > >
> > >
> > > --
> > > Andre Vehreschild * Email: vehre ad gmx dot de
> >
> >
> >
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit-6.diff --]
[-- Type: text/x-patch, Size: 10261 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 259739)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,16 @@
+2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ Backport from trunk.
+ * dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored
+ during dependency computation. They define no data dependency.
+ * trans-array.c (conv_array_index_offset): The stride can not be set
+ here, prevent fail.
+ * trans-intrinsic.c (conv_caf_send): Add creation of temporary array
+ for caf_get's result and copying to the array with vectorial
+ indexing.
+
2018-04-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/85520
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c (Revision 259739)
+++ gcc/fortran/dependency.c (Arbeitskopie)
@@ -2239,8 +2239,9 @@
break;
/* Exactly matching and forward overlapping ranges don't cause a
- dependency. */
- if (fin_dep < GFC_DEP_BACKWARD)
+ dependency, when they are not part of a coarray ref. */
+ if (fin_dep < GFC_DEP_BACKWARD
+ && lref->u.ar.codimen == 0 && rref->u.ar.codimen == 0)
return 0;
/* Keep checking. We only have a dependency if
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 259739)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -3022,7 +3022,7 @@
}
/* Multiply by the stride. */
- if (!integer_onep (stride))
+ if (stride != NULL && !integer_onep (stride))
index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
index, stride);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 259739)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1266,34 +1266,124 @@
}
else
{
- /* If has_vector, pass descriptor for whole array and the
- vector bounds separately. */
- gfc_array_ref *ar, ar2;
- bool has_vector = false;
+ bool has_vector = gfc_has_vector_subscript (lhs_expr);
- if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr))
+ if (gfc_is_coindexed (lhs_expr) || !has_vector)
{
- has_vector = true;
- ar = gfc_find_array_ref (lhs_expr);
- ar2 = *ar;
- memset (ar, '\0', sizeof (*ar));
- ar->as = ar2.as;
- ar->type = AR_FULL;
+ /* If has_vector, pass descriptor for whole array and the
+ vector bounds separately. */
+ gfc_array_ref *ar, ar2;
+ bool has_tmp_lhs_array = false;
+ if (has_vector)
+ {
+ has_tmp_lhs_array = true;
+ ar = gfc_find_array_ref (lhs_expr);
+ ar2 = *ar;
+ memset (ar, '\0', sizeof (*ar));
+ ar->as = ar2.as;
+ ar->type = AR_FULL;
+ }
+ lhs_se.want_pointer = 1;
+ gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+ /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
+ that has the wrong type if component references are done. */
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+ gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
+ if (has_tmp_lhs_array)
+ {
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
+ *ar = ar2;
+ }
}
- lhs_se.want_pointer = 1;
- gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
- /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
- has the wrong type if component references are done. */
- lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
- tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
- if (has_vector)
+ else
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
- *ar = ar2;
+ /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
+ indexed array expression. This is rewritten to:
+
+ tmp_array = arr2[...]
+ arr1 ([...]) = tmp_array
+
+ because using the standard gfc_conv_expr (lhs_expr) did the
+ assignment with lhs and rhs exchanged. */
+
+ gfc_ss *lss_for_tmparray, *lss_real;
+ gfc_loopinfo loop;
+ gfc_se se;
+ stmtblock_t body;
+ tree tmparr_desc, src;
+ tree index = gfc_index_zero_node;
+ tree stride = gfc_index_zero_node;
+ int n;
+
+ /* Walk both sides of the assignment, once to get the shape of the
+ temporary array to create right. */
+ lss_for_tmparray = gfc_walk_expr (lhs_expr);
+ /* And a second time to be able to create an assignment of the
+ temporary to the lhs_expr. gfc_trans_create_temp_array replaces
+ the tree in the descriptor with the one for the temporary
+ array. */
+ lss_real = gfc_walk_expr (lhs_expr);
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, lss_for_tmparray);
+ gfc_add_ss_to_loop (&loop, lss_real);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &lhs_expr->where);
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
+ lss_for_tmparray, lhs_type, NULL_TREE,
+ false, true, false,
+ &lhs_expr->where);
+ tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
+ gfc_start_scalarized_body (&loop, &body);
+ gfc_init_se (&se, NULL);
+ gfc_copy_loopinfo_to_se (&se, &loop);
+ se.ss = lss_real;
+ gfc_conv_expr (&se, lhs_expr);
+ gfc_add_block_to_block (&body, &se.pre);
+
+ /* Walk over all indexes of the loop. */
+ for (n = loop.dimen - 1; n > 0; --n)
+ {
+ tmp = loop.loopvar[n];
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, tmp, loop.from[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, index);
+
+ stride = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop.to[n - 1], loop.from[n - 1]);
+ stride = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ stride, gfc_index_one_node);
+
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ index, loop.from[0]);
+
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ loop.loopvar[0], index);
+
+ src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
+ src = gfc_build_array_ref (src, index, NULL);
+ /* Now create the assignment of lhs_expr = tmp_array. */
+ gfc_add_modify (&body, se.expr, src);
+ gfc_add_block_to_block (&body, &se.post);
+ lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&loop.pre, &loop.post);
+ gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
+ gfc_free_ss (lss_for_tmparray);
+ gfc_free_ss (lss_real);
}
}
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 259739)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ Backport from trunk.
+ * gfortran.dg/coarray/get_to_indexed_array_1.f90: New test.
+ * gfortran.dg/coarray/get_to_indirect_array.f90: New test.
+
2018-04-25 Martin Liska <mliska@suse.cz>
Backport from mainline
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (Arbeitskopie)
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+! Test that index vector on lhs of caf-expression works correctly.
+
+program pr81773
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(ndim) = -1
+ integer :: res(ndim)[*] = [ (i, i=1, ndim) ]
+ type T
+ integer :: padding
+ integer :: dest(ndim)
+ integer :: src(ndim)
+ end type
+
+ type(T) :: dest
+ type(T), allocatable :: caf[:]
+
+ vec([ndim, 3, 1]) = res(1:3)[1]
+ if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1
+
+ dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )
+ dest%dest([ 4,3,2 ]) = res(3:5)[1]
+ if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2
+
+ vec(:) = -1
+ allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ))
+ vec([ 5,3,2 ]) = caf[1]%src(2:4)
+ if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3
+end
+
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test that pr81773/fortran is fixed.
+
+program get_to_indexed_array
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(1:ndim) = 0
+ integer :: indx(1:2) = [3, 2]
+ integer :: mat(1:ndim, 1:ndim) = 0
+ integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ]
+
+ ! No sync needed, because this test always is running on single image
+ vec([ndim , 1]) = res(1:2)[1]
+ if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then
+ print *,"vec: ", vec, " on image: ", this_image()
+ stop 1
+ end if
+
+ mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2])
+ if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then
+ print *, "mat: ", mat, " on image: ", this_image()
+ stop 2
+ end if
+end
+
+! vim:ts=2:sts=2:sw=2:
[-- Attachment #3: submit-7.diff --]
[-- Type: text/x-patch, Size: 10266 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 259740)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,16 @@
+2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ Backport from trunk.
+ * dependency.c (gfc_dep_resolver): Coarray indexes are to be ignored
+ during dependency computation. They define no data dependency.
+ * trans-array.c (conv_array_index_offset): The stride can not be set
+ here, prevent fail.
+ * trans-intrinsic.c (conv_caf_send): Add creation of temporary array
+ for caf_get's result and copying to the array with vectorial
+ indexing.
+
2018-04-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/85520
Index: gcc/fortran/dependency.c
===================================================================
--- gcc/fortran/dependency.c (Revision 259740)
+++ gcc/fortran/dependency.c (Arbeitskopie)
@@ -2238,8 +2238,9 @@
break;
/* Exactly matching and forward overlapping ranges don't cause a
- dependency. */
- if (fin_dep < GFC_DEP_BACKWARD)
+ dependency, when they are not part of a coarray ref. */
+ if (fin_dep < GFC_DEP_BACKWARD
+ && lref->u.ar.codimen == 0 && rref->u.ar.codimen == 0)
return 0;
/* Keep checking. We only have a dependency if
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 259740)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -3073,7 +3073,7 @@
}
/* Multiply by the stride. */
- if (!integer_onep (stride))
+ if (stride != NULL && !integer_onep (stride))
index = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
index, stride);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 259740)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -1906,34 +1906,124 @@
}
else
{
- /* If has_vector, pass descriptor for whole array and the
- vector bounds separately. */
- gfc_array_ref *ar, ar2;
- bool has_vector = false;
+ bool has_vector = gfc_has_vector_subscript (lhs_expr);
- if (gfc_is_coindexed (lhs_expr) && gfc_has_vector_subscript (lhs_expr))
+ if (gfc_is_coindexed (lhs_expr) || !has_vector)
{
- has_vector = true;
- ar = gfc_find_array_ref (lhs_expr);
- ar2 = *ar;
- memset (ar, '\0', sizeof (*ar));
- ar->as = ar2.as;
- ar->type = AR_FULL;
+ /* If has_vector, pass descriptor for whole array and the
+ vector bounds separately. */
+ gfc_array_ref *ar, ar2;
+ bool has_tmp_lhs_array = false;
+ if (has_vector)
+ {
+ has_tmp_lhs_array = true;
+ ar = gfc_find_array_ref (lhs_expr);
+ ar2 = *ar;
+ memset (ar, '\0', sizeof (*ar));
+ ar->as = ar2.as;
+ ar->type = AR_FULL;
+ }
+ lhs_se.want_pointer = 1;
+ gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
+ /* Using gfc_conv_expr_descriptor, we only get the descriptor, but
+ that has the wrong type if component references are done. */
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
+ gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
+ gfc_get_dtype_rank_type (has_vector ? ar2.dimen
+ : lhs_expr->rank,
+ lhs_type));
+ if (has_tmp_lhs_array)
+ {
+ vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
+ *ar = ar2;
+ }
}
- lhs_se.want_pointer = 1;
- gfc_conv_expr_descriptor (&lhs_se, lhs_expr);
- /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
- has the wrong type if component references are done. */
- lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
- tmp = build_fold_indirect_ref_loc (input_location, lhs_se.expr);
- gfc_add_modify (&lhs_se.pre, gfc_conv_descriptor_dtype (tmp),
- gfc_get_dtype_rank_type (has_vector ? ar2.dimen
- : lhs_expr->rank,
- lhs_type));
- if (has_vector)
+ else
{
- vec = conv_caf_vector_subscript (&block, lhs_se.expr, &ar2);
- *ar = ar2;
+ /* Special casing for arr1 ([...]) = arr2[...], i.e. caf_get to
+ indexed array expression. This is rewritten to:
+
+ tmp_array = arr2[...]
+ arr1 ([...]) = tmp_array
+
+ because using the standard gfc_conv_expr (lhs_expr) did the
+ assignment with lhs and rhs exchanged. */
+
+ gfc_ss *lss_for_tmparray, *lss_real;
+ gfc_loopinfo loop;
+ gfc_se se;
+ stmtblock_t body;
+ tree tmparr_desc, src;
+ tree index = gfc_index_zero_node;
+ tree stride = gfc_index_zero_node;
+ int n;
+
+ /* Walk both sides of the assignment, once to get the shape of the
+ temporary array to create right. */
+ lss_for_tmparray = gfc_walk_expr (lhs_expr);
+ /* And a second time to be able to create an assignment of the
+ temporary to the lhs_expr. gfc_trans_create_temp_array replaces
+ the tree in the descriptor with the one for the temporary
+ array. */
+ lss_real = gfc_walk_expr (lhs_expr);
+ gfc_init_loopinfo (&loop);
+ gfc_add_ss_to_loop (&loop, lss_for_tmparray);
+ gfc_add_ss_to_loop (&loop, lss_real);
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop, &lhs_expr->where);
+ lhs_type = gfc_typenode_for_spec (&lhs_expr->ts);
+ gfc_trans_create_temp_array (&lhs_se.pre, &lhs_se.post,
+ lss_for_tmparray, lhs_type, NULL_TREE,
+ false, true, false,
+ &lhs_expr->where);
+ tmparr_desc = lss_for_tmparray->info->data.array.descriptor;
+ gfc_start_scalarized_body (&loop, &body);
+ gfc_init_se (&se, NULL);
+ gfc_copy_loopinfo_to_se (&se, &loop);
+ se.ss = lss_real;
+ gfc_conv_expr (&se, lhs_expr);
+ gfc_add_block_to_block (&body, &se.pre);
+
+ /* Walk over all indexes of the loop. */
+ for (n = loop.dimen - 1; n > 0; --n)
+ {
+ tmp = loop.loopvar[n];
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, tmp, loop.from[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, index);
+
+ stride = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ loop.to[n - 1], loop.from[n - 1]);
+ stride = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ stride, gfc_index_one_node);
+
+ index = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+
+ index = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ index, loop.from[0]);
+
+ index = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ loop.loopvar[0], index);
+
+ src = build_fold_indirect_ref (gfc_conv_array_data (tmparr_desc));
+ src = gfc_build_array_ref (src, index, NULL);
+ /* Now create the assignment of lhs_expr = tmp_array. */
+ gfc_add_modify (&body, se.expr, src);
+ gfc_add_block_to_block (&body, &se.post);
+ lhs_se.expr = gfc_build_addr_expr (NULL_TREE, tmparr_desc);
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&loop.pre, &loop.post);
+ gfc_add_expr_to_block (&lhs_se.post, gfc_finish_block (&loop.pre));
+ gfc_free_ss (lss_for_tmparray);
+ gfc_free_ss (lss_real);
}
}
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 259740)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2018-04-28 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/81773
+ PR fortran/83606
+ Backport from trunk.
+ * gfortran.dg/coarray/get_to_indexed_array_1.f90: New test.
+ * gfortran.dg/coarray/get_to_indirect_array.f90: New test.
+
2018-04-26 Richard Biener <rguenther@suse.de>
Backport from mainline
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indexed_array_1.f90 (Arbeitskopie)
@@ -0,0 +1,32 @@
+! { dg-do run }
+
+! Test that index vector on lhs of caf-expression works correctly.
+
+program pr81773
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(ndim) = -1
+ integer :: res(ndim)[*] = [ (i, i=1, ndim) ]
+ type T
+ integer :: padding
+ integer :: dest(ndim)
+ integer :: src(ndim)
+ end type
+
+ type(T) :: dest
+ type(T), allocatable :: caf[:]
+
+ vec([ndim, 3, 1]) = res(1:3)[1]
+ if (any (vec /= [ 3, -1, 2, -1, 1])) stop 1
+
+ dest = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] )
+ dest%dest([ 4,3,2 ]) = res(3:5)[1]
+ if (any (dest%dest /= [-1, 5, 4, 3, -1])) stop 2
+
+ vec(:) = -1
+ allocate(caf[*], source = T(42, [ ( -1, i = 1, ndim ) ], [ ( i - 2, i = ndim, 1, -1) ] ))
+ vec([ 5,3,2 ]) = caf[1]%src(2:4)
+ if (any (vec /= [ -1, 0, 1, -1, 2])) stop 3
+end
+
Index: gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (nicht existent)
+++ gcc/testsuite/gfortran.dg/coarray/get_to_indirect_array.f90 (Arbeitskopie)
@@ -0,0 +1,28 @@
+! { dg-do run }
+!
+! Test that pr81773/fortran is fixed.
+
+program get_to_indexed_array
+
+ integer, parameter :: ndim = 5
+ integer :: i
+ integer :: vec(1:ndim) = 0
+ integer :: indx(1:2) = [3, 2]
+ integer :: mat(1:ndim, 1:ndim) = 0
+ integer :: res(1:ndim)[*]=[ (i, i=1, ndim) ]
+
+ ! No sync needed, because this test always is running on single image
+ vec([ndim , 1]) = res(1:2)[1]
+ if (vec(1) /= res(2) .or. vec(ndim) /= res(1)) then
+ print *,"vec: ", vec, " on image: ", this_image()
+ stop 1
+ end if
+
+ mat(2:3,[indx(:)]) = reshape(res(1:4)[1], [2, 2])
+ if (any(mat(2:3, 3:2:-1) /= reshape(res(1:4), [2,2]))) then
+ print *, "mat: ", mat, " on image: ", this_image()
+ stop 2
+ end if
+end
+
+! vim:ts=2:sts=2:sw=2:
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2018-04-28 14:54 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-04-08 12:25 [Fortran, Patch, PR81773, PR83606, coarray, v1] Fix coarray get to array with vector indexing Andre Vehreschild
2018-04-13 7:34 ` [Ping, Fortran, " Andre Vehreschild
2018-04-14 10:53 ` Paul Richard Thomas
2018-04-14 14:47 ` Andre Vehreschild
2018-04-28 14:54 ` Andre Vehreschild
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).