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

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

[Mikael Morin]

Hello,

I repost this patch series initially targetted at the 11 branch only [1],
and that I now would like to commit to master as well before.

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 2 of the series, preceded with the revert in patch 1.
I intend to commit both of them squashed together.

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


Changes from v1:

  Rebase on master.


[1] https://gcc.gnu.org/pipermail/fortran/2021-August/056329.html


Mikael Morin (2):
  Revert "Remove KIND argument from INDEX so it does not mess up
    scalarization."
  fortran: Ignore unused args in scalarization [PR97896]

 gcc/fortran/intrinsic.c               | 48 +++------------------
 gcc/fortran/intrinsic.h               |  3 +-
 gcc/fortran/iresolve.c                | 21 ++-------
 gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
 gcc/fortran/trans-array.h             |  3 ++
 gcc/fortran/trans-decl.c              | 24 +----------
 gcc/fortran/trans-intrinsic.c         |  1 +
 gcc/fortran/trans-stmt.c              | 20 +++++++++
 gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++
 9 files changed, 121 insertions(+), 83 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90

-- 
2.33.0

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

[Mikael Morin]

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


This reverts commit d09847357b965a2c2cda063827ce362d4c9c86f2 except for
its testcase.

gcc/fortran/ChangeLog:
	* 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: 0001-Revert-Remove-KIND-argument-from-INDEX-so-it-does-no.patch --]
[-- Type: text/x-patch; name="0001-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 f5c88d98cc9..a6a18a471e3 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -888,39 +888,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.  */
@@ -2223,11 +2190,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);
 
@@ -4530,10 +4497,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 7511daaaaf1..fb655fb078a 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -519,7 +519,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 49ba9060eae..cb7f684d52c 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"
@@ -2267,28 +2266,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 2/2] fortran: Ignore unused args in scalarization [PR97896]

[Mikael Morin]

[-- Attachment #1: Type: text/plain, Size: 1500 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
function.  That argument 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 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.

	PR fortran/97896

gcc/fortran/ChangeLog:
	* 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.  Count arguments.  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/ChangeLog:
	* gfortran.dg/index_5.f90: New.
---
 gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
 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 ++++++++++
 5 files changed, 107 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: 0002-fortran-Ignore-unused-args-in-scalarization-PR97896.patch --]
[-- Type: text/x-patch; name="0002-fortran-Ignore-unused-args-in-scalarization-PR97896.patch", Size: 6975 bytes --]

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 5ceb261b698..79321854498 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11460,6 +11460,59 @@ 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.
+   FUNCTION is the intrinsic function being called, ACTUAL_ARG is the actual
+   argument being examined in that call, and ARG_NUM the index number
+   of ACTUAL_ARG in the list of arguments.
+   The intrinsic procedure’s dummy argument associated with ACTUAL_ARG is
+   identified using the name in ACTUAL_ARG if it is present (that is: if it’s
+   a keyword argument), otherwise using ARG_NUM.  */
+
+static bool
+arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
+				 gfc_actual_arglist &actual_arg, int arg_num)
+{
+  if (function != NULL)
+    {
+      switch (function->id)
+	{
+	  case GFC_ISYM_INDEX:
+	    if ((actual_arg.name == NULL && arg_num == 3)
+		|| (actual_arg.name != NULL
+		    && strcmp ("kind", actual_arg.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.
@@ -11467,6 +11520,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_symbol *proc_ifc, gfc_ss_type type)
 {
   gfc_formal_arglist *dummy_arg;
@@ -11483,10 +11537,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
   else
     dummy_arg = NULL;
 
+  int arg_num = 0;
   scalar = 1;
   for (; arg; arg = arg->next)
     {
-      if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
+      if (!arg->expr
+	  || arg->expr->expr_type == EXPR_NULL
+	  || !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num))
 	goto loop_continue;
 
       newss = gfc_walk_subexpr (head, arg->expr);
@@ -11519,6 +11576,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
         }
 
 loop_continue:
+      arg_num++;
       if (dummy_arg != NULL)
 	dummy_arg = dummy_arg->next;
     }
@@ -11579,6 +11637,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_get_proc_ifc_for_expr (expr),
 					     GFC_SS_REFERENCE);
       if (ss != old_ss
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 12068c742a5..8f806c32f80 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -76,6 +76,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.  */
@@ -84,6 +86,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_symbol *, 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 0d9195863a3..3f867911af5 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11084,6 +11084,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,
 					     NULL, GFC_SS_SCALAR);
 
   if (expr->rank == 0)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index eaf2cc25f21..bdf7957c4a0 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;
+}
+
+
 /* 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.  */
@@ -402,6 +421,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),
 					   get_proc_ifc_for_call (code),
 					   GFC_SS_REFERENCE);
 
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 0/2] fortran: Ignore unused arguments for scalarisation [PR97896]

