From: Tobias Burnus Date: Thu, 23 Sep 2021 16:47:45 +0000 (+0200) Subject: Fortran: Handle allocated() with coindexed scalars [PR93834] X-Git-Tag: upstream/12.2.0~4831 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=1b07d9dce6c51c98d011236c3d4cd84a2ed59ba2;p=platform%2Fupstream%2Fgcc.git Fortran: Handle allocated() with coindexed scalars [PR93834] While for an allocatable 'array', 'array(:)' and 'array(:)[1]' are not allocatable, it is believed that not only 'scalar' but also 'scalar[1]' is allocatable. However, coarrays are collectively established/allocated; thus, 'allocated(scalar[i])' is equivalent to 'allocated(scalar)'. [At least when assuming that 'i' does not refer to a failed image.] 2021-09-23 Harald Anlauf Tobias Burnus PR fortran/93834 gcc/fortran/ChangeLog: * trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle coindexed scalar coarrays. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/coarray_allocated.f90: New test. --- diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 42a995b..612ca41 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8887,50 +8887,63 @@ caf_this_image_ref (gfc_ref *ref) static void gfc_conv_allocated (gfc_se *se, gfc_expr *expr) { - gfc_actual_arglist *arg1; gfc_se arg1se; tree tmp; - symbol_attribute caf_attr; + bool coindexed_caf_comp = false; + gfc_expr *e = expr->value.function.actual->expr; gfc_init_se (&arg1se, NULL); - arg1 = expr->value.function.actual; - - if (arg1->expr->ts.type == BT_CLASS) + if (e->ts.type == BT_CLASS) { /* Make sure that class array expressions have both a _data component reference and an array reference.... */ - if (CLASS_DATA (arg1->expr)->attr.dimension) - gfc_add_class_array_ref (arg1->expr); + if (CLASS_DATA (e)->attr.dimension) + gfc_add_class_array_ref (e); /* .... whilst scalars only need the _data component. */ else - gfc_add_data_component (arg1->expr); + gfc_add_data_component (e); } - /* When arg1 references an allocatable component in a coarray, then call + /* When 'e' references an allocatable component in a coarray, then call the caf-library function caf_is_present (). */ - if (flag_coarray == GFC_FCOARRAY_LIB && arg1->expr->expr_type == EXPR_FUNCTION - && arg1->expr->value.function.isym - && arg1->expr->value.function.isym->id == GFC_ISYM_CAF_GET) - caf_attr = gfc_caf_attr (arg1->expr->value.function.actual->expr); - else - gfc_clear_attr (&caf_attr); - if (flag_coarray == GFC_FCOARRAY_LIB && caf_attr.codimension - && !caf_this_image_ref (arg1->expr->value.function.actual->expr->ref)) - tmp = trans_caf_is_present (se, arg1->expr->value.function.actual->expr); + if (flag_coarray == GFC_FCOARRAY_LIB && e->expr_type == EXPR_FUNCTION + && e->value.function.isym + && e->value.function.isym->id == GFC_ISYM_CAF_GET) + { + e = e->value.function.actual->expr; + if (gfc_expr_attr (e).codimension) + { + /* Last partref is the coindexed coarray. As coarrays are collectively + (de)allocated, the allocation status must be the same as the one of + the local allocation. Convert to local access. */ + for (gfc_ref *ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY && ref->u.ar.codimen) + { + for (int i = ref->u.ar.dimen; + i < ref->u.ar.dimen + ref->u.ar.codimen; ++i) + ref->u.ar.dimen_type[i] = DIMEN_THIS_IMAGE; + break; + } + } + else if (!caf_this_image_ref (e->ref)) + coindexed_caf_comp = true; + } + if (coindexed_caf_comp) + tmp = trans_caf_is_present (se, e); else { - if (arg1->expr->rank == 0) + if (e->rank == 0) { /* Allocatable scalar. */ arg1se.want_pointer = 1; - gfc_conv_expr (&arg1se, arg1->expr); + gfc_conv_expr (&arg1se, e); tmp = arg1se.expr; } else { /* Allocatable array. */ arg1se.descriptor_only = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr); + gfc_conv_expr_descriptor (&arg1se, e); tmp = gfc_conv_descriptor_data_get (arg1se.expr); } diff --git a/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 new file mode 100644 index 0000000..a423d1f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/coarray_allocated.f90 @@ -0,0 +1,55 @@ +! { dg-do run } +! { dg-additional-options "-fdump-tree-original" } +! PR fortran/93834 - ICE in trans_caf_is_present + +program p + type t + integer, allocatable :: x[:,:,:] + end type t + integer, allocatable :: a[:] + type(t) :: c + if (allocated (a)) stop 1 + if (allocated (c%x)) stop 2 + + ! The coindexed scalar (!) variable is regarded as allocatable but + ! we can check the value on any image of the team as they are + ! established collectively. As tested by the dump, we do it on + ! this_image (). + ! + ! For this reason, -fcoarray=single and -fcoarray=lib give the + ! same result + if (allocated (a[1])) stop 3 + if (allocated (c%x[1,2,3])) stop 4 + + ! Allocate collectively + allocate(a[*]) + allocate(c%x[4,10,*]) + + if (.not. allocated (a)) stop 5 + if (.not. allocated (c%x)) stop 6 + if (.not. allocated (a[1])) stop 7 + if (.not. allocated (c%x[1,2,3])) stop 8 + + ! Dellocate collectively + deallocate(a) + deallocate(c%x) + + if (allocated (a)) stop 9 + if (allocated (c%x)) stop 10 + if (allocated (a[1])) stop 11 + if (allocated (c%x[1,2,3])) stop 12 +end + +! twice == 0 for .not. allocated' (coindexed vs. not) +! four times != for allocated (before alloc after dealloc, coindexed and not) + +! There are also == 0 and != 0 for (de)allocate checks with -fcoarray=single but those +! aren't prefixed by '(integer(kind=4) *)' + +! { dg-final { scan-tree-dump-times "\\(integer\\(kind=4\\) \\*\\) a.data != 0B" 4 "original" } } +! { dg-final { scan-tree-dump-times "\\(integer\\(kind=4\\) \\*\\) c.x.data != 0B" 4 "original" } } +! { dg-final { scan-tree-dump-times "\\(integer\\(kind=4\\) \\*\\) a.data == 0B" 2 "original" } } +! { dg-final { scan-tree-dump-times "\\(integer\\(kind=4\\) \\*\\) c.x.data == 0B" 2 "original" } } + +! Expected: always local access and never a call to _gfortran_caf_get +! { dg-final { scan-tree-dump-not "caf_get" "original" } }