The mainline code to check whether an argument has to be included in
scalarization uses only the name of a dummy argument object to recognize a
specific argument of an intrinsic procedure. On the 11 branch, the dummy
argument object is not available and the code uses a mix of check for
argument name (for keyword arguments) and argument index (for non-keyword ones).
This makes backports non-straightforward in this area, as the argument indexes
depend on the intrinsics.
This change fixes a bogus backport for LEN_TRIM, whose KIND argument index
should be different from that of INDEX.
PR fortran/87711
PR fortran/97896
gcc/fortran/ChangeLog:
* trans-array.c (arg_evaluated_for_scalarization): Handle keyword and
non-keyword arguments separatedly. Adapt the expected argument index
for KIND to each intrinsic in the non-keyword case.
gcc/testsuite/ChangeLog:
* gfortran.dg/index_5.f90: Enrich test with usages of INDEX with
a non-keyword KIND argument.
* gfortran.dg/len_trim.f90: Same for LEN_TRIM.
(tests cherry picked from commit 15630e6e9eb019477d1fc5c0966b43979e18ae18)
---
gcc/fortran/trans-array.c | 41 +++++++++++++++++++-------
gcc/testsuite/gfortran.dg/index_5.f90 | 2 ++
gcc/testsuite/gfortran.dg/len_trim.f90 | 6 ++++
3 files changed, 39 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index db14daca459..e187a08f8f0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11220,18 +11220,39 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
{
if (function != NULL)
{
- switch (function->id)
+ if (actual_arg.name == NULL)
{
- case GFC_ISYM_INDEX:
- case GFC_ISYM_LEN_TRIM:
- if ((actual_arg.name == NULL && arg_num == 3)
- || (actual_arg.name != NULL
- && strcmp ("kind", actual_arg.name) == 0))
- return false;
- /* Fallthrough. */
+ switch (function->id)
+ {
+ case GFC_ISYM_INDEX:
+ if (arg_num == 3)
+ return false;
+ break;
- default:
- break;
+ case GFC_ISYM_LEN_TRIM:
+ if (arg_num == 1)
+ return false;
+
+ /* Fallthrough. */
+
+ default:
+ break;
+ }
+ }
+ else
+ {
+ switch (function->id)
+ {
+ case GFC_ISYM_INDEX:
+ case GFC_ISYM_LEN_TRIM:
+ if (strcmp ("kind", actual_arg.name) == 0)
+ return false;
+
+ /* Fallthrough. */
+
+ default:
+ break;
+ }
}
}
diff --git a/gcc/testsuite/gfortran.dg/index_5.f90 b/gcc/testsuite/gfortran.dg/index_5.f90
index e039455d175..4dc2ce4c0a1 100644
--- a/gcc/testsuite/gfortran.dg/index_5.f90
+++ b/gcc/testsuite/gfortran.dg/index_5.f90
@@ -19,5 +19,7 @@ program p
d = index ('xyxyz','yx', back=a, kind=8)
b = index ('xyxyz','yx', back=a, kind=8)
d = index ('xyxyz','yx', back=a, kind=4)
+ b = index ('xyxyz','yx', a, 4)
+ d = index ('xyxyz','yx', a, 8)
end
diff --git a/gcc/testsuite/gfortran.dg/len_trim.f90 b/gcc/testsuite/gfortran.dg/len_trim.f90
index 2252b81f084..77e3d30c669 100644
--- a/gcc/testsuite/gfortran.dg/len_trim.f90
+++ b/gcc/testsuite/gfortran.dg/len_trim.f90
@@ -17,11 +17,17 @@ program main
kk = len_trim (a)
mm = len_trim (a, kind=4)
nn = len_trim (a, kind=8)
+ mm = len_trim (a, 4)
+ nn = len_trim (a, 8)
kk = len_trim ([b])
mm = len_trim ([b],kind=4)
nn = len_trim ([b],kind=8)
+ mm = len_trim ([b], 4)
+ nn = len_trim ([b], 8)
kk = len_trim (c)
mm = len_trim (c, kind=4)
nn = len_trim (c, kind=8)
+ mm = len_trim (c, 4)
+ nn = len_trim (c, 8)
if (any (l4 /= 2_4) .or. any (l8 /= 2_8)) stop 1
end program main
