[PATCH 0/7] fortran: Ignore unused arguments for scalarisation [PR97896]

[PATCH 0/7] fortran: Ignore unused arguments for scalarisation [PR97896]

[Mikael Morin]

Hello,

I have had these patches fixing PR97896 almost ready for a while.  Now is time to actually submit them, at last.

The problematic case is intrinsic procedures where an argument is actually not used in the code generated (KIND argument of INDEX in the testcase), which confuses the scalariser.

Thomas König comitted a change to workaround the problem, but it regressed in PR97896.  These patch put the workaround where I think it is more appropriate, namely at the beginning of the scalarisation procedure.  This is the patch 7 of the series, preceded with the revert in patch 6.  I intend to commit both of them squashed together.

The rest of the series (patches 1-5) is preliminary work to be able to identify the KIND argument of the INDEX intrinsic by its name, rather than using the right number of next->next->next indirections starting with the first argument.  It is probably overkill for just this use case, but I think it’s worth having that facility in the long term.
These patches use some c++ features, namely class inheritance and virtual functions; I know this is frowned upon by some (fortran) maintainers; let’s see what they will say.

I intend to submit a separate patch for the release branch with only patch 6 and 7 and the next->next->next indirections.

Regression-tested on x86_64-linux-gnu.  Ok for master? 

Mikael Morin (7):
  fortran: new abstract class gfc_dummy_arg
  fortran: Tiny sort_actual internal refactoring
  fortran: Reverse actual vs dummy argument mapping
  fortran: simplify elemental arguments walking
  fortran: Delete redundant missing_arg_type field
  Revert "Remove KIND argument from INDEX so it does not mess up
    scalarization."
  fortran: Ignore unused args in scalarization [PR97896]

 gcc/fortran/gfortran.h                |  45 +++++---
 gcc/fortran/interface.c               |  14 +--
 gcc/fortran/intrinsic.c               | 152 +++++++++++++-------------
 gcc/fortran/intrinsic.h               |   3 +-
 gcc/fortran/iresolve.c                |  21 +---
 gcc/fortran/resolve.c                 |  10 +-
 gcc/fortran/symbol.c                  |  19 ++++
 gcc/fortran/trans-array.c             |  75 ++++++++++---
 gcc/fortran/trans-array.h             |   5 +-
 gcc/fortran/trans-decl.c              |  24 +---
 gcc/fortran/trans-expr.c              |   7 +-
 gcc/fortran/trans-intrinsic.c         |   3 +-
 gcc/fortran/trans-stmt.c              |  30 +++--
 gcc/fortran/trans.h                   |   4 +-
 gcc/testsuite/gfortran.dg/index_5.f90 |  23 ++++
 15 files changed, 252 insertions(+), 183 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90

-- 
2.30.2

[PATCH 1/7] fortran: new abstract class gfc_dummy_arg

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1089 bytes --]


Introduce a new abstract class gfc_dummy_arg that provides a common
interface to both dummy arguments of user-defined procedures (which
have type gfc_formal_arglist) and dummy arguments of intrinsic procedures
(which have type gfc_intrinsic_arg).

gcc/fortran/
	* gfortran.h (gfc_dummy_arg): New.
	(gfc_formal_arglist, gfc_intrinsic_arg): Inherit gfc_dummy_arg.
	(gfc_get_formal_arglist, gfc_get_intrinsic_arg): Call constructor.
	* intrinsic.c (gfc_intrinsic_init_1): Merge the memory area of
	conversion intrinsics with that of regular function and
	subroutine intrinsics.
	Use a separate memory area for arguments.
	(add_sym, gfc_intrinsic_init_1): Don’t do pointer arithmetics
	with next_arg.
	(add_sym, make_alias, add_conv,
	add_char_conversions, gfc_intrinsic_init_1): Call constructor
	before filling object data.
	* resolve.c (resolve_select_type): Same.
---
 gcc/fortran/gfortran.h  | 22 ++++++++++++++-------
 gcc/fortran/intrinsic.c | 44 ++++++++++++++++++++++-------------------
 gcc/fortran/resolve.c   | 10 ++++++----
 3 files changed, 45 insertions(+), 31 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-fortran-new-abstract-class-gfc_dummy_arg.patch --]
[-- Type: text/x-patch; name="0001-fortran-new-abstract-class-gfc_dummy_arg.patch", Size: 6343 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 921aed93dc3..031e46d1457 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1131,17 +1131,25 @@ gfc_component;
 
 #define gfc_get_component() XCNEW (gfc_component)
 
+
+/* dummy arg of either an intrinsic or a user-defined procedure.  */
+class gfc_dummy_arg
+{
+};
+
+
 /* Formal argument lists are lists of symbols.  */
-typedef struct gfc_formal_arglist
+struct gfc_formal_arglist : public gfc_dummy_arg
 {
   /* Symbol representing the argument at this position in the arglist.  */
   struct gfc_symbol *sym;
   /* Points to the next formal argument.  */
   struct gfc_formal_arglist *next;
-}
-gfc_formal_arglist;
+};
+
+#define GFC_NEW(T) new (XCNEW (T)) T
 
-#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
+#define gfc_get_formal_arglist() GFC_NEW (gfc_formal_arglist)
 
 
 /* The gfc_actual_arglist structure is for actual arguments and
@@ -2159,7 +2167,7 @@ gfc_ref;
 
 
 /* Structures representing intrinsic symbols and their arguments lists.  */
-typedef struct gfc_intrinsic_arg
+struct gfc_intrinsic_arg : public gfc_dummy_arg
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
 
@@ -2169,9 +2177,9 @@ typedef struct gfc_intrinsic_arg
   gfc_actual_arglist *actual;
 
   struct gfc_intrinsic_arg *next;
+};
 
