public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/coarray_native] Make allocate with source work, some more offset fixes for implied this_image().
@ 2020-12-19 19:49 Thomas König
0 siblings, 0 replies; only message in thread
From: Thomas König @ 2020-12-19 19:49 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:76453c3247faca6dfcf72ec04644e1cb87648d1f
commit 76453c3247faca6dfcf72ec04644e1cb87648d1f
Author: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Sat Dec 19 20:49:03 2020 +0100
Make allocate with source work, some more offset fixes for implied this_image().
gcc/fortran/ChangeLog:
* options.c (gfc_post_options): Always set flag_debug_aux_vars for
shared coarrays.
* resolve.c (gfc_expr_to_initialize): Set extra dimensions to
DIMEN_THIS_IMAGE.
* trans-array.c (cas_add_strides): Re-introduce.
(cas_add_this_image_offset): Rename add_lbound to
correct_full_offset, use cas_add_strides.
gcc/testsuite/ChangeLog:
* gfortran.dg/caf-shared/alloc_coarray_with_source_1.f90: New test.
* gfortran.dg/caf-shared/cobounds_torture_1.f90: New test.
* gfortran.dg/caf-shared/cobounds_torture_2.f90: New test.
* gfortran.dg/caf-shared/cobounds_torture_3.f90: New test.
Diff:
---
gcc/fortran/options.c | 5 +++
gcc/fortran/resolve.c | 23 ++++++++++--
gcc/fortran/trans-array.c | 32 +++++++++++++++--
.../caf-shared/alloc_coarray_with_source_1.f90 | 29 +++++++++++++++
.../gfortran.dg/caf-shared/cobounds_torture_1.f90 | 39 ++++++++++++++++++++
.../gfortran.dg/caf-shared/cobounds_torture_2.f90 | 41 ++++++++++++++++++++++
.../gfortran.dg/caf-shared/cobounds_torture_3.f90 | 38 ++++++++++++++++++++
7 files changed, 202 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index d844fa93115..9e32ae69dde 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -485,6 +485,11 @@ gfc_post_options (const char **pfilename)
gfc_fatal_error ("Maximum subrecord length cannot exceed %d",
MAX_SUBRECORD_LENGTH);
+ /* For now, we always want to debug auxiliary variables we create
+ for shared coarrays. */
+ if (flag_coarray == GFC_FCOARRAY_SHARED)
+ flag_debug_aux_vars = 1;
+
gfc_cpp_post_options ();
if (gfc_option.allow_std & GFC_STD_F2008)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e359c2083c4..40a2f6fb2d9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7606,17 +7606,34 @@ gfc_expr_to_initialize (gfc_expr *e)
if (ref->type == REF_ARRAY && ref->next == NULL)
{
if (ref->u.ar.dimen == 0
- && ref->u.ar.as && ref->u.ar.as->corank)
+ && ref->u.ar.as && ref->u.ar.as->corank
+ && flag_coarray != GFC_FCOARRAY_SHARED)
return result;
ref->u.ar.type = AR_FULL;
for (i = 0; i < ref->u.ar.dimen; i++)
- ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
-
+ {
+ gfc_free_expr (ref->u.ar.start[i]);
+ gfc_free_expr (ref->u.ar.end[i]);
+ gfc_free_expr (ref->u.ar.stride[i]);
+ ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
+ }
break;
}
+ if (flag_coarray == GFC_FCOARRAY_SHARED)
+ {
+ for (i = ref->u.ar.dimen; i < ref->u.ar.dimen + ref->u.ar.codimen; i++)
+ {
+ gfc_free_expr (ref->u.ar.start[i]);
+ gfc_free_expr (ref->u.ar.end[i]);
+ gfc_free_expr (ref->u.ar.stride[i]);
+ ref->u.ar.start[i] = ref->u.ar.end[i] = ref->u.ar.stride[i] = NULL;
+ ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE;
+ }
+ }
+
gfc_free_shape (&result->shape, result->rank);
/* Recalculate rank, shape, etc. */
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5fca413cbc5..1e3579e554a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2940,6 +2940,28 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where);
}
+/* Add stride from rank beg to end - 1. */
+
+static tree
+cas_add_strides (tree expr, tree desc, int beg, int end)
+{
+ int i;
+ tree tmp, stride, lbound;
+ tmp = gfc_index_zero_node;
+ for (i = beg; i < end; i++)
+ {
+ stride = gfc_conv_array_stride (desc, i);
+ lbound = gfc_conv_array_lbound (desc, i);
+ tmp =
+ fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE(tmp), tmp,
+ fold_build2_loc (input_location, MULT_EXPR,
+ TREE_TYPE (stride), stride, lbound));
+ }
+ return fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE(expr),
+ expr, tmp);
+}
+
+
/* If the full offset is needed, this function calculates the new offset via
new_offset = offset
@@ -2947,9 +2969,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript,
+ sum (stride[i]*lbound[i]) over remaining codim. */
static tree
-cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar, bool add_lbound)
+cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar,
+ bool correct_full_offset)
{
tree tmp;
+
/* Calculate the actual offset. */
/* tmp = _gfortran_cas_coarray_this_image (0). */
tmp = build_call_expr_loc (input_location, gfor_fndecl_cas_this_image,
@@ -2960,7 +2984,7 @@ cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar, bool add_l
build_int_cst (TREE_TYPE (tmp), 1));
/* tmp = _gfortran_cas_coarray_this_image (0) - 1 + lbound[first_codim] */
- if (add_lbound)
+ if (correct_full_offset)
tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp), tmp,
gfc_conv_array_lbound(desc, ar->dimen));
@@ -2969,6 +2993,10 @@ cas_add_this_image_offset (tree offset, tree desc, gfc_array_ref *ar, bool add_l
tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
gfc_conv_array_stride (desc, ar->dimen), tmp);
+ if (correct_full_offset)
+ tmp = cas_add_strides (tmp, desc, ar->as->rank + 1,
+ ar->as->rank + ar->as->corank);
+
return fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (offset),
offset, tmp);
}
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/alloc_coarray_with_source_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/alloc_coarray_with_source_1.f90
new file mode 100644
index 00000000000..6634653678c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/alloc_coarray_with_source_1.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+
+program coarray_41
+
+ integer, allocatable :: vec(:)[:,:]
+
+ allocate(vec(10)[2,*], source= 37)
+
+ if (.not. allocated(vec)) error stop
+
+ call foo(vec)
+
+ if (any(vec /= 42)) error stop
+
+ deallocate(vec)
+contains
+
+ subroutine foo(gv)
+
+ integer, allocatable, intent(inout) :: gv(:)[:,:]
+ integer, allocatable :: gvin(:)
+
+ allocate(gvin, mold=gv)
+ gvin = 5
+ gv = gv + gvin
+ end subroutine foo
+
+end program coarray_41
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_1.f90 b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_1.f90
new file mode 100644
index 00000000000..2c8b2891366
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_1.f90
@@ -0,0 +1,39 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+
+program main
+ implicit none
+ integer, dimension(2) :: ia
+ integer, dimension(3) :: ib
+ integer, dimension(4) :: ic
+ integer :: me
+ integer :: a(2)[77:78,3:*]
+ integer :: b(2)[34:35,2:3,*]
+ integer :: c(2) [-21:-20,2:3,4:5,8:*]
+ character(len=20) :: line1, line2, line3
+ me = this_image()
+ ia = this_image(a)
+ ib = this_image(b)
+ ic = this_image(c)
+ a(:)[ia(1),ia(2)] = me
+ b(:)[ib(1),ib(2),ib(3)] = me + 100
+ c(:)[ic(1),ic(2),ic(3),ic(4)] = me + 200
+! print '(Z16)',loc(c(1)[ic(1),ic(2),ic(3),ic(4)]) - (this_image() - 1)*8
+ write (unit=line1,fmt='(*(I4))') a(:)[ia(1),ia(2)]
+ write (unit=line2,fmt='(*(I4))') a(:)
+ write (unit=line3,fmt='(*(I4))') me, me
+ if (line1 /= line2) stop 1
+ if (line1 /= line3) stop 2
+ write (unit=line1,fmt='(*(I4))') b(:)[ib(1),ib(2),ib(3)]
+ write (unit=line2,fmt='(*(I4))') b(:)
+ write (unit=line3,fmt='(*(I4))') me + 100, me + 100
+ if (line1 /= line2) stop 3
+ if (line1 /= line3) stop 4
+ write (unit=line1,fmt='(*(I4))') c(:)[ic(1),ic(2),ic(3),ic(4)]
+ write (unit=line2,fmt='(*(I4))') c(:)
+ write (unit=line3,fmt='(*(I4))') me + 200, me + 200
+ if (line1 /= line2) stop 5
+ if (line1 /= line3) stop 6
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_2.f90 b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_2.f90
new file mode 100644
index 00000000000..f7fe5ab0e22
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_2.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+
+program main
+ implicit none
+ integer, dimension(2) :: ia
+ integer, dimension(3) :: ib
+ integer, dimension(4) :: ic
+ integer :: me
+ integer, allocatable :: a(:)[:,:]
+ integer, allocatable :: b(:)[:,:,:]
+ integer, allocatable :: c(:) [:,:,:,:]
+ character(len=20) :: line1, line2, line3
+ me = this_image()
+ allocate (a(2)[77:78,3:*])
+ allocate (b(2)[34:35,2:3,*])
+ allocate (c(2) [-21:-20,2:3,4:5,8:*])
+ ia = this_image(a)
+ ib = this_image(b)
+ ic = this_image(c)
+ a(:)[ia(1),ia(2)] = me
+ b(:)[ib(1),ib(2),ib(3)] = me + 100
+ c(:)[ic(1),ic(2),ic(3),ic(4)] = me + 200
+ write (unit=line1,fmt='(*(I4))') a(:)[ia(1),ia(2)]
+ write (unit=line2,fmt='(*(I4))') a(:)
+ write (unit=line3,fmt='(*(I4))') me, me
+ if (line1 /= line2) stop 1
+ if (line1 /= line3) stop 2
+ write (unit=line1,fmt='(*(I4))') b(:)[ib(1),ib(2),ib(3)]
+ write (unit=line2,fmt='(*(I4))') b(:)
+ write (unit=line3,fmt='(*(I4))') me + 100, me + 100
+ if (line1 /= line2) stop 3
+ if (line1 /= line3) stop 4
+ write (unit=line1,fmt='(*(I4))') c(:)[ic(1),ic(2),ic(3),ic(4)]
+ write (unit=line2,fmt='(*(I4))') c(:)
+ write (unit=line3,fmt='(*(I4))') me + 200, me + 200
+ if (line1 /= line2) stop 5
+ if (line1 /= line3) stop 6
+end program main
+
+
diff --git a/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_3.f90 b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_3.f90
new file mode 100644
index 00000000000..4b2379542a1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/caf-shared/cobounds_torture_3.f90
@@ -0,0 +1,38 @@
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "2" }
+
+program main
+ implicit none
+ integer, dimension(2) :: ia
+ integer, dimension(3) :: ib
+ integer, dimension(4) :: ic
+ integer :: me
+ integer :: a(2)[77:78,3:*]
+ integer :: b(2)[34:35,2:3,*]
+ integer :: c(2) [-21:-20,2:3,4:5,8:*]
+ character(len=20) :: line1, line2, line3
+ me = this_image()
+ ia = this_image(a)
+ ib = this_image(b)
+ ic = this_image(c)
+ a = me
+ b = me + 100
+ c = me + 200
+ write (unit=line1,fmt='(*(I4))') a(:)[ia(1),ia(2)]
+ write (unit=line2,fmt='(*(I4))') a(:)
+ write (unit=line3,fmt='(*(I4))') me, me
+ if (line1 /= line2) stop 1
+ if (line1 /= line3) stop 2
+ write (unit=line1,fmt='(*(I4))') b(:)[ib(1),ib(2),ib(3)]
+ write (unit=line2,fmt='(*(I4))') b(:)
+ write (unit=line3,fmt='(*(I4))') me + 100, me + 100
+ if (line1 /= line2) stop 3
+ if (line1 /= line3) stop 4
+ write (unit=line1,fmt='(*(I4))') c(:)[ic(1),ic(2),ic(3),ic(4)]
+ write (unit=line2,fmt='(*(I4))') c(:)
+ write (unit=line3,fmt='(*(I4))') me + 200, me + 200
+ if (line1 /= line2) stop 5
+ if (line1 /= line3) stop 6
+end program main
+
+
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-12-19 19:49 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-12-19 19:49 [gcc/devel/coarray_native] Make allocate with source work, some more offset fixes for implied this_image() Thomas König
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).