Hi Harald,
I spend yesterday about two hours with this. Now I am still
tired but understand more. I think the confusion between the
two of us is due to wording and in which directions the
thoughts then go:
Talking about coindexed, all of a[i], b[i]%c and c%d[i] are
coindexed and there are many constraints like "shall not be
a coindexed variable" – which then rejects all of those.
That's what I was thinking of.
I think your starting point is that while ('a' = allocatable)
a, b%a, c[5]%d(1)%a
are ALLOCATABLE, adding a subobject reference such as
a(:), b%a(:,:), c[5]%d(1)%a(:,:,:)
makes the variable no longer allocatable.
I think that's what you were thinking of.
We then both argued along those different lines – which caused
the confusion as we both thought we talked about the same.
While those cases are clear, the question is whether
a[i] or b%a[i]
is allocatable or not – assuming that 'a' is a scalar.
(For an array, '(:)' has to appear before the image-selector,
which in turn makes it nonallocatable.)
I tried to pinpoint the words for this in the standard – and
failed. I think I need a "how to read the Fortran standard" 101
and some long time actually reading it :-(
Malcolm has answered me – and he believes (but only offhand) that
a[i] and b%a[i]
_are_ allocatable. See (6) at
https://mailman.j3-fortran.org/pipermail/j3/2021-September/013322.html
This implies that
if ( allocated (a[i]) .and. allocated (b%a[i]) ) stop 1
is valid.
However, I do note that coarray allocatables have to be collectively
(de)allocated, therefore
allocated (a[i]) .and. allocated (b%a[i])
is equivalent to
allocated (a) .and. allocated (b%a)
at least assuming that no image has failed.
First: Does this answer all the questions you had and resolved the
confusion?
Secondly, do you agree about the last bits of the analysis?
Thirdly, what do you think of the attached patch?
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht
München, HRB 106955
Fortran: Handle allocated() with coindexed scalars [PR93834]
2021-09-07 Harald Anlauf <anl...@gmx.de>
Tobias Burnus <tob...@codesourcery.com>
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.]
PR fortran/93834
gcc/fortran/ChangeLog:
* trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle
coindexed scalar coarrays.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray_allocated.f90: New test.
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 46670baae55..6a7a86d245a 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8887,50 +8887,64 @@ 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_init_se (&arg1se, NULL);
- arg1 = expr->value.function.actual;
+ expr = expr->value.function.actual->expr;
- if (arg1->expr->ts.type == BT_CLASS)
+ gfc_init_se (&arg1se, NULL);
+ if (expr->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 (expr)->attr.dimension)
+ gfc_add_class_array_ref (expr);
/* .... whilst scalars only need the _data component. */
else
- gfc_add_data_component (arg1->expr);
+ gfc_add_data_component (expr);
}
- /* When arg1 references an allocatable component in a coarray, then call
+ /* When expr 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 && expr->expr_type == EXPR_FUNCTION
+ && expr->value.function.isym
+ && expr->value.function.isym->id == GFC_ISYM_CAF_GET)
+ {
+ expr = expr->value.function.actual->expr;
+ if (caf_this_image_ref (expr->ref))
+ coindexed_caf_comp = false; /* Local access. */
+ else if (gfc_expr_attr (expr).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 = expr->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;
+ }
+ }
+ }
+ if (coindexed_caf_comp)
+ tmp = trans_caf_is_present (se, expr);
else
{
- if (arg1->expr->rank == 0)
+ if (expr->rank == 0)
{
/* Allocatable scalar. */
arg1se.want_pointer = 1;
- gfc_conv_expr (&arg1se, arg1->expr);
+ gfc_conv_expr (&arg1se, expr);
tmp = arg1se.expr;
}
else
{
/* Allocatable array. */
arg1se.descriptor_only = 1;
- gfc_conv_expr_descriptor (&arg1se, arg1->expr);
+ gfc_conv_expr_descriptor (&arg1se, expr);
tmp = gfc_conv_descriptor_data_get (arg1se.expr);
}
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocated.f90 b/gcc/testsuite/gfortran.dg/coarray_allocated.f90
new file mode 100644
index 00000000000..dcd334b9e30
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocated.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -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
+
+ if (allocated (a[1])) stop 4
+ if (allocated (c%x[1,2,3])) stop 5
+end
+
+! { dg-final { scan-tree-dump-times "a.data != 0B" 2 "original" } }
+! { dg-final { scan-tree-dump-times "c.x.data != 0B" 2 "original" } }
+! { dg-final { scan-tree-dump-not "_gfortran_caf_get" "original" } }