-}
-gfc_intrinsic_arg;
+#define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg)
 
 
 /* Specifies the various kinds of check functions used to verify the
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 219f04f2317..ba79eb3242b 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -376,6 +376,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
       break;
 
     case SZ_NOTHING:
+      next_sym = new (next_sym) gfc_intrinsic_sym;
       next_sym->name = gfc_get_string ("%s", name);
 
       strcpy (buf, "_gfortran_");
@@ -406,6 +407,7 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
   va_start (argp, resolve);
 
   first_flag = 1;
+  gfc_intrinsic_arg * previous_arg;
 
   for (;;)
     {
@@ -422,12 +424,12 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
 	nargs++;
       else
 	{
-	  next_arg++;
+	  next_arg = new (next_arg) gfc_intrinsic_arg;
 
 	  if (first_flag)
 	    next_sym->formal = next_arg;
 	  else
-	    (next_arg - 1)->next = next_arg;
+	    previous_arg->next = next_arg;
 
 	  first_flag = 0;
 
@@ -437,6 +439,9 @@ add_sym (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt type
 	  next_arg->optional = optional;
 	  next_arg->value = 0;
 	  next_arg->intent = intent;
+
+	  previous_arg = next_arg;
+	  next_arg++;
 	}
     }
 
@@ -1270,6 +1275,7 @@ make_alias (const char *name, int standard)
       break;
 
     case SZ_NOTHING:
+      next_sym = new (next_sym) gfc_intrinsic_sym;
       next_sym[0] = next_sym[-1];
       next_sym->name = gfc_get_string ("%s", name);
       next_sym->standard = standard;
@@ -3991,7 +3997,7 @@ add_conv (bt from_type, int from_kind, bt to_type, int to_kind, int standard)
   to.type = to_type;
   to.kind = to_kind;
 
-  sym = conversion + nconv;
+  sym = new (conversion + nconv) gfc_intrinsic_sym;
 
   sym->name = conv_name (&from, &to);
   sym->lib_name = sym->name;
@@ -4167,15 +4173,17 @@ add_char_conversions (void)
 	to.type = BT_CHARACTER;
 	to.kind = gfc_character_kinds[j].kind;
 
-	char_conversions[n].name = conv_name (&from, &to);
-	char_conversions[n].lib_name = char_conversions[n].name;
-	char_conversions[n].simplify.cc = gfc_convert_char_constant;
-	char_conversions[n].standard = GFC_STD_F2003;
-	char_conversions[n].elemental = 1;
-	char_conversions[n].pure = 1;
-	char_conversions[n].conversion = 0;
-	char_conversions[n].ts = to;
-	char_conversions[n].id = GFC_ISYM_CONVERSION;
+	gfc_intrinsic_sym *current_conv;
+	current_conv = new (&char_conversions[n]) gfc_intrinsic_sym;
+	current_conv->name = conv_name (&from, &to);
+	current_conv->lib_name = char_conversions[n].name;
+	current_conv->simplify.cc = gfc_convert_char_constant;
+	current_conv->standard = GFC_STD_F2003;
+	current_conv->elemental = 1;
+	current_conv->pure = 1;
+	current_conv->conversion = 0;
+	current_conv->ts = to;
+	current_conv->id = GFC_ISYM_CONVERSION;
 
 	n++;
       }
@@ -4198,16 +4206,13 @@ gfc_intrinsic_init_1 (void)
   sizing = SZ_CONVS;
   add_conversions ();
 
-  functions = XCNEWVAR (struct gfc_intrinsic_sym,
-			sizeof (gfc_intrinsic_sym) * (nfunc + nsub)
-			+ sizeof (gfc_intrinsic_arg) * nargs);
+  next_sym = XCNEWVEC (struct gfc_intrinsic_sym, nfunc + nsub + nconv);
 
-  next_sym = functions;
+  functions = next_sym;
   subroutines = functions + nfunc;
+  conversion = subroutines + nsub;
 
-  conversion = XCNEWVEC (gfc_intrinsic_sym, nconv);
-
-  next_arg = ((gfc_intrinsic_arg *) (subroutines + nsub)) - 1;
+  next_arg = XCNEWVEC (gfc_intrinsic_arg, nargs);
 
   sizing = SZ_NOTHING;
   nconv = 0;
@@ -4225,7 +4230,6 @@ void
 gfc_intrinsic_done_1 (void)
 {
   free (functions);
-  free (conversion);
   free (char_conversions);
   gfc_free_namespace (gfc_intrinsic_namespace);
 }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad387ac..8f13582e4b4 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9676,10 +9676,12 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	  new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
 	  new_st->expr1->value.function.actual->next->expr->where = code->loc;
 	  /* Set up types in formal arg list.  */
-	  new_st->expr1->value.function.isym->formal = XCNEW (gfc_intrinsic_arg);
-	  new_st->expr1->value.function.isym->formal->ts = new_st->expr1->value.function.actual->expr->ts;
-	  new_st->expr1->value.function.isym->formal->next = XCNEW (gfc_intrinsic_arg);
-	  new_st->expr1->value.function.isym->formal->next->ts = new_st->expr1->value.function.actual->next->expr->ts;
+	  gfc_intrinsic_sym *e1_isym = new_st->expr1->value.function.isym;
+	  gfc_actual_arglist *e1_actual = new_st->expr1->value.function.actual;
+	  e1_isym->formal = gfc_get_intrinsic_arg ();
+	  e1_isym->formal->ts = e1_actual->expr->ts;
+	  e1_isym->formal->next = gfc_get_intrinsic_arg ();
+	  e1_isym->formal->next->ts = e1_actual->next->expr->ts;
 
 	  new_st->next = body->next;
 	}

[PATCH 2/7] fortran: Tiny sort_actual internal refactoring

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 260 bytes --]


Preliminary refactoring to make further changes more obvious.
No functional change.

gcc/fortran/
	* intrinsic.c (sort_actual): initialise variable and use it earlier.
---
 gcc/fortran/intrinsic.c | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-fortran-Tiny-sort_actual-internal-refactoring.patch --]
