[gcc(refs/users/marxin/heads/martin-hook-test-v4)] PR fortran/97272 - Wrong answer from MAXLOC with character argXZXX

[gcc(refs/users/marxin/heads/martin-hook-test-v4)] PR fortran/97272 - Wrong answer from MAXLOC with character argXZXX

[Martin Liska]

https://gcc.gnu.org/g:323a43e556749c93dd0e10e6db37b02c5a763eac

commit 323a43e556749c93dd0e10e6db37b02c5a763eac
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Sun Oct 4 20:24:29 2020 +0200

    PR fortran/97272 - Wrong answer from MAXLOC with character argXZXX
    
    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.

Diff:
---
 gcc/fortran/trans-intrinsic.c         | 19 +++++++++++++++++++
 gcc/testsuite/gfortran.dg/pr97272.f90 | 19 +++++++++++++++++++
 2 files changed, 38 insertions(+)

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