[Harald Anlauf]

Hi Mikael,

thanks for working on this!

Am 07.11.21 um 17:17 schrieb Mikael Morin via Gcc-patches:
> Hello,
>
> I repost this patch series initially targetted at the 11 branch only [1],
> and that I now would like to commit to master as well before.
>
> 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 2 of the series, preceded with the revert in patch 1.
> I intend to commit both of them squashed together.
>
> Regression-tested on x86_64-linux-gnu.  Ok for master and 11 branch?
>
>
> Changes from v1:
>
>    Rebase on master.
>
>
> [1] https://gcc.gnu.org/pipermail/fortran/2021-August/056329.html
>
>
> Mikael Morin (2):
>    Revert "Remove KIND argument from INDEX so it does not mess up
>      scalarization."
>    fortran: Ignore unused args in scalarization [PR97896]
>
>   gcc/fortran/intrinsic.c               | 48 +++------------------
>   gcc/fortran/intrinsic.h               |  3 +-
>   gcc/fortran/iresolve.c                | 21 ++-------
>   gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
>   gcc/fortran/trans-array.h             |  3 ++
>   gcc/fortran/trans-decl.c              | 24 +----------
>   gcc/fortran/trans-intrinsic.c         |  1 +
>   gcc/fortran/trans-stmt.c              | 20 +++++++++
>   gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++
>   9 files changed, 121 insertions(+), 83 deletions(-)
>   create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90
>

LGTM at first sight.  But you may want to wait for Tobias or Thomas to
take a second look.

Thanks for the patch!

Harald

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

[Harald Anlauf]

Hi Mikael,

thanks for working on this!

Am 07.11.21 um 17:17 schrieb Mikael Morin via Gcc-patches:
> Hello,
> 
> I repost this patch series initially targetted at the 11 branch only [1],
> and that I now would like to commit to master as well before.
> 
> 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 2 of the series, preceded with the revert in patch 1.
> I intend to commit both of them squashed together.
> 
> Regression-tested on x86_64-linux-gnu.  Ok for master and 11 branch?
> 
> 
> Changes from v1:
> 
>    Rebase on master.
> 
> 
> [1] https://gcc.gnu.org/pipermail/fortran/2021-August/056329.html
> 
> 
> Mikael Morin (2):
>    Revert "Remove KIND argument from INDEX so it does not mess up
>      scalarization."
>    fortran: Ignore unused args in scalarization [PR97896]
> 
>   gcc/fortran/intrinsic.c               | 48 +++------------------
>   gcc/fortran/intrinsic.h               |  3 +-
>   gcc/fortran/iresolve.c                | 21 ++-------
>   gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
>   gcc/fortran/trans-array.h             |  3 ++
>   gcc/fortran/trans-decl.c              | 24 +----------
>   gcc/fortran/trans-intrinsic.c         |  1 +
>   gcc/fortran/trans-stmt.c              | 20 +++++++++
>   gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++
>   9 files changed, 121 insertions(+), 83 deletions(-)
>   create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90
> 

LGTM at first sight.  But you may want to wait for Tobias or Thomas to
take a second look.

Thanks for the patch!

Harald

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

[Thomas Koenig]

On 07.11.21 17:17, Mikael Morin via Fortran wrote:
> Regression-tested on x86_64-linux-gnu.  Ok for master and 11 branch?

OK.

Just one remark: Since just reverting my old patch would introduce
a regression for that one revision, please squash the patches before
committing.

Thanks a lot for the patch!

Best regards

	Thomas

[committed] fortran: Ignore unused arguments for scalarisation [PR97896]

[Mikael Morin]

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

Committed as r12-5192.