[-- Type: text/x-patch; name="0002-fortran-Tiny-sort_actual-internal-refactoring.patch", Size: 666 bytes --]

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ba79eb3242b..2b7b72f03e2 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4415,19 +4415,18 @@ do_sort:
 
   for (f = formal; f; f = f->next)
     {
-      if (f->actual && f->actual->label != NULL && f->ts.type)
+      a = f->actual;
+      if (a && a->label != NULL && f->ts.type)
 	{
 	  gfc_error ("ALTERNATE RETURN not permitted at %L", where);
 	  return false;
 	}
 
-      if (f->actual == NULL)
+      if (a == NULL)
 	{
 	  a = gfc_get_actual_arglist ();
 	  a->missing_arg_type = f->ts.type;
 	}
-      else
-	a = f->actual;
 
       if (actual == NULL)
 	*ap = a;

[PATCH 3/7] fortran: Reverse actual vs dummy argument mapping

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1467 bytes --]


There was originally no way from an actual argument to get
to the corresponding dummy argument, even if the job of sorting
and matching actual with dummy arguments was done.
The closest was a field named actual in gfc_intrinsic_arg that was
used as scratch data when sorting arguments of one specific call.
However that value was overwritten later on as arguments of another
call to the same procedure were sorted and matched.

This change removes that field and adds instead a new field
associated_dummy in gfc_actual_arglist.  This field uses the just
introduced gfc_dummy_arg interface, which makes it usable with
both external and intrinsic procedure dummy arguments.

As the removed field was used in the code sorting and matching arguments,
that code has to be updated.  Two local vectors with matching indices
are introduced for respectively dummy and actual arguments, and the
loops are modified to use indices and update those argument vectors.

gcc/fortran/
	* gfortran.h (gfc_actual_arglist): New field associated_dummy.
	(gfc_intrinsic_arg): Remove field actual.
	* interface.c (gfc_compare_actual): Initialize associated_dummy.
	* intrinsic.c (sort_actual):  Add argument vectors.
	Use loops with indices on argument vectors.
	Initialize associated_dummy.
---
 gcc/fortran/gfortran.h  |  6 +++++-
 gcc/fortran/interface.c |  9 +++++++--
 gcc/fortran/intrinsic.c | 31 ++++++++++++++++++++-----------
 3 files changed, 32 insertions(+), 14 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-fortran-Reverse-actual-vs-dummy-argument-mapping.patch --]
[-- Type: text/x-patch; name="0003-fortran-Reverse-actual-vs-dummy-argument-mapping.patch", Size: 4225 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 031e46d1457..78b43a31a9a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1168,6 +1168,11 @@ typedef struct gfc_actual_arglist
   gfc_param_spec_type spec_type;
 
   struct gfc_expr *expr;
+
+  /*  The dummy arg this actual arg is associated with, if the interface
+      is explicit.  NULL otherwise.  */
+  gfc_dummy_arg *associated_dummy;
+
   struct gfc_actual_arglist *next;
 }
 gfc_actual_arglist;
@@ -2174,7 +2179,6 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg
   gfc_typespec ts;
   unsigned optional:1, value:1;
   ENUM_BITFIELD (sym_intent) intent:2;
-  gfc_actual_arglist *actual;
 
   struct gfc_intrinsic_arg *next;
 };
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa9da9..b763f87e8bd 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3131,6 +3131,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 			   "call at %L", where);
 	  return false;
 	}
+      else
+	a->associated_dummy = f;
 
       if (a->expr == NULL)
 	{
@@ -3546,9 +3548,12 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
   /* The argument lists are compatible.  We now relink a new actual
      argument list with null arguments in the right places.  The head
      of the list remains the head.  */
-  for (i = 0; i < n; i++)
+  for (f = formal, i = 0; f; f = f->next, i++)
     if (new_arg[i] == NULL)
-      new_arg[i] = gfc_get_actual_arglist ();
+      {
+	new_arg[i] = gfc_get_actual_arglist ();
+	new_arg[i]->associated_dummy = f;
+      }
 
   if (na != 0)
     {
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 2b7b72f03e2..ef5da389434 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4290,8 +4290,14 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
   remove_nullargs (ap);
   actual = *ap;
 
+  auto_vec<gfc_intrinsic_arg *> dummy_args;
+  auto_vec<gfc_actual_arglist *> ordered_actual_args;
+
   for (f = formal; f; f = f->next)
-    f->actual = NULL;
+    dummy_args.safe_push (f);
+
+  ordered_actual_args.safe_grow_cleared (dummy_args.length (),
+					 /* exact = */true);
 
   f = formal;
   a = actual;
@@ -4343,7 +4349,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
 	}
     }
 
-  for (;;)
+  for (int i = 0;; i++)
     {		/* Put the nonkeyword arguments in a 1:1 correspondence */
       if (f == NULL)
 	break;
@@ -4353,7 +4359,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap,
       if (a->name != NULL)
 	goto keywords;
 
-      f->actual = a;
+      ordered_actual_args[i] = a;
 
       f = f->next;
       a = a->next;
@@ -4371,7 +4377,8 @@ keywords:
      to be keyword arguments.  */
   for (; a; a = a->next)
     {
-      for (f = formal; f; f = f->next)
+      int idx;
+      FOR_EACH_VEC_ELT (dummy_args, idx, f)
 	if (strcmp (a->name, f->name) == 0)
 	  break;
 
@@ -4386,21 +4393,21 @@ keywords:
 	  return false;
 	}
 
-      if (f->actual != NULL)
+      if (ordered_actual_args[idx] != NULL)
 	{
 	  gfc_error ("Argument %qs appears twice in call to %qs at %L",
 		     f->name, name, where);
 	  return false;
 	}
-
-      f->actual = a;
+      ordered_actual_args[idx] = a;
     }
 
 optional:
   /* At this point, all unmatched formal args must be optional.  */
