Remove KIND argument from INDEX so it does not mess up scalarization.

2019-12-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/91541
	* intrinsic.c (add_sym_4ind): New function.
	(add_functions): Use it for INDEX.
	(resolve_intrinsic): Also call f1m for INDEX.
	* intrinsic.h (gfc_resolve_index_func): Adjust prototype to
	take a gfc_arglist instead of individual arguments.
	* iresolve.c (gfc_resolve_index_func): Adjust arguments.
	Remove KIND argument if present, and make sure this is
	not done twice.
	* trans-decl.c: Include "intrinsic.h".
	(gfc_get_extern_function_decl): Special case for resolving INDEX.

2019-12-30  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/91541
	* gfortran.dg/index_3.f90: New test.

From-SVN: r279763

1 files changed, 21 insertions, 4 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 53338dd..2a44a0a 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1352,16 +1352,31 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 
 
 void
-gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
-			gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back,
-			gfc_expr *kind)
+gfc_resolve_index_func (gfc_expr *f, gfc_actual_arglist *a)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
+  gfc_expr *str, *back, *kind;
+  gfc_actual_arglist *a_sub_str, *a_back, *a_kind;
+
+  if (f->do_not_resolve_again)
+    return;
+
+  a_sub_str = a->next;
+  a_back = a_sub_str->next;
+  a_kind = a_back->next;
+
+  str = a->expr;
+  back = a_back->expr;
+  kind = a_kind->expr;
 
   f->ts.type = BT_INTEGER;
   if (kind)
-    f->ts.kind = mpz_get_si (kind->value.integer);
+    {
+      f->ts.kind = mpz_get_si ((kind)->value.integer);
+      a_back->next = NULL;
+      gfc_free_actual_arglist (a_kind);
+    }
   else
     f->ts.kind = gfc_default_integer_kind;
 
@@ -1376,6 +1391,8 @@ gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
 
   f->value.function.name
     = gfc_get_string ("__index_%d_i%d", str->ts.kind, f->ts.kind);
+
+  f->do_not_resolve_again = 1;
 }