diff options
author | Harald Anlauf <anlauf@gmx.de> | 2021-11-23 17:51:38 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2021-11-23 17:51:38 +0100 |
commit | 721d8b9e26bf8205c1f2125c2626919a408cdbe4 (patch) | |
tree | 475dbb2f16e80450852f47254c88354701bb7ff6 | |
parent | 46d3cfd29dc701e1e0d18b0380d6299fce7944f2 (diff) | |
download | gcc-721d8b9e26bf8205c1f2125c2626919a408cdbe4.tar.gz |
Fortran: fix scalarization for intrinsic LEN_TRIM with present KIND argument
gcc/fortran/ChangeLog:
PR fortran/87711
PR fortran/87851
* trans-array.c (arg_evaluated_for_scalarization): Add LEN_TRIM to
list of intrinsics for which an optional KIND argument needs to be
removed before scalarization.
gcc/testsuite/ChangeLog:
PR fortran/87711
PR fortran/87851
* gfortran.dg/len_trim.f90: New test.
-rw-r--r-- | gcc/fortran/trans-array.c | 1 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/len_trim.f90 | 27 |
2 files changed, 28 insertions, 0 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2090adf01e7..238b1b72385 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -11499,6 +11499,7 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function, switch (function->id) { case GFC_ISYM_INDEX: + case GFC_ISYM_LEN_TRIM: if (strcmp ("kind", gfc_dummy_arg_get_name (*dummy_arg)) == 0) return false; /* Fallthrough. */ diff --git a/gcc/testsuite/gfortran.dg/len_trim.f90 b/gcc/testsuite/gfortran.dg/len_trim.f90 new file mode 100644 index 00000000000..2252b81f084 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/len_trim.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "-O -Wall -Wconversion-extra -fdump-tree-original" } +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } +! PR fortran/87711 - ICE in gfc_trans_transfer +! PR fortran/87851 - return type for len_trim + +program main + implicit none + character(3), parameter :: a(1) = 'aa' + character(3) :: b = "bb" + character(3) :: c(1) = 'cc' + integer(4), parameter :: l4(1) = len_trim (a, kind=4) + integer(8), parameter :: l8(1) = len_trim (a, kind=8) + integer :: kk(1) = len_trim (a) + integer(4) :: mm(1) = len_trim (a, kind=4) + integer(8) :: nn(1) = len_trim (a, kind=8) + kk = len_trim (a) + mm = len_trim (a, kind=4) + nn = len_trim (a, kind=8) + kk = len_trim ([b]) + mm = len_trim ([b],kind=4) + nn = len_trim ([b],kind=8) + kk = len_trim (c) + mm = len_trim (c, kind=4) + nn = len_trim (c, kind=8) + if (any (l4 /= 2_4) .or. any (l8 /= 2_8)) stop 1 +end program main |