-  for (f = formal; f; f = f->next)
+  int idx;
+  FOR_EACH_VEC_ELT (dummy_args, idx, f)
     {
-      if (f->actual == NULL && f->optional == 0)
+      if (ordered_actual_args[idx] == NULL && f->optional == 0)
 	{
 	  gfc_error ("Missing actual argument %qs in call to %qs at %L",
 		     f->name, name, where);
@@ -4413,9 +4420,9 @@ do_sort:
      together in a way that corresponds with the formal list.  */
   actual = NULL;
 
-  for (f = formal; f; f = f->next)
+  FOR_EACH_VEC_ELT (dummy_args, idx, f)
     {
-      a = f->actual;
+      a = ordered_actual_args[idx];
       if (a && a->label != NULL && f->ts.type)
 	{
 	  gfc_error ("ALTERNATE RETURN not permitted at %L", where);
@@ -4428,6 +4435,8 @@ do_sort:
 	  a->missing_arg_type = f->ts.type;
 	}
 
+      a->associated_dummy = f;
+
       if (actual == NULL)
 	*ap = a;
       else

[PATCH 4/7] fortran: simplify elemental arguments walking

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1881 bytes --]


This adds two methods to the abstract gfc_dummy_arg and makes
usage of them to simplify a bit the walking of elemental procedure
arguments for scalarization.  As information about dummy arguments
can be obtained from the actual argument through the just-introduced
associated_dummy field, there is no need to carry around the procedure
interface and walk dummy arguments manually together with actual arguments.

gcc/fortran/
	* gfortran.h (gfc_dummy_arg::get_typespec,
	gfc_dummy_arg::is_optional): Declare new methods.
	(gfc_formal_arglist::get_typespec,
	gfc_formal_arglist::is_optional): Same.
	(gfc_intrinsic_arg::get_typespec,
	gfc_intrinsic_arg::is_optional): Same.
	* symbol.c (gfc_formal_arglist::get_typespec,
	gfc_formal_arglist::is_optional): Implement new methods.
	* intrinsic.c (gfc_intrinsic_arg::get_typespec,
	gfc_intrinsic_arg::is_optional): Same.
	* trans.h (gfc_ss_info::dummy_arg): Use the more general
	interface as declaration type.
	* trans-array.c (gfc_scalar_elemental_arg_saved_as_reference):
	use get_typespec_method to get the type.
	(gfc_walk_elemental_function_args): Remove proc_ifc argument.
	Get info about the dummy arg using the associated_dummy field.
	* trans-array.h (gfc_walk_elemental_function_args): Update declaration.
	* trans-intrinsic.c (gfc_walk_intrinsic_function):
	Update call to gfc_walk_elemental_function_args.
	* trans-stmt.c (gfc_trans_call): Ditto.
	(get_proc_ifc_for_call): Remove.
---
 gcc/fortran/gfortran.h        |  9 +++++++++
 gcc/fortran/intrinsic.c       | 13 +++++++++++++
 gcc/fortran/symbol.c          | 13 +++++++++++++
 gcc/fortran/trans-array.c     | 22 ++++++----------------
 gcc/fortran/trans-array.h     |  2 +-
 gcc/fortran/trans-intrinsic.c |  2 +-
 gcc/fortran/trans-stmt.c      | 22 ----------------------
 gcc/fortran/trans.h           |  4 ++--
 8 files changed, 45 insertions(+), 42 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0004-fortran-simplify-elemental-arguments-walking.patch --]
[-- Type: text/x-patch; name="0004-fortran-simplify-elemental-arguments-walking.patch", Size: 7606 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 78b43a31a9a..edad3d9e98c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1135,6 +1135,9 @@ gfc_component;
 /* dummy arg of either an intrinsic or a user-defined procedure.  */
 class gfc_dummy_arg
 {
+public:
+  virtual const gfc_typespec & get_typespec () const = 0;
+  virtual bool is_optional () const = 0;
 };
 
 
@@ -1145,6 +1148,9 @@ struct gfc_formal_arglist : public gfc_dummy_arg
   struct gfc_symbol *sym;
   /* Points to the next formal argument.  */
   struct gfc_formal_arglist *next;
+
+  virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
+  virtual bool is_optional () const FINAL OVERRIDE;
 };
 
 #define GFC_NEW(T) new (XCNEW (T)) T
@@ -2181,6 +2187,9 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg
   ENUM_BITFIELD (sym_intent) intent:2;
 
   struct gfc_intrinsic_arg *next;
+
+  virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
+  virtual bool is_optional () const FINAL OVERRIDE;
 };
 
 #define gfc_get_intrinsic_arg() GFC_NEW (gfc_intrinsic_arg)
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ef5da389434..007cac053cb 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -5507,3 +5507,16 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
 		 " only be called via an explicit interface or if declared"
 		 " EXTERNAL.", sym->name, &sym->declared_at);
 }
+
+
+const gfc_typespec &
+gfc_intrinsic_arg::get_typespec () const
+{
+  return ts;
+}
+
+bool
+gfc_intrinsic_arg::is_optional () const
+{
+  return optional;
+}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6d61bf4982b..59f0d0385a0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -5259,3 +5259,16 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
 
   return dummies;
 }
+
+
+const gfc_typespec &
+gfc_formal_arglist::get_typespec () const
+{
+  return sym->ts;
+}
+
+bool
+gfc_formal_arglist::is_optional () const
+{
+  return sym->attr.optional;
+}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013defdbb..7d85abb181f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2879,7 +2879,7 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
   /* If the expression is of polymorphic type, it's actual size is not known,
      so we avoid copying it anywhere.  */
   if (ss_info->data.scalar.dummy_arg
-      && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS
+      && ss_info->data.scalar.dummy_arg->get_typespec ().type == BT_CLASS
       && ss_info->expr->ts.type == BT_CLASS)
     return true;
 
@@ -11207,9 +11207,8 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref)
 
 gfc_ss *
 gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
