From 9de42a8e995451cb13dceb3970ae23ff88240bff Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 8 Mar 2020 18:52:35 +0000 Subject: [PATCH] Patch and ChangeLogs for PR93581 --- gcc/fortran/ChangeLog | 8 ++++++ gcc/fortran/resolve.c | 33 ++++++++++++++++++++++-- gcc/fortran/trans-array.c | 18 +++++++++++++ gcc/testsuite/ChangeLog | 7 ++++- gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 | 24 +++++++++++++++++ 5 files changed, 87 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 90e1cab..b3ff063 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2020-03-08 Paul Thomas + + 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-05 Steven G. Kargl PR fortran/93792 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 8f5267f..b5813a7 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5199,8 +5199,8 @@ gfc_resolve_substring_charlen (gfc_expr *e) bool gfc_resolve_ref (gfc_expr *expr) { - int current_part_dimension, n_components, seen_part_dimension; - gfc_ref *ref, **prev; + 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) @@ -5246,12 +5246,14 @@ gfc_resolve_ref (gfc_expr *expr) 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: @@ -5267,6 +5269,7 @@ gfc_resolve_ref (gfc_expr *expr) break; case AR_ELEMENT: + array_ref = NULL; current_part_dimension = 0; break; @@ -5306,7 +5309,33 @@ gfc_resolve_ref (gfc_expr *expr) 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; } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 65ba84c..a4b1cba 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6947,6 +6947,24 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a1a371b..722a473 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-03-08 Paul Thomas + + PR fortran/93581 + * gfortran.dg/inquiry_type_ref_6.f90 : New test. + 2020-03-08 Patrick Palka PR c++/93729 @@ -20,7 +25,7 @@ 2020-03-06 Wilco Dijkstra - * gcc.target/aarch64/fmla_intrinsic_1.c: Check for correct lane syntax. + * gcc.target/aarch64/fmla_intrinsic_1.c: Check for correct lane syntax. * gcc.target/aarch64/fmls_intrinsic_1.c: Likewise. * gcc.target/aarch64/mla_intrinsic_1.c: Likewise. * gcc.target/aarch64/mls_intrinsic_1.c: Likewise. diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 new file mode 100644 index 0000000..ffe09b0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 @@ -0,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 +! +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 +end -- 2.7.4