* [PATCH v2 1/7] fortran: new wrapper class gfc_dummy_arg
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 2/7] fortran: Tiny sort_actual internal refactoring Mikael Morin
` (5 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 421 bytes --]
Introduce a new wrapper 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_kind, gfc_dummy_arg): New.
---
gcc/fortran/gfortran.h | 20 +++++++++++++++++++-
1 file changed, 19 insertions(+), 1 deletion(-)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-fortran-new-wrapper-class-gfc_dummy_arg.patch --]
[-- Type: text/x-patch; name="0001-fortran-new-wrapper-class-gfc_dummy_arg.patch", Size: 882 bytes --]
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 921aed93dc3..55ac4a80549 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2169,11 +2169,29 @@ typedef struct gfc_intrinsic_arg
gfc_actual_arglist *actual;
struct gfc_intrinsic_arg *next;
-
}
gfc_intrinsic_arg;
+typedef enum {
+ GFC_UNDEFINED_DUMMY_ARG = 0,
+ GFC_INTRINSIC_DUMMY_ARG,
+ GFC_NON_INTRINSIC_DUMMY_ARG
+}
+gfc_dummy_arg_kind;
+
+/* dummy arg of either an intrinsic or a user-defined procedure. */
+struct gfc_dummy_arg
+{
+ gfc_dummy_arg_kind kind;
+
+ union {
+ gfc_intrinsic_arg *intrinsic;
+ gfc_formal_arglist *non_intrinsic;
+ } u;
+};
+
+
/* Specifies the various kinds of check functions used to verify the
argument lists of intrinsic functions. fX with X an integer refer
to check functions of intrinsics with X arguments. f1m is used for
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 2/7] fortran: Tiny sort_actual internal refactoring
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
2021-08-05 16:26 ` [PATCH v2 1/7] fortran: new wrapper class gfc_dummy_arg Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 3/7] fortran: Reverse actual vs dummy argument mapping Mikael Morin
` (4 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, 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 219f04f2317..ffeaf2841b7 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4411,19 +4411,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;
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 3/7] fortran: Reverse actual vs dummy argument mapping
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
2021-08-05 16:26 ` [PATCH v2 1/7] fortran: new wrapper class gfc_dummy_arg Mikael Morin
2021-08-05 16:26 ` [PATCH v2 2/7] fortran: Tiny sort_actual internal refactoring Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 4/7] fortran: simplify elemental arguments walking Mikael Morin
` (3 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 1562 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 (get_nonintrinsic_dummy_arg): New.
(gfc_compare_actual): Initialize associated_dummy.
* intrinsic.c (get_intrinsic_dummy_arg): New.
(sort_actual): Add argument vectors.
Use loops with indices on argument vectors.
Initialize associated_dummy.
---
gcc/fortran/gfortran.h | 11 ++++++++++-
gcc/fortran/interface.c | 21 ++++++++++++++++++--
gcc/fortran/intrinsic.c | 43 ++++++++++++++++++++++++++++++-----------
3 files changed, 61 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: 5934 bytes --]
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 55ac4a80549..c890d80bce0 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1144,6 +1144,9 @@ gfc_formal_arglist;
#define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist)
+struct gfc_dummy_arg;
+
+
/* The gfc_actual_arglist structure is for actual arguments and
for type parameter specification lists. */
typedef struct gfc_actual_arglist
@@ -1160,6 +1163,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;
@@ -2166,7 +2174,6 @@ typedef struct gfc_intrinsic_arg
gfc_typespec ts;
unsigned optional:1, value:1;
ENUM_BITFIELD (sym_intent) intent:2;
- gfc_actual_arglist *actual;
struct gfc_intrinsic_arg *next;
}
@@ -2191,6 +2198,8 @@ struct gfc_dummy_arg
} u;
};
+#define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg)
+
/* Specifies the various kinds of check functions used to verify the
argument lists of intrinsic functions. fX with X an integer refer
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa9da9..dba167559d1 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3026,6 +3026,18 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist *arguments)
}
+static gfc_dummy_arg *
+get_nonintrinsic_dummy_arg (gfc_formal_arglist *formal)
+{
+ gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg ();
+
+ dummy_arg->kind = GFC_NON_INTRINSIC_DUMMY_ARG;
+ dummy_arg->u.non_intrinsic = formal;
+
+ return dummy_arg;
+}
+
+
/* Given formal and actual argument lists, see if they are compatible.
If they are compatible, the actual argument list is sorted to
correspond with the formal list, and elements for missing optional
@@ -3131,6 +3143,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
"call at %L", where);
return false;
}
+ else
+ a->associated_dummy = get_nonintrinsic_dummy_arg (f);
if (a->expr == NULL)
{
@@ -3546,9 +3560,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 = get_nonintrinsic_dummy_arg (f);
+ }
if (na != 0)
{
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index ffeaf2841b7..c42891e7e1a 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4269,6 +4269,18 @@ remove_nullargs (gfc_actual_arglist **ap)
}
+static gfc_dummy_arg *
+get_intrinsic_dummy_arg (gfc_intrinsic_arg *intrinsic)
+{
+ gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg ();
+
+ dummy_arg->kind = GFC_INTRINSIC_DUMMY_ARG;
+ dummy_arg->u.intrinsic = intrinsic;
+
+ return dummy_arg;
+}
+
+
/* Given an actual arglist and a formal arglist, sort the actual
arglist so that its arguments are in a one-to-one correspondence
with the format arglist. Arguments that are not present are given
@@ -4286,8 +4298,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;
@@ -4339,7 +4357,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;
@@ -4349,7 +4367,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;
@@ -4367,7 +4385,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;
@@ -4382,21 +4401,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);
@@ -4409,9 +4428,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);
@@ -4424,6 +4443,8 @@ do_sort:
a->missing_arg_type = f->ts.type;
}
+ a->associated_dummy = get_intrinsic_dummy_arg (f);
+
if (actual == NULL)
*ap = a;
else
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 4/7] fortran: simplify elemental arguments walking
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
` (2 preceding siblings ...)
2021-08-05 16:26 ` [PATCH v2 3/7] fortran: Reverse actual vs dummy argument mapping Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 5/7] fortran: Delete redundant missing_arg_type field Mikael Morin
` (2 subsequent siblings)
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 1604 bytes --]
This adds two functions working with the wrapper class 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/
* interface.c (gfc_dummy_arg_get_typespec,
gfc_dummy_arg_is_optional): New functions.
* gfortran.h (gfc_dummy_arg_get_typespec,
gfc_dummy_arg_is_optional): Declare them.
* trans.h (gfc_ss_info::dummy_arg): Use the wrapper type
as declaration type.
* trans-array.c (gfc_scalar_elemental_arg_saved_as_reference):
use gfc_dummy_arg_get_typespec function 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 | 4 ++++
gcc/fortran/interface.c | 34 ++++++++++++++++++++++++++++++++++
gcc/fortran/trans-array.c | 23 +++++++----------------
gcc/fortran/trans-array.h | 2 +-
gcc/fortran/trans-intrinsic.c | 2 +-
gcc/fortran/trans-stmt.c | 22 ----------------------
gcc/fortran/trans.h | 4 ++--
7 files changed, 49 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: 7126 bytes --]
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c890d80bce0..12dd33bf74f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2201,6 +2201,10 @@ struct gfc_dummy_arg
#define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg)
+const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &);
+bool gfc_dummy_arg_is_optional (gfc_dummy_arg &);
+
+
/* Specifies the various kinds of check functions used to verify the
argument lists of intrinsic functions. fX with X an integer refer
to check functions of intrinsics with X arguments. f1m is used for
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index dba167559d1..d463ee8228a 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -5403,3 +5403,37 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
f = &((*f)->next);
}
}
+
+
+const gfc_typespec &
+gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg)
+{
+ switch (dummy_arg.kind)
+ {
+ case GFC_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.intrinsic->ts;
+
+ case GFC_NON_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.non_intrinsic->sym->ts;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
+
+bool
+gfc_dummy_arg_is_optional (gfc_dummy_arg & dummy_arg)
+{
+ switch (dummy_arg.kind)
+ {
+ case GFC_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.intrinsic->optional;
+
+ case GFC_NON_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.non_intrinsic->sym->attr.optional;
+
+ default:
+ gcc_unreachable ();
+ }
+}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013defdbb..6ae72a354e5 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2879,7 +2879,8 @@ 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
+ && gfc_dummy_arg_get_typespec (*ss_info->data.scalar.dummy_arg).type
+ == BT_CLASS
&& ss_info->expr->ts.type == BT_CLASS)
return true;
@@ -11207,9 +11208,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 +11218,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 +11233,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
+ && gfc_dummy_arg_is_optional (*dummy_arg)
&& arg->expr->expr_type == EXPR_VARIABLE
&& (gfc_expr_attr (arg->expr).optional
|| gfc_expr_attr (arg->expr).allocatable
@@ -11257,10 +11253,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 +11311,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
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 5/7] fortran: Delete redundant missing_arg_type field
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
` (3 preceding siblings ...)
2021-08-05 16:26 ` [PATCH v2 4/7] fortran: simplify elemental arguments walking Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 6/7] Revert "Remove KIND argument from INDEX so it does not mess up scalarization." Mikael Morin
2021-08-05 16:26 ` [PATCH v2 7/7] fortran: Ignore unused args in scalarization [PR97896] Mikael Morin
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 716 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 gfc_dummy_arg_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 | 9 +++++++--
4 files changed, 8 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: 2648 bytes --]
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 12dd33bf74f..5a28d1408eb 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1155,11 +1155,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 d463ee8228a..7289374e932 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3581,11 +3581,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 c42891e7e1a..d8bf5732e0a 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4438,10 +4438,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 = get_intrinsic_dummy_arg (f);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b18a9ec9799..3e1f12bfbc7 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5831,7 +5831,10 @@ 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)
+ gfc_dummy_arg * const dummy_arg = arg->associated_dummy;
+ if (dummy_arg
+ && gfc_dummy_arg_get_typespec (*dummy_arg).type
+ == BT_CHARACTER)
parmse.string_length = build_int_cst (gfc_charlen_type_node,
0);
}
@@ -5848,7 +5851,9 @@ 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
+ && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type
+ == BT_CHARACTER)
parmse.string_length = build_int_cst (gfc_charlen_type_node, 0);
}
else if (fsym && fsym->ts.type == BT_CLASS
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 6/7] Revert "Remove KIND argument from INDEX so it does not mess up scalarization."
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
` (4 preceding siblings ...)
2021-08-05 16:26 ` [PATCH v2 5/7] fortran: Delete redundant missing_arg_type field Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
2021-08-05 16:26 ` [PATCH v2 7/7] fortran: Ignore unused args in scalarization [PR97896] Mikael Morin
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, 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 d8bf5732e0a..5cd4225762b 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);
@@ -4547,10 +4514,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);
}
}
}
^ permalink raw reply [flat|nested] 8+ messages in thread* [PATCH v2 7/7] fortran: Ignore unused args in scalarization [PR97896]
2021-08-05 16:26 [PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896] Mikael Morin
` (5 preceding siblings ...)
2021-08-05 16:26 ` [PATCH v2 6/7] Revert "Remove KIND argument from INDEX so it does not mess up scalarization." Mikael Morin
@ 2021-08-05 16:26 ` Mikael Morin
6 siblings, 0 replies; 8+ messages in thread
From: Mikael Morin @ 2021-08-05 16:26 UTC (permalink / raw)
To: fortran; +Cc: gcc-patches, Mikael Morin
[-- Attachment #1: Type: text/plain, Size: 1683 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
* interface.c (gfc_dummy_arg_get_name): New function.
* gfortran.h (gfc_dummy_arg_get_name): Declare it.
* 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 | 1 +
gcc/fortran/interface.c | 17 +++++++++
gcc/fortran/trans-array.c | 51 ++++++++++++++++++++++++++-
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 ++++++++++++
7 files changed, 115 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: 7192 bytes --]
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5a28d1408eb..4035d260498 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2196,6 +2196,7 @@ struct gfc_dummy_arg
#define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg)
+const char * gfc_dummy_arg_get_name (gfc_dummy_arg &);
const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &);
bool gfc_dummy_arg_is_optional (gfc_dummy_arg &);
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 7289374e932..22aa916c88e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -5400,6 +5400,23 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
}
+const char *
+gfc_dummy_arg_get_name (gfc_dummy_arg & dummy_arg)
+{
+ switch (dummy_arg.kind)
+ {
+ case GFC_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.intrinsic->name;
+
+ case GFC_NON_INTRINSIC_DUMMY_ARG:
+ return dummy_arg.u.non_intrinsic->sym->name;
+
+ default:
+ gcc_unreachable ();
+ }
+}
+
+
const gfc_typespec &
gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg)
{
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6ae72a354e5..96b0a2583b0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11201,6 +11201,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 && dummy_arg != NULL)
+ {
+ switch (function->id)
+ {
+ case GFC_ISYM_INDEX:
+ if (strcmp ("kind", gfc_dummy_arg_get_name (*dummy_arg)) == 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.
@@ -11208,6 +11253,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;
@@ -11222,7 +11268,9 @@ 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
+ || !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg))
continue;
newss = gfc_walk_subexpr (head, arg->expr);
@@ -11311,6 +11359,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
+
^ permalink raw reply [flat|nested] 8+ messages in thread