-				  gfc_symbol *proc_ifc, gfc_ss_type type)
+				  gfc_ss_type type)
 {
-  gfc_formal_arglist *dummy_arg;
   int scalar;
   gfc_ss *head;
   gfc_ss *tail;
@@ -11218,16 +11217,12 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
   head = gfc_ss_terminator;
   tail = NULL;
 
-  if (proc_ifc)
-    dummy_arg = gfc_sym_get_dummy_args (proc_ifc);
-  else
-    dummy_arg = NULL;
-
   scalar = 1;
   for (; arg; arg = arg->next)
     {
+      gfc_dummy_arg * const dummy_arg = arg->associated_dummy;
       if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
-	goto loop_continue;
+	continue;
 
       newss = gfc_walk_subexpr (head, arg->expr);
       if (newss == head)
@@ -11237,13 +11232,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
 	  newss = gfc_get_scalar_ss (head, arg->expr);
 	  newss->info->type = type;
 	  if (dummy_arg)
-	    newss->info->data.scalar.dummy_arg = dummy_arg->sym;
+	    newss->info->data.scalar.dummy_arg = dummy_arg;
 	}
       else
 	scalar = 0;
 
       if (dummy_arg != NULL
-	  && dummy_arg->sym->attr.optional
+	  && dummy_arg->is_optional ()
 	  && arg->expr->expr_type == EXPR_VARIABLE
 	  && (gfc_expr_attr (arg->expr).optional
 	      || gfc_expr_attr (arg->expr).allocatable
@@ -11257,10 +11252,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
           while (tail->next != gfc_ss_terminator)
             tail = tail->next;
         }
-
-loop_continue:
-      if (dummy_arg != NULL)
-	dummy_arg = dummy_arg->next;
     }
 
   if (scalar)
@@ -11319,7 +11310,6 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
 
       ss = gfc_walk_elemental_function_args (old_ss,
 					     expr->value.function.actual,
-					     gfc_get_proc_ifc_for_expr (expr),
 					     GFC_SS_REFERENCE);
       if (ss != old_ss
 	  && (comp
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4d443d7118..998fd284dd6 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -82,7 +82,7 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
 gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref);
 /* Walk the arguments of an elemental function.  */
 gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
-					  gfc_symbol *, gfc_ss_type);
+					  gfc_ss_type);
 /* Walk an intrinsic function.  */
 gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
 				     gfc_intrinsic_sym *);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 46670baae55..8a9283b358d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11163,7 +11163,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
 
   if (isym->elemental)
     return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
-					     NULL, GFC_SS_SCALAR);
+					     GFC_SS_SCALAR);
 
   if (expr->rank == 0)
     return ss;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7cbdef7a304..3fd4475f411 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -356,27 +356,6 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 }
 
 
-/* Get the interface symbol for the procedure corresponding to the given call.
-   We can't get the procedure symbol directly as we have to handle the case
-   of (deferred) type-bound procedures.  */
-
-static gfc_symbol *
-get_proc_ifc_for_call (gfc_code *c)
-{
-  gfc_symbol *sym;
-
-  gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL);
-
-  sym = gfc_get_proc_ifc_for_expr (c->expr1);
-
-  /* Fall back/last resort try.  */
-  if (sym == NULL)
-    sym = c->resolved_sym;
-
-  return sym;
-}
-
-
 /* Translate the CALL statement.  Builds a call to an F95 subroutine.  */
 
 tree
@@ -402,7 +381,6 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
   ss = gfc_ss_terminator;
   if (code->resolved_sym->attr.elemental)
     ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
-					   get_proc_ifc_for_call (code),
 					   GFC_SS_REFERENCE);
 
   /* MVBITS is inlined but needs the dependency checking found here.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 78578cfd732..a17a1ec2312 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -266,8 +266,8 @@ typedef struct gfc_ss_info
     struct
     {
       /* If the scalar is passed as actual argument to an (elemental) procedure,
-	 this is the symbol of the corresponding dummy argument.  */
-      gfc_symbol *dummy_arg;
+	 this is the corresponding dummy argument.  */
+      gfc_dummy_arg *dummy_arg;
       tree value;
       /* Tells that the scalar is a reference to a variable that might
 	 be present on the lhs, so that we should evaluate the value

[PATCH 5/7] fortran: Delete redundant missing_arg_type field

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 700 bytes --]


Now that we can get information about an actual arg's associated
dummy using the associated_dummy attribute, the field missing_arg_type
contains redundant information.
This removes it.

gcc/fortran/
	* gfortran.h (gfc_actual_arglist::missing_arg_type): Remove.
	* interface.c (gfc_compare_actual_formal): Remove
	missing_arg_type initialization.
	* intrinsic.c (sort_actual): Ditto.
	* trans-expr.c (gfc_conv_procedure_call): Use associated_dummy
	and get_typespec to get the dummy argument type.
---
 gcc/fortran/gfortran.h   | 5 -----
 gcc/fortran/interface.c  | 5 -----
 gcc/fortran/intrinsic.c  | 5 +----
 gcc/fortran/trans-expr.c | 7 +++++--
 4 files changed, 6 insertions(+), 16 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0005-fortran-Delete-redundant-missing_arg_type-field.patch --]
[-- Type: text/x-patch; name="0005-fortran-Delete-redundant-missing_arg_type-field.patch", Size: 2553 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index edad3d9e98c..627a3480ef1 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1166,11 +1166,6 @@ typedef struct gfc_actual_arglist
   /* Alternate return label when the expr member is null.  */
   struct gfc_st_label *label;
 
-  /* This is set to the type of an eventual omitted optional
-     argument. This is used to determine if a hidden string length
-     argument has to be added to a function call.  */
-  bt missing_arg_type;
-
   gfc_param_spec_type spec_type;
 
   struct gfc_expr *expr;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b763f87e8bd..c51ec4c124e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3569,11 +3569,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
   if (*ap == NULL && n > 0)
     *ap = new_arg[0];
 
-  /* Note the types of omitted optional arguments.  */
-  for (a = *ap, f = formal; a; a = a->next, f = f->next)
-    if (a->expr == NULL && a->label == NULL)
-      a->missing_arg_type = f->sym->ts.type;
-
   return true;
 }
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 007cac053cb..8d5546ce19f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4430,10 +4430,7 @@ do_sort:
 	}
 
       if (a == NULL)
-	{
-	  a = gfc_get_actual_arglist ();
-	  a->missing_arg_type = f->ts.type;
-	}
+	a = gfc_get_actual_arglist ();
 
       a->associated_dummy = f;
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b18a9ec9799..4806ebac56e 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5831,7 +5831,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		{
 		  /* Pass a NULL pointer for an absent arg.  */
 		  parmse.expr = null_pointer_node;
-		  if (arg->missing_arg_type == BT_CHARACTER)
+		  if (arg->associated_dummy
+		      && arg->associated_dummy->get_typespec ().type
+			 == BT_CHARACTER)
 		    parmse.string_length = build_int_cst (gfc_charlen_type_node,
 							  0);
 		}
