OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Patch and ChangeLogs for PR93581

Browse Source
This commit is contained in:
Paul Thomas 2020-03-08 18:52:35 +00:00
parent 5e1b4e60c1
commit 9de42a8e99
5 changed files with 87 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2020-03-08 Paul Thomas <pault@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-05 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/93792

33
gcc/fortran/resolve.c
View File

@ -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;
}

18
gcc/fortran/trans-array.c
View File

@ -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;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2020-03-08 Paul Thomas <pault@gcc.gnu.org>
PR fortran/93581
* gfortran.dg/inquiry_type_ref_6.f90 : New test.
2020-03-08 Patrick Palka <ppalka@redhat.com>
PR c++/93729
@ -20,7 +25,7 @@
2020-03-06 Wilco Dijkstra <wdijkstr@arm.com>
* 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.

24
gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 Normal file
View File

@ -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 <gscfq@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
end