From 35d2c6b6e8a7448a84abbf967feeb78a29117014 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 4 Oct 2020 20:24:29 +0200 Subject: [PATCH] PR fortran/97272 - Wrong answer from MAXLOC with character arg The optional KIND argument to the MINLOC/MAXLOC intrinsic must not be passed to the library function, as the kind conversion of the result is treated explicitly elsewhere. gcc/fortran/ChangeLog: PR fortran/97272 * trans-intrinsic.c (strip_kind_from_actual): Helper function for removal of KIND argument. (gfc_conv_intrinsic_minmaxloc): Ignore KIND argument here, as it is treated elsewhere. gcc/testsuite/ChangeLog: PR fortran/97272 * gfortran.dg/pr97272.f90: New test. --- gcc/fortran/trans-intrinsic.c | 19 +++++++++++++++++++ gcc/testsuite/gfortran.dg/pr97272.f90 | 19 +++++++++++++++++++ 2 files changed, 38 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pr97272.f90 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3b3bd8629cd..8729bc12152 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5073,6 +5073,24 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr * expr) } +/* Remove unneeded kind= argument from actual argument list when the + result conversion is dealt with in a different place. */ + +static void +strip_kind_from_actual (gfc_actual_arglist * actual) +{ + for (gfc_actual_arglist *a = actual; a; a = a->next) + { + gfc_actual_arglist *b = a->next; + if (b && b->name && strcmp (b->name, "kind") == 0) + { + a->next = b->next; + b->next = NULL; + gfc_free_actual_arglist (b); + } + } +} + /* Emit code for minloc or maxloc intrinsic. There are many different cases we need to handle. For performance reasons we sometimes create two loops instead of one, where the second one is much simpler. @@ -5208,6 +5226,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) { gfc_actual_arglist *a, *b; a = actual; + strip_kind_from_actual (a); while (a->next) { b = a->next; diff --git a/gcc/testsuite/gfortran.dg/pr97272.f90 b/gcc/testsuite/gfortran.dg/pr97272.f90 new file mode 100644 index 00000000000..e81903860ea --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr97272.f90 @@ -0,0 +1,19 @@ +! { dg-do run } +! PR fortran/97272 - Wrong answer from MAXLOC with character arg + +program test + implicit none + integer :: i, j, k, l = 10 + character, allocatable :: a(:) + allocate (a(l)) + a(:) = 'a' + l = l - 1 + a(l) = 'b' + i = maxloc (a, dim=1) + j = maxloc (a, dim=1, kind=2) + k = maxloc (a, dim=1, kind=8, back=.true.) +! print *, 'i = ', i, 'a(i) = ', a(i) +! print *, 'j = ', j, 'a(j) = ', a(j) +! print *, 'k = ', k, 'a(k) = ', a(k) + if (i /= l .or. j /= l .or. k /= l) stop 1 +end -- 2.30.2