@@ -5848,7 +5850,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			  || !CLASS_DATA (fsym)->attr.allocatable));
 	  gfc_init_se (&parmse, NULL);
 	  parmse.expr = null_pointer_node;
-	  if (arg->missing_arg_type == BT_CHARACTER)
+	  if (arg->associated_dummy
+	      && arg->associated_dummy->get_typespec ().type == BT_CHARACTER)
 	    parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
 	}
       else if (fsym && fsym->ts.type == BT_CLASS

[PATCH 6/7] Revert "Remove KIND argument from INDEX so it does not mess up scalarization."

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 818 bytes --]


This reverts commit d09847357b965a2c2cda063827ce362d4c9c86f2 except for
its testcase.

gcc/fortran/
	* intrinsic.c (add_sym_4ind): Remove.
	(add_functions): Use add_sym4 instead of add_sym4ind.
	Don’t special case the index intrinsic.
	* iresolve.c (gfc_resolve_index_func): Use the individual arguments
	directly instead of the full argument list.
	* intrinsic.h (gfc_resolve_index_func): Update the declaration
	accordingly.
	* trans-decl.c (gfc_get_extern_function_decl): Don’t modify the
	list of arguments in the case of the index intrinsic.
---
 gcc/fortran/intrinsic.c  | 48 ++++++----------------------------------
 gcc/fortran/intrinsic.h  |  3 ++-
 gcc/fortran/iresolve.c   | 21 ++++--------------
 gcc/fortran/trans-decl.c | 24 +-------------------
 4 files changed, 14 insertions(+), 82 deletions(-)


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0006-Revert-Remove-KIND-argument-from-INDEX-so-it-does-no.patch --]
[-- Type: text/x-patch; name="0006-Revert-Remove-KIND-argument-from-INDEX-so-it-does-no.patch", Size: 6289 bytes --]

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 8d5546ce19f..b3e907ba3b8 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -893,39 +893,6 @@ add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty
 	   (void *) 0);
 }
 
-/* Add a symbol to the function list where the function takes 4
-   arguments and resolution may need to change the number or
-   arrangement of arguments. This is the case for INDEX, which needs
-   its KIND argument removed.  */
-
-static void
-add_sym_4ind (const char *name, gfc_isym_id id, enum klass cl, int actual_ok,
-	      bt type, int kind, int standard,
-	      bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *),
-	      gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *,
-				     gfc_expr *),
-	      void (*resolve) (gfc_expr *, gfc_actual_arglist *),
-	      const char *a1, bt type1, int kind1, int optional1,
-	      const char *a2, bt type2, int kind2, int optional2,
-	      const char *a3, bt type3, int kind3, int optional3,
-	      const char *a4, bt type4, int kind4, int optional4 )
-{
-  gfc_check_f cf;
-  gfc_simplify_f sf;
-  gfc_resolve_f rf;
-
-  cf.f4 = check;
-  sf.f4 = simplify;
-  rf.f1m = resolve;
-
-  add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf,
-	   a1, type1, kind1, optional1, INTENT_IN,
-	   a2, type2, kind2, optional2, INTENT_IN,
-	   a3, type3, kind3, optional3, INTENT_IN,
-	   a4, type4, kind4, optional4, INTENT_IN,
-	   (void *) 0);
-}
-
 
 /* Add a symbol to the subroutine list where the subroutine takes
    4 arguments.  */
@@ -2229,11 +2196,11 @@ add_functions (void)
 
   /* The resolution function for INDEX is called gfc_resolve_index_func
      because the name gfc_resolve_index is already used in resolve.c.  */
-  add_sym_4ind ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
-		BT_INTEGER, di, GFC_STD_F77,
-		gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
-		stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
-		bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
+  add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES,
+	     BT_INTEGER, di, GFC_STD_F77,
+	     gfc_check_index, gfc_simplify_index, gfc_resolve_index_func,
+	     stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED,
+	     bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL);
 
   make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77);
 
@@ -4539,10 +4506,9 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e)
 
   arg = e->value.function.actual;
 
-  /* Special case hacks for MIN, MAX and INDEX.  */
+  /* Special case hacks for MIN and MAX.  */
   if (specific->resolve.f1m == gfc_resolve_max
-      || specific->resolve.f1m == gfc_resolve_min
-      || specific->resolve.f1m == gfc_resolve_index_func)
+      || specific->resolve.f1m == gfc_resolve_min)
     {
       (*specific->resolve.f1m) (e, arg);
       return;
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 2148f89e194..b195e0b271a 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -521,7 +521,8 @@ void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *);
-void gfc_resolve_index_func (gfc_expr *, gfc_actual_arglist *);
+void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *,
+			     gfc_expr *);
 void gfc_resolve_ierrno (gfc_expr *);
 void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *);
 void gfc_resolve_ichar (gfc_expr *, gfc_expr *, gfc_expr *);
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index e17fe45f080..598c0409b66 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1276,27 +1276,16 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 
 
 void
-gfc_resolve_index_func (gfc_expr *f, gfc_actual_arglist *a)
+gfc_resolve_index_func (gfc_expr *f, gfc_expr *str,
+			gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back,
+			gfc_expr *kind)
 {
   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);
   else
     f->ts.kind = gfc_default_integer_kind;
 
@@ -1311,8 +1300,6 @@ gfc_resolve_index_func (gfc_expr *f, gfc_actual_arglist *a)
 
   f->value.function.name
     = gfc_get_string ("__index_%d_i%d", str->ts.kind, f->ts.kind);
-
-  f->do_not_resolve_again = 1;
 }
 
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bf8783a35f8..235084ad4a6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -42,7 +42,6 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-types.h"
 #include "trans-array.h"
 #include "trans-const.h"
