[PATCH 0/7] fortran: Ignore unused arguments for scalarisation [PR97896]
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 2/7] fortran: Tiny sort_actual internal refactoring
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(-)
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 1/7] fortran: new abstract class gfc_dummy_arg
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(-)
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 =
[PATCH 3/7] fortran: Reverse actual vs dummy argument mapping
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(-)
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 dummy_args;
+ auto_vec 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 (
[PATCH 4/7] fortran: simplify elemental arguments walking
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(-)
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 *hea
[PATCH 5/7] fortran: Delete redundant missing_arg_type field
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(-)
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."
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(-)
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,
+
[PATCH 7/7] fortran: Ignore unused args in scalarization [PR97896]
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
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",
Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514
Here's now my third attempt to fix this PR, taking into account
the comments by Tobias and Bernhard.
> > On 10.06.21 20:52, Harald Anlauf via Fortran wrote:
> > > +static bool
> > > +substring_has_constant_len (gfc_expr *e)
> > > +{
> > > + ptrdiff_t istart, iend;
> > > + size_t length;
> > > + bool equal_length = false;
> > > +
> > > + if (e->ts.type != BT_CHARACTER
> > > + || !e->ref
> > > + || e->ref->type != REF_SUBSTRING
> >
> > Is there a reason why you do not handle:
> >
> > type t
> >character(len=5) :: str1
> >character(len=:), allocatable :: str2
> > end type
> > type(t) :: x
> >
> > allocate(x%str2, source="abd")
> > if (len (x%str)) /= 1) ...
> > if (len (x%str2(1:2) /= 2) ...
> > etc.
> >
> > Namely: Search the last_ref = expr->ref->next->next ...?
> > and then check that lastref?
The mentioned search is now implemented.
Note, however, that gfc_simplify_len still won't handle neither
deferred strings nor their substrings.
I think there is nothing to simplify at compile time here. Otherwise
there would be a conflict/inconsistency with type parameter inquiry,
see F2018:9.4.5(2):
"A deferred type parameter of a pointer that is not associated or
of an unallocated allocatable variable shall not be inquired about."
> >* * *
> >
> > Slightly unrelated: I think the following does not violate
> > F2018's R916 / C923 – but is rejected, namely:
> >R916 type-param-inquiry is designator % type-param-name
> > the latter is 'len' or 'kind' for intrinsic types. And:
> >R901 designator is ...
> > or substring
> > But
> >
> > character(len=5) :: str
> > print *, str(1:3)%len
> > end
> >
> > fails with
> >
> > 2 | print *, str(1:3)%len
> >| 1
> > Error: Syntax error in PRINT statement at (1)
> >
> >
> > Assuming you don't want to handle it, can you open a new PR?
> > Thanks!
I tried to look into this, but there appear to be several unrelated
issues requiring a separate treatment. I therefore opened:
https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101735
> > > + istart = gfc_mpz_get_hwi (e->ref->u.ss.start->value.integer);
> > > + iend = gfc_mpz_get_hwi (e->ref->u.ss.end->value.integer);
> > > + length = gfc_mpz_get_hwi (e->ref->u.ss.length->length->value.integer);
> > > +
> > > + if (istart <= iend)
> > > +{
> > > + if (istart < 1)
> > > + {
> > > + gfc_error ("Substring start index (%ld) at %L below 1",
> > > + (long) istart, &e->ref->u.ss.start->where);
> >
> > As mentioned by Bernhard, you could use HOST_WIDE_INT_PRINT_DEC.
> >
> > (It probably only matters on Windows which uses long == int = 32bit for
> > strings longer than INT_MAX.)
Done.
The updated patch regtests fine. OK?
Thanks,
Harald
Fortran - simplify length of substring with constant bounds
gcc/fortran/ChangeLog:
PR fortran/100950
* simplify.c (substring_has_constant_len): New.
(gfc_simplify_len): Handle case of substrings with constant
bounds.
gcc/testsuite/ChangeLog:
PR fortran/100950
* gfortran.dg/pr100950.f90: New test.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47aa98f..8f7fcec94c8 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,69 @@ gfc_simplify_leadz (gfc_expr *e)
}
+/* Check for constant length of a substring. */
+
+static bool
+substring_has_constant_len (gfc_expr *e)
+{
+ gfc_ref *ref;
+ HOST_WIDE_INT istart, iend, length;
+ bool equal_length = false;
+
+ if (e->ts.type != BT_CHARACTER || e->ts.deferred)
+return false;
+
+ for (ref = e->ref; ref; ref = ref->next)
+if (ref->type != REF_COMPONENT)
+ break;
+
+ if (!ref
+ || ref->type != REF_SUBSTRING
+ || !ref->u.ss.start
+ || ref->u.ss.start->expr_type != EXPR_CONSTANT
+ || !ref->u.ss.end
+ || ref->u.ss.end->expr_type != EXPR_CONSTANT
+ || !ref->u.ss.length
+ || !ref->u.ss.length->length
+ || ref->u.ss.length->length->expr_type != EXPR_CONSTANT)
+return false;
+
+ /* Basic checks on substring starting and ending indices. */
+ if (!gfc_resolve_substring (ref, &equal_length))
+return false;
+
+ istart = gfc_mpz_get_hwi (ref->u.ss.start->value.integer);
+ iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer);
+ length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
+
+ if (istart <= iend)
+{
+ if (istart < 1)
+ {
+ gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
+ ") at %L below 1",
+ istart, &ref->u.ss.start->where);
+ return false;
+ }
+ if (iend > length)
+ {
+ gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
+ ") at %L exceeds string length",
+ iend, &ref->u.ss.end->where);
+ return false;
+ }
+ length = iend - istart + 1;
+}
+ else
+length = 0;
+
+ /* Fix substring length. */
+ e->value.character.length = length;
+
+ return true;
+}
+
+
gfc_expr
