This is a straightforward patch, especially for the bug in the PR! The
additional fix ensures that expr%LEN always returns a scalar. Please
note the comment in resolve.c about bounds checking.
Regtests on trunk - OK for 9- and 10-branches?
Paul
2020-03-01 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/93581
* resolve.c (gfc_resolve_ref): Modify array refs to be elements
if the ref chain ends in INQUIRY_LEN.
* trans-array.c (gfc_get_dataptr_offset): Provide the offsets
for INQUIRY_RE and INQUIRY_IM.
2020-03-01 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/93581
* gfortran.dg/inquiry_type_ref_6.f90 : New test.
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 279842)
--- gcc/fortran/resolve.c (working copy)
*************** gfc_resolve_substring_charlen (gfc_expr
*** 5192,5199 ****
bool
gfc_resolve_ref (gfc_expr *expr)
{
! int current_part_dimension, n_components, seen_part_dimension;
! gfc_ref *ref, **prev;
bool equal_length;
for (ref = expr->ref; ref; ref = ref->next)
--- 5192,5199 ----
bool
gfc_resolve_ref (gfc_expr *expr)
{
! int current_part_dimension, n_components, seen_part_dimension, dim;
! gfc_ref *ref, **prev, *array_ref;
bool equal_length;
for (ref = expr->ref; ref; ref = ref->next)
*************** gfc_resolve_ref (gfc_expr *expr)
*** 5239,5250 ****
--- 5239,5252 ----
current_part_dimension = 0;
seen_part_dimension = 0;
n_components = 0;
+ array_ref = NULL;
for (ref = expr->ref; ref; ref = ref->next)
{
switch (ref->type)
{
case REF_ARRAY:
+ array_ref = ref;
switch (ref->u.ar.type)
{
case AR_FULL:
*************** gfc_resolve_ref (gfc_expr *expr)
*** 5260,5265 ****
--- 5262,5268 ----
break;
case AR_ELEMENT:
+ array_ref = NULL;
current_part_dimension = 0;
break;
*************** gfc_resolve_ref (gfc_expr *expr)
*** 5299,5305 ****
--- 5302,5334 ----
break;
case REF_SUBSTRING:
+ break;
+
case REF_INQUIRY:
+ /* Implement requirement in note 9.7 of F2018 that the result of the
+ LEN inquiry be a scalar. */
+ if (ref->u.i == INQUIRY_LEN && array_ref)
+ {
+ array_ref->u.ar.type = AR_ELEMENT;
+ expr->rank = 0;
+ /* INQUIRY_LEN is not evaluated from the the rest of the expr
+ but directly from the string length. This means that setting
+ the array indices to one does not matter but might trigger
+ a runtime bounds error. Suppress the check. */
+ expr->no_bounds_check = 1;
+ for (dim = 0; dim < array_ref->u.ar.dimen; dim++)
+ {
+ array_ref->u.ar.dimen_type[dim] = DIMEN_ELEMENT;
+ if (array_ref->u.ar.start[dim])
+ gfc_free_expr (array_ref->u.ar.start[dim]);
+ array_ref->u.ar.start[dim]
+ = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+ if (array_ref->u.ar.end[dim])
+ gfc_free_expr (array_ref->u.ar.end[dim]);
+ if (array_ref->u.ar.stride[dim])
+ gfc_free_expr (array_ref->u.ar.stride[dim]);
+ }
+ }
break;
}
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 279842)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_get_dataptr_offset (stmtblock_t *blo
*** 6947,6952 ****
--- 6947,6970 ----
tmp = gfc_build_array_ref (tmp, index, NULL);
break;
+ case REF_INQUIRY:
+ switch (ref->u.i)
+ {
+ case INQUIRY_RE:
+ tmp = fold_build1_loc (input_location, REALPART_EXPR,
+ TREE_TYPE (TREE_TYPE (tmp)), tmp);
+ break;
+
+ case INQUIRY_IM:
+ tmp = fold_build1_loc (input_location, IMAGPART_EXPR,
+ TREE_TYPE (TREE_TYPE (tmp)), tmp);
+ break;
+
+ default:
+ break;
+ }
+ break;
+
default:
gcc_unreachable ();
break;
Index: gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 (working copy)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do run }
+ ! { dg-options "-fcheck=all" }
+ !
+ ! Test the fix for PR93581 and the implementation of note 9.7 of F2018.
+ ! The latter requires that the result of the LEN inquiry be a scalar
+ ! even for array expressions.
+ !
+ ! Contributed by Gerhard Steinmetz <gs...@t-online.de>
+ !
+ program p
+ complex, target :: z(2) = [(1.0, 2.0),(3.0, 4.0)]
+ character(:), allocatable, target :: c(:)
+ real, pointer :: r(:)
+ character(:), pointer :: s(:)
+
+ r => z%re
+ if (any (r .ne. real (z))) stop 1
+ r => z%im
+ if (any (r .ne. imag (z))) stop 2
+
+ allocate (c, source = ['abc','def'])
+ s(-2:-1) => c(1:2)
+ if (s%len .ne. len (c)) stop 3 ! This is the reason for the -fcheck=all
+ end