-#include "intrinsic.h" 		/* For gfc_resolve_index_func.  */
 /* Only for gfc_trans_code.  Shouldn't need to include this.  */
 #include "trans-stmt.h"
 #include "gomp-constants.h"
@@ -2258,28 +2257,7 @@ module_sym:
 		{
 		  /* All specific intrinsics take less than 5 arguments.  */
 		  gcc_assert (isym->formal->next->next->next->next == NULL);
-		  if (isym->resolve.f1m == gfc_resolve_index_func)
-		    {
-		      /* gfc_resolve_index_func is special because it takes a
-			 gfc_actual_arglist instead of individual arguments.  */
-		      gfc_actual_arglist *a, *n;
-		      int i;
-		      a = gfc_get_actual_arglist();
-		      n = a;
-
-		      for (i = 0; i < 4; i++)
-			{
-			  n->next = gfc_get_actual_arglist();
-			  n = n->next;
-			}
-
-		      a->expr = &argexpr;
-		      isym->resolve.f1m (&e, a);
-		      a->expr = NULL;
-		      gfc_free_actual_arglist (a);
-		    }
-		  else
-		    isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL);
+		  isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL);
 		}
 	    }
 	}

[PATCH 7/7] fortran: Ignore unused args in scalarization [PR97896]

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1873 bytes --]


The KIND argument of the INDEX intrinsic is a compile time constant
that is used at compile time only to resolve to a kind-specific library
method.  It is otherwise completely ignored at runtime, and there is
no code generated for it as the library procedure has no kind argument.
This confuses the scalarizer which expects to see every argument
of elemental functions to be used when calling a procedure.
This change removes the argument from the scalarization lists
at the beginning of the scalarization process, so that the argument
is completely ignored.

gcc/fortran/
	PR fortran/97896
	* gfortran.h (gfc_dummy_arg::get_name): New method.
	(gfc_formal_arglist::get_name, gfc_intrinsic_arg::get_name):
	Declare new methods.
	* symbol.c (gfc_formal_arglist::get_name): Implement new method.
	* intrinsic.c (gfc_intrinsic_arg::get_name): Same.
	* trans-array.h (gfc_get_intrinsic_for_expr,
	gfc_get_proc_ifc_for_expr): New.
	* trans-array.c (gfc_get_intrinsic_for_expr,
	arg_evaluated_for_scalarization): New.
	(gfc_walk_elemental_function_args): Add intrinsic procedure
	as argument.  Check arg_evaluated_for_scalarization.
	* trans-intrinsic.c (gfc_walk_intrinsic_function): Update call.
	* trans-stmt.c (get_intrinsic_for_code): New.
	(gfc_trans_call): Update call.

gcc/testsuite/
	PR fortran/97896
	* gfortran.dg/index_5.f90: New.
---
 gcc/fortran/gfortran.h                |  3 ++
 gcc/fortran/intrinsic.c               |  6 +++
 gcc/fortran/symbol.c                  |  6 +++
 gcc/fortran/trans-array.c             | 53 ++++++++++++++++++++++++++-
 gcc/fortran/trans-array.h             |  3 ++
 gcc/fortran/trans-intrinsic.c         |  1 +
 gcc/fortran/trans-stmt.c              | 20 ++++++++++
 gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++++
 8 files changed, 114 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0007-fortran-Ignore-unused-args-in-scalarization-PR97896.patch --]
[-- Type: text/x-patch; name="0007-fortran-Ignore-unused-args-in-scalarization-PR97896.patch", Size: 7910 bytes --]

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 627a3480ef1..6d9af76c9fc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1136,6 +1136,7 @@ gfc_component;
 class gfc_dummy_arg
 {
 public:
+  virtual const char *get_name () const = 0;
   virtual const gfc_typespec & get_typespec () const = 0;
   virtual bool is_optional () const = 0;
 };
@@ -1149,6 +1150,7 @@ struct gfc_formal_arglist : public gfc_dummy_arg
   /* Points to the next formal argument.  */
   struct gfc_formal_arglist *next;
 
+  virtual const char *get_name () const FINAL OVERRIDE;
   virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
   virtual bool is_optional () const FINAL OVERRIDE;
 };
@@ -2183,6 +2185,7 @@ struct gfc_intrinsic_arg : public gfc_dummy_arg
 
   struct gfc_intrinsic_arg *next;
 
+  virtual const char *get_name () const FINAL OVERRIDE;
   virtual const gfc_typespec & get_typespec () const FINAL OVERRIDE;
   virtual bool is_optional () const FINAL OVERRIDE;
 };
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index b3e907ba3b8..af4da7ea7d3 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -5472,6 +5472,12 @@ gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
 }
 
 
+const char *
+gfc_intrinsic_arg::get_name () const
+{
+  return name;
+}
+
 const gfc_typespec &
 gfc_intrinsic_arg::get_typespec () const
 {
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 59f0d0385a0..9d1e2f876dc 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -5261,6 +5261,12 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
 }
 
 
+const char *
+gfc_formal_arglist::get_name () const
+{
+  return sym->name;
+}
+
 const gfc_typespec &
 gfc_formal_arglist::get_typespec () const
 {
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7d85abb181f..1fe48c22b93 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11200,6 +11200,51 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref)
 }
 
 