[-- Attachment #2: pr97896-final.patch --]
[-- Type: text/x-patch, Size: 15558 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
function.  That argument 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 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.
This also reverts the existing workaround
(commit d09847357b965a2c2cda063827ce362d4c9c86f2 except for its testcase).

	PR fortran/97896

gcc/fortran/ChangeLog:
	* 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.
	* 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.  Count arguments.  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/ChangeLog:
	* gfortran.dg/index_5.f90: New.
---
 gcc/fortran/intrinsic.c               | 48 +++------------------
 gcc/fortran/intrinsic.h               |  3 +-
 gcc/fortran/iresolve.c                | 21 ++-------
 gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
 gcc/fortran/trans-array.h             |  3 ++
 gcc/fortran/trans-decl.c              | 24 +----------
 gcc/fortran/trans-intrinsic.c         |  1 +
 gcc/fortran/trans-stmt.c              | 20 +++++++++
 gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++
 9 files changed, 121 insertions(+), 83 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index a5a087be083..2d7d2461fd0 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -889,39 +889,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.  */
@@ -2224,11 +2191,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);
 
@@ -4531,10 +4498,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 7511daaaaf1..fb655fb078a 100644
--- a/gcc/fortran/intrinsic.h
+++ b/gcc/fortran/intrinsic.h
@@ -519,7 +519,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-array.c b/gcc/fortran/trans-array.c
index 5ceb261b698..79321854498 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11460,6 +11460,59 @@ 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.
+   FUNCTION is the intrinsic function being called, ACTUAL_ARG is the actual
+   argument being examined in that call, and ARG_NUM the index number
+   of ACTUAL_ARG in the list of arguments.
+   The intrinsic procedure’s dummy argument associated with ACTUAL_ARG is
+   identified using the name in ACTUAL_ARG if it is present (that is: if it’s
+   a keyword argument), otherwise using ARG_NUM.  */
+
+static bool
+arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
+				 gfc_actual_arglist &actual_arg, int arg_num)
+{
+  if (function != NULL)
+    {
+      switch (function->id)
+	{
+	  case GFC_ISYM_INDEX:
+	    if ((actual_arg.name == NULL && arg_num == 3)
+		|| (actual_arg.name != NULL
+		    && strcmp ("kind", actual_arg.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.
@@ -11467,6 +11520,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_symbol *proc_ifc, gfc_ss_type type)
 {
   gfc_formal_arglist *dummy_arg;
@@ -11483,10 +11537,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
   else
     dummy_arg = NULL;
 
+  int arg_num = 0;
   scalar = 1;
   for (; arg; arg = arg->next)
     {
-      if (!arg->expr || arg->expr->expr_type == EXPR_NULL)
+      if (!arg->expr
+	  || arg->expr->expr_type == EXPR_NULL
+	  || !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num))
 	goto loop_continue;
 
       newss = gfc_walk_subexpr (head, arg->expr);
@@ -11519,6 +11576,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
         }
 
 loop_continue:
+      arg_num++;
       if (dummy_arg != NULL)
 	dummy_arg = dummy_arg->next;
     }
@@ -11579,6 +11637,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_get_proc_ifc_for_expr (expr),
 					     GFC_SS_REFERENCE);
       if (ss != old_ss
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 12068c742a5..8f806c32f80 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -76,6 +76,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.  */
@@ -84,6 +86,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_symbol *, gfc_ss_type);
 /* Walk an intrinsic function.  */
 gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *,
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 49ba9060eae..cb7f684d52c 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"
@@ -2267,28 +2266,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);
 		}
 	    }
 	}
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 0d9195863a3..3f867911af5 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11084,6 +11084,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,
 					     NULL, GFC_SS_SCALAR);
 
   if (expr->rank == 0)
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index eaf2cc25f21..bdf7957c4a0 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;
+}
+
+
 /* 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.  */
@@ -402,6 +421,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),
 					   get_proc_ifc_for_call (code),
 					   GFC_SS_REFERENCE);
 
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
+

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

[Mikael Morin]

Hello,

This is a variant of the patch series previously posted for master at [1], without patches 1 to 5.
It has a more limited impact, which makes it more suitable for the release branches.

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 2 of the series, preceded with the revert in patch 1.  I intend to commit both of them squashed together.

Regression-tested on x86_64-linux-gnu.  Ok for 11 branch? 


[1] https://gcc.gnu.org/pipermail/fortran/2021-August/056317.html

Mikael Morin (2):
  Revert "Remove KIND argument from INDEX so it does not mess up
    scalarization."
  fortran: Ignore unused args in scalarization [PR97896]

 gcc/fortran/intrinsic.c               | 48 +++------------------
 gcc/fortran/intrinsic.h               |  3 +-
 gcc/fortran/iresolve.c                | 21 ++-------
 gcc/fortran/trans-array.c             | 61 ++++++++++++++++++++++++++-
 gcc/fortran/trans-array.h             |  3 ++
 gcc/fortran/trans-decl.c              | 24 +----------
 gcc/fortran/trans-intrinsic.c         |  1 +
 gcc/fortran/trans-stmt.c              | 20 +++++++++
 gcc/testsuite/gfortran.dg/index_5.f90 | 23 ++++++++++
 9 files changed, 121 insertions(+), 83 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90

-- 
2.30.2