+/* Given an expression referring to an intrinsic function call,
+   return the intrinsic symbol.  */
+
+gfc_intrinsic_sym *
+gfc_get_intrinsic_for_expr (gfc_expr *call)
+{
+  if (call == NULL)
+    return NULL;
+
+  /* Normal procedure case.  */
+  if (call->expr_type == EXPR_FUNCTION)
+    return call->value.function.isym;
+  else
+    return NULL;
+}
+
+
+/* Indicates whether an argument to an intrinsic function should be used in
+   scalarization.  It is usually the case, except for some intrinsics
+   requiring the value to be constant, and using the value at compile time only.
+   As the value is not used at runtime in those cases, we don’t produce code
+   for it, and it should not be visible to the scalarizer.  */
+
+static bool
+arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
+				 gfc_dummy_arg *dummy_arg)
+{
+  if (function != NULL)
+    {
+      switch (function->id)
+	{
+	  case GFC_ISYM_INDEX:
+	    if (strcmp ("kind", dummy_arg->get_name ()) == 0)
+	      return false;
+	  /* Fallthrough.  */
+
+	  default:
+	    break;
+	}
+    }
+
+  return true;
+}
+
+
 /* Walk the arguments of an elemental function.
    PROC_EXPR is used to check whether an argument is permitted to be absent.  If
    it is NULL, we don't do the check and the argument is assumed to be present.
@@ -11207,6 +11252,7 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref)
 
 gfc_ss *
 gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
+				  gfc_intrinsic_sym *intrinsic_sym,
 				  gfc_ss_type type)
 {
   int scalar;
@@ -11221,7 +11267,11 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
   for (; arg; arg = arg->next)
     {
       gfc_dummy_arg * const dummy_arg = arg->associated_dummy;
-      if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
+      if (!arg->expr
+	  || arg->expr->expr_type == EXPR_NULL
+	  || (dummy_arg
+	      && intrinsic_sym
+	      && !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg)))
 	continue;
 
       newss = gfc_walk_subexpr (head, arg->expr);
@@ -11310,6 +11360,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
 
       ss = gfc_walk_elemental_function_args (old_ss,
 					     expr->value.function.actual,
+					     gfc_get_intrinsic_for_expr (expr),
 					     GFC_SS_REFERENCE);
       if (ss != old_ss
 	  && (comp
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 998fd284dd6..19c2f765b9a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -74,6 +74,8 @@ void gfc_trans_static_array_pointer (gfc_symbol *);
 
 /* Get the procedure interface for a function call.  */
 gfc_symbol *gfc_get_proc_ifc_for_expr (gfc_expr *);
+/* Get the intrinsic symbol for an intrinsic function call.  */
+gfc_intrinsic_sym *gfc_get_intrinsic_for_expr (gfc_expr *);
 /* Generate scalarization information for an expression.  */
 gfc_ss *gfc_walk_expr (gfc_expr *);
 /* Workhorse for gfc_walk_expr.  */
@@ -82,6 +84,7 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *);
 gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref);
 /* Walk the arguments of an elemental function.  */
 gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *,
+					  gfc_intrinsic_sym *,
 					  gfc_ss_type);
 /* Walk an intrinsic function.  */
 gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 8a9283b358d..c2383119e5d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11163,6 +11163,7 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr,
 
   if (isym->elemental)
     return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
+					     expr->value.function.isym,
 					     GFC_SS_SCALAR);
 
   if (expr->rank == 0)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 3fd4475f411..2b9ca875ee5 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -356,6 +356,25 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
 }
 
 
+/* Given an executable statement referring to an intrinsic function call,
+   returns the intrinsic symbol.  */
+
+static gfc_intrinsic_sym *
+get_intrinsic_for_code (gfc_code *code)
+{
+  if (code->op == EXEC_CALL)
+    {
+      gfc_intrinsic_sym * const isym = code->resolved_isym;
+      if (isym)
+	return isym;
+      else
+	return gfc_get_intrinsic_for_expr (code->expr1);
+    }
+
+  return NULL;
+}
+
+
 /* Translate the CALL statement.  Builds a call to an F95 subroutine.  */
 
 tree
@@ -381,6 +400,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
   ss = gfc_ss_terminator;
   if (code->resolved_sym->attr.elemental)
     ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
+					   get_intrinsic_for_code (code),
 					   GFC_SS_REFERENCE);
 
   /* MVBITS is inlined but needs the dependency checking found here.  */
diff --git a/gcc/testsuite/gfortran.dg/index_5.f90 b/gcc/testsuite/gfortran.dg/index_5.f90
new file mode 100644
index 00000000000..e039455d175
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/index_5.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+!
+! PR fortran/97896
+! An ICE occured with INDEX when the KIND argument was present
+! because of a mismatch between the number of arguments expected
+! during the scalarization process and the number of arguments actually
+! used.
+!
+! Test contributed by Harald Anlauf <anlauf@gcc.gnu.org>, based on an initial
+! submission by G. Steinmetz <gscfq@t-online.de>.
+
+program p
+  implicit none
+  logical    :: a(2)
+  integer    :: b(2)
+  integer(8) :: d(2)
+  b = index ('xyxyz','yx', back=a)
+  b = index ('xyxyz','yx', back=a, kind=4)
+  d = index ('xyxyz','yx', back=a, kind=8)
+  b = index ('xyxyz','yx', back=a, kind=8)
+  d = index ('xyxyz','yx', back=a, kind=4)
+end
+

Re: [PATCH 1/7] fortran: new abstract class gfc_dummy_arg

[Thomas Koenig]

Hi Mikael,

> Introduce a new abstract class gfc_dummy_arg that provides a common
> interface to both dummy arguments of user-defined procedures (which
> have type gfc_formal_arglist) and dummy arguments of intrinsic procedures
> (which have type gfc_intrinsic_arg).

good to see you again!

So far, we have refrained from adding too much explicit C++-isms into
the code, and if we do, my participation at least will have to be
reduced sharply (I don't speak much C++, and I don't intend to learn).

So, is this a path we want to go down?

Regards

	Thomas

Re: [PATCH 1/7] fortran: new abstract class gfc_dummy_arg

[Mikael Morin]

Le 04/08/2021 à 09:05, Thomas Koenig a écrit :
> 
> So far, we have refrained from adding too much explicit C++-isms into
> the code, and if we do, my participation at least will have to be
> reduced sharply (I don't speak much C++, and I don't intend to learn).
> 
> So, is this a path we want to go down?
> 
I’m not a C++ fanboy, but I think that avoiding it at all price would be 
a mistake.
Even fortran has support for typebound procedures.  It’s not an obscure 
feature.
Of course my (lack of) recent activity makes my voice very weak for any 
decision regarding the future of the project.

Now regarding these patches, I can propose dropping patches 1-5 
completely.  I don’t want to rewrite it with unions and the like.
Patch 7 would need some adjustments, but I promised to do it for 
backport anyway.
Does that work?
Mikael