[PATCH] fortran: Remove reference count update [PR108957]
Hello, Harald reminded me recently that there was a working patch attached to the PR. I added a documentation comment with the hope that it may help avoid making the same mistake in the future. Regression tested on x86_64-pc-linux-gnu. OK for master? -- >8 -- Remove one reference count incrementation following the assignment of a symbol pointer to a local variable. Most symbol pointers are "weak" pointer and don't need any reference count update when they are assigned, and it is especially the case of local variables. This fixes a memory leak with the testcase from the PR (not included). PR fortran/108957 gcc/fortran/ChangeLog: * gfortran.h (gfc_symbol): Add comment documenting reference counting. * parse.cc (parse_interface): Remove reference count incrementation. --- gcc/fortran/gfortran.h | 20 gcc/fortran/parse.cc | 3 --- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index f4a1c106cea..6caf7765ac6 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1944,7 +1944,27 @@ typedef struct gfc_symbol according to the Fortran standard. */ unsigned pass_as_value:1; + /* Reference counter, used for memory management. + + Some symbols may be present in more than one namespace, for example + function and subroutine symbols are present both in the outer namespace and + the procedure body namespace. Freeing symbols with the namespaces they are + in would result in double free for those symbols. This field counts + references and is used to delay the memory release until the last reference + to the symbol is removed. + + Not every symbol pointer is accounted for reference counting. Fields + gfc_symtree::n::sym are, and gfc_finalizer::proc_sym as well. But most of + them (dummy arguments, generic list elements, etc) are "weak" pointers; + the reference count isn't updated when they are assigned, and they are + ignored when the surrounding structure memory is released. This is not a + problem because there is always a namespace as surrounding context and + symbols have a name they can be referred with in that context, so the + namespace keeps the symbol from being freed, keeping the pointer valid. + When the namespace ceases to exist, and the symbols with it, the other + structures referencing symbols cease to exist as well. */ int refs; + struct gfc_namespace *ns;/* namespace containing this symbol */ tree backend_decl; diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index 8f09ddf753c..58386805ffe 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -4064,9 +4064,6 @@ loop: accept_statement (st); prog_unit = gfc_new_block; prog_unit->formal_ns = gfc_current_ns; - if (prog_unit == prog_unit->formal_ns->proc_name - && prog_unit->ns != prog_unit->formal_ns) -prog_unit->refs++; decl: /* Read data declaration statements. */ -- 2.40.1
[PATCH] fortran: Undo new symbols in all namespaces [PR110996]
Hello,
this fixes a memory management issue in the fortran frontend.
I have included the (reduced) testcase from the PR, even if it wasn't failing
here on x86_64 with the test harness.
Tested on x86_64-pc-linux-gnu and manually checked the testcase with
valgrind.
OK for master?
-- >8 --
Remove new symbols from all namespaces they may have been added to in case a
statement mismatches in the end and all the symbols referenced in it have to
be reverted.
This fixes memory errors and random internal compiler errors caused by
a new symbol left with dangling pointers but not properly removed from the
namespace at statement rejection.
Before this change, new symbols were removed from their own namespace
(their ns field) only. This change additionally removes them from the
namespaces pointed to by respectively the gfc_current_ns global variable,
and the symbols' formal_ns field.
PR fortran/110996
gcc/fortran/ChangeLog:
* gfortran.h (gfc_release_symbol): Set return type to bool.
* symbol.cc (gfc_release_symbol): Ditto. Return whether symbol was
freed.
(delete_symbol_from_ns): New, outline code from...
(gfc_restore_last_undo_checkpoint): ... here. Delete new symbols
from two more namespaces.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr110996.f90: New test.
---
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/symbol.cc | 57 --
gcc/testsuite/gfortran.dg/pr110996.f90 | 16
3 files changed, 62 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr110996.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 371f8743312..f4a1c106cea 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3514,7 +3514,7 @@ gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
void gfc_free_symbol (gfc_symbol *&);
-void gfc_release_symbol (gfc_symbol *&);
+bool gfc_release_symbol (gfc_symbol *&);
gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 2cba2ea0bed..a6078bc608a 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3105,13 +3105,14 @@ gfc_free_symbol (gfc_symbol *)
}
-/* Decrease the reference counter and free memory when we reach zero. */
+/* Decrease the reference counter and free memory when we reach zero.
+ Returns true if the symbol has been freed, false otherwise. */
-void
+bool
gfc_release_symbol (gfc_symbol *)
{
if (sym == NULL)
-return;
+return false;
if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
&& (!sym->attr.entry || !sym->module))
@@ -3125,10 +3126,11 @@ gfc_release_symbol (gfc_symbol *)
sym->refs--;
if (sym->refs > 0)
-return;
+return false;
gcc_assert (sym->refs == 0);
gfc_free_symbol (sym);
+ return true;
}
@@ -3649,6 +3651,29 @@ gfc_drop_last_undo_checkpoint (void)
}
+/* Remove the reference to the symbol SYM in the symbol tree held by NS
+ and free SYM if the last reference to it has been removed.
+ Returns whether the symbol has been freed. */
+
+static bool
+delete_symbol_from_ns (gfc_symbol *sym, gfc_namespace *ns)
+{
+ if (ns == nullptr)
+return false;
+
+ /* The derived type is saved in the symtree with the first
+ letter capitalized; the all lower-case version to the
+ derived type contains its associated generic function. */
+ const char *sym_name = gfc_fl_struct (sym->attr.flavor)
+? gfc_dt_upper_string (sym->name)
+: sym->name;
+
+ gfc_delete_symtree (>sym_root, sym_name);
+
+ return gfc_release_symbol (sym);
+}
+
+
/* Undoes all the changes made to symbols since the previous checkpoint.
This subroutine is made simpler due to the fact that attributes are
never removed once added. */
@@ -3703,15 +3728,23 @@ gfc_restore_last_undo_checkpoint (void)
}
if (p->gfc_new)
{
- /* The derived type is saved in the symtree with the first
-letter capitalized; the all lower-case version to the
-derived type contains its associated generic function. */
- if (gfc_fl_struct (p->attr.flavor))
- gfc_delete_symtree (>ns->sym_root,gfc_dt_upper_string (p->name));
- else
- gfc_delete_symtree (>ns->sym_root, p->name);
+ bool freed = delete_symbol_from_ns (p, p->ns);
- gfc_release_symbol (p);
+ /* If the symbol is a procedure (function or subroutine), remove
+it from the procedure body namespace as well as from the outer
+namespace. */
+ if (!freed
+ && p->formal_ns !=
Re: [PATCH] fortran: Remove redundant tree walk to delete element
Le 08/09/2023 à 23:22, Harald Anlauf via Fortran a écrit :
Am 08.09.23 um 12:04 schrieb Mikael Morin via Gcc-patches:
Hello,
this avoids some redundant work in the symbol deletion code, which is
used a lot by the parser to cancel statements that fail to match in the
end.
I haven't tried to measure the performance effect, if any, on a
pathological example;
just passed the fortran testsuite on x86_64-pc-linux-gnu.
OK for master?
This is OK.
Thanks.
I had forgotten function comments.
This is what I have pushed.
From 1ea7130315a14ba4f66c2de76d034b33181812c5 Mon Sep 17 00:00:00 2001
From: Mikael Morin
Date: Sat, 9 Sep 2023 11:45:11 +0200
Subject: [PATCH] fortran: Remove redundant tree walk to delete element
Remove preliminary walk of the symbol tree when we are about to remove an
element. This preliminary walk was necessary because the deletion function
updated the tree without reporting back to the caller the element it had
removed. But knowing that element is necessary to free its memory, so one
had to first get that element before it was removed from the tree.
This change updates the main deletion function delete_treap and its public
wrapper gfc_delete_bbt so that the removed element can be known by the
caller. This makes the preliminary walk in gfc_delete_symtree redundant,
permitting its removal.
gcc/fortran/ChangeLog:
* bbt.cc (delete_treap): Add argument REMOVED, set it to the removed
element from the tree. Change NULL to nullptr.
(gfc_delete_bbt): Return the removed element from the tree.
* gfortran.h (gfc_delete_symtree): Remove prototype.
(gfc_delete_bbt): Set return type to pointer.
* symbol.cc (gfc_delete_symtree): Make static. Get the element to be
freed from the result of gfc_delete_bbt. Remove the preliminary walk to
get it.
---
gcc/fortran/bbt.cc | 41 +
gcc/fortran/gfortran.h | 3 +--
gcc/fortran/symbol.cc | 6 ++
3 files changed, 32 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/bbt.cc b/gcc/fortran/bbt.cc
index 851e5e92c7b..7f1f4067fbd 100644
--- a/gcc/fortran/bbt.cc
+++ b/gcc/fortran/bbt.cc
@@ -162,37 +162,54 @@ delete_root (gfc_bbt *t)
}
-/* Delete an element from a tree. The 'old' value does not
- necessarily have to point to the element to be deleted, it must
- just point to a treap structure with the key to be deleted.
- Returns the new root node of the tree. */
+/* Delete an element from a tree, returning the new root node of the tree.
+ The OLD value does not necessarily have to point to the element to be
+ deleted, it must just point to a treap structure with the key to be deleted.
+ The REMOVED argument, if non-null, is set to the removed element from the
+ tree upon return. */
static gfc_bbt *
-delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare)
+delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare, gfc_bbt **removed)
{
int c;
- if (t == NULL)
-return NULL;
+ if (t == nullptr)
+{
+ if (removed)
+ *removed = nullptr;
+ return nullptr;
+}
c = (*compare) (old, t);
if (c < 0)
-t->left = delete_treap (old, t->left, compare);
+t->left = delete_treap (old, t->left, compare, removed);
if (c > 0)
-t->right = delete_treap (old, t->right, compare);
+t->right = delete_treap (old, t->right, compare, removed);
if (c == 0)
-t = delete_root (t);
+{
+ if (removed)
+ *removed = t;
+ t = delete_root (t);
+}
return t;
}
-void
+/* Delete the element from the tree at *ROOT that matches the OLD element
+ according to the COMPARE_FN function. This updates the *ROOT pointer to
+ point to the new tree root (if different from the original) and returns the
+ deleted element. */
+
+void *
gfc_delete_bbt (void *root, void *old, compare_fn compare)
{
gfc_bbt **t;
+ gfc_bbt *removed;
t = (gfc_bbt **) root;
- *t = delete_treap ((gfc_bbt *) old, *t, compare);
+ *t = delete_treap ((gfc_bbt *) old, *t, compare, );
+
+ return (void *) removed;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b37c6bb9ad4..371f8743312 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3510,7 +3510,6 @@ bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
-void gfc_delete_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
@@ -3911,7 +3910,7 @@ bool gfc_inline_intrinsic_function_p (gfc_expr *);
/* bbt.cc */
typedef int (*compare_fn) (void *, void *);
void gfc_insert_bbt (void *, void *, compare_fn);
-void gfc_delete_bbt (void *, void *, compare_fn);
+void * gfc_delete_bbt (void *, void *, compare
[PATCH] fortran: Remove redundant tree walk to delete element
Hello,
this avoids some redundant work in the symbol deletion code, which is
used a lot by the parser to cancel statements that fail to match in the
end.
I haven't tried to measure the performance effect, if any, on a pathological
example;
just passed the fortran testsuite on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Remove preliminary walk of the symbol tree when we are about to remove an
element. This preliminary walk was necessary because the deletion function
updated the tree without reporting back to the caller the element it had
removed. But knowing that element is necessary to free its memory, so one
had to first get that element before it was removed from the tree.
This change updates the main deletion function delete_treap and its public
wrapper gfc_delete_bbt so that the removed element can be known by the
caller. This makes the preliminary walk in gfc_delete_symtree redundant,
permitting its removal.
gcc/fortran/ChangeLog:
* bbt.cc (delete_treap): Add argument REMOVED, set it to the removed
element from the tree. Change NULL to nullptr.
(gfc_delete_bbt): Return the removed element from the tree.
* gfortran.h (gfc_delete_symtree): Remove prototype.
(gfc_delete_bbt): Set return type to pointer.
* symbol.cc (gfc_delete_symtree): Make static. Get the element to be
freed from the result of gfc_delete_bbt. Remove the preliminary walk to
get it.
---
gcc/fortran/bbt.cc | 27 +++
gcc/fortran/gfortran.h | 3 +--
gcc/fortran/symbol.cc | 6 ++
3 files changed, 22 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/bbt.cc b/gcc/fortran/bbt.cc
index 851e5e92c7b..2a032083c5c 100644
--- a/gcc/fortran/bbt.cc
+++ b/gcc/fortran/bbt.cc
@@ -168,31 +168,42 @@ delete_root (gfc_bbt *t)
Returns the new root node of the tree. */
static gfc_bbt *
-delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare)
+delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare, gfc_bbt **removed)
{
int c;
- if (t == NULL)
-return NULL;
+ if (t == nullptr)
+{
+ if (removed)
+ *removed = nullptr;
+ return nullptr;
+}
c = (*compare) (old, t);
if (c < 0)
-t->left = delete_treap (old, t->left, compare);
+t->left = delete_treap (old, t->left, compare, removed);
if (c > 0)
-t->right = delete_treap (old, t->right, compare);
+t->right = delete_treap (old, t->right, compare, removed);
if (c == 0)
-t = delete_root (t);
+{
+ if (removed)
+ *removed = t;
+ t = delete_root (t);
+}
return t;
}
-void
+void *
gfc_delete_bbt (void *root, void *old, compare_fn compare)
{
gfc_bbt **t;
+ gfc_bbt *removed;
t = (gfc_bbt **) root;
- *t = delete_treap ((gfc_bbt *) old, *t, compare);
+ *t = delete_treap ((gfc_bbt *) old, *t, compare, );
+
+ return (void *) removed;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b37c6bb9ad4..371f8743312 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3510,7 +3510,6 @@ bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
-void gfc_delete_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
gfc_user_op *gfc_get_uop (const char *);
gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
@@ -3911,7 +3910,7 @@ bool gfc_inline_intrinsic_function_p (gfc_expr *);
/* bbt.cc */
typedef int (*compare_fn) (void *, void *);
void gfc_insert_bbt (void *, void *, compare_fn);
-void gfc_delete_bbt (void *, void *, compare_fn);
+void * gfc_delete_bbt (void *, void *, compare_fn);
/* dump-parse-tree.cc */
void gfc_dump_parse_tree (gfc_namespace *, FILE *);
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index aa3cdc98c86..2cba2ea0bed 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -2948,7 +2948,7 @@ gfc_new_symtree (gfc_symtree **root, const char *name)
/* Delete a symbol from the tree. Does not free the symbol itself! */
-void
+static void
gfc_delete_symtree (gfc_symtree **root, const char *name)
{
gfc_symtree st, *st0;
@@ -2963,10 +2963,8 @@ gfc_delete_symtree (gfc_symtree **root, const char *name)
else
p = name;
- st0 = gfc_find_symtree (*root, p);
-
st.name = gfc_get_string ("%s", p);
- gfc_delete_bbt (root, , compare_symtree);
+ st0 = (gfc_symtree *) gfc_delete_bbt (root, , compare_symtree);
free (st0);
}
--
2.40.1
Re: [PATCH] Fortran: runtime bounds-checking in presence of array constructors [PR31059]
Le 01/09/2023 à 22:48, Harald Anlauf a écrit : Hi Mikael, On 9/1/23 10:41, Mikael Morin via Gcc-patches wrote: May I suggest to handle functions the same way? I'll have a look at them, but will need to gather a few suitable testcases first. I have just opened PR111339 (https://gcc.gnu.org/bugzilla/show_bug.cgi?id=111339) to track the case of functions separately.
[PATCH] diagnostics: Delete config pointer before overwriting it.
Hello, this is a fix for a small memory leak in the fortran frontend. Tested on x86_64-pc-linux-gnu, nothing stands out besides the apparently well-known guality instability. OK for master ? -- >8 -- Delete m_client_data_hooks before it is reassigned in tree_diagnostics_defaults. This fixes a small memory leak in the fortran frontend, which restores the diagnostics configurations to their default values with a call to tree_diagnostics_defaults at the end of the main parse hook. gcc/ChangeLog: * tree-diagnostic.cc (tree_diagnostics_defaults): Delete allocated pointer before overwriting it. --- gcc/tree-diagnostic.cc | 1 + 1 file changed, 1 insertion(+) diff --git a/gcc/tree-diagnostic.cc b/gcc/tree-diagnostic.cc index 731e3559cd8..d2f6637b6d9 100644 --- a/gcc/tree-diagnostic.cc +++ b/gcc/tree-diagnostic.cc @@ -377,5 +377,6 @@ tree_diagnostics_defaults (diagnostic_context *context) context->print_path = default_tree_diagnostic_path_printer; context->make_json_for_path = default_tree_make_json_for_path; context->set_locations_cb = set_inlining_locations; + delete context->m_client_data_hooks; context->m_client_data_hooks = make_compiler_data_hooks (); } -- 2.40.1
Re: [PATCH] Fortran: runtime bounds-checking in presence of array constructors [PR31059]
Le 31/08/2023 à 22:42, Harald Anlauf via Fortran a écrit : Dear all, gfortran's array bounds-checking code does a mostly reasonable job for array sections in expressions and assignments, but forgot the case that (rank-1) expressions can involve array constructors, which have a shape ;-) The attached patch walks over the loops generated by the scalarizer, checks for the presence of a constructor, and takes the first shape found as reference. (If several constructors are present, discrepancies in their shape seems to be already detected at compile time). For more details on what will be caught now see testcase. Regtested on x86_64-pc-linux-gnu. OK for mainline? This is OK. May I suggest to handle functions the same way? Thanks. Thanks, Harald
Re: [PATCH] fortran: Restore interface to its previous state on error [PR48776]
Le 28/08/2023 à 21:17, Harald Anlauf via Fortran a écrit :
Hi Mikael,
On 8/27/23 21:22, Mikael Morin via Gcc-patches wrote:
Hello,
this fixes an old error-recovery bug.
Tested on x86_64-pc-linux-gnu.
OK for master?
I have only a minor comment:
+/* Free the leading members of the gfc_interface linked list given in
INTR
+ up to the END element (exclusive: the END element is not freed).
+ If END is not nullptr, it is assumed that END is in the linked
list starting
+ with INTR. */
+
+static void
+free_interface_elements_until (gfc_interface *intr, gfc_interface *end)
+{
+ gfc_interface *next;
+
+ for (; intr != end; intr = next)
Would it make sense to add a protection for intr == NULL, i.e.:
+ for (; intr && intr != end; intr = next)
Just to prevent a NULL pointer dereference in case there
is a corruption of the chain or something else went wrong.
This would happen in the case END is not a member of the INTR linked
list. In that case, the most forgiving would be not freeing any memory
and just returning. But it would require walking the list a second time
to determine before proceeding if END is present, and let's not do work
that is expected to be useless.
I will just do the change as you suggest it.
Otherwise it looks good to me.
It appears that your patch similarly fixes PR107923. :-)
Good news. :-)
I will double check that none of the testcases there remain unfixed and
close as duplicate.
I don't know how you manage to make your way through the hundreds of
open PRs by the way.
Thanks for the review.
Thanks for the patch!
Harald
[PATCH] fortran: Restore interface to its previous state on error [PR48776]
Hello,
this fixes an old error-recovery bug.
Tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Keep memory of the content of the current interface body being parsed
and restore it to its previous state if it has been modified at the time
a parse attempt fails.
This fixes memory errors and random segmentation faults caused by
dangling symbol pointers kept in interfaces' linked lists of symbols.
If a parsing attempt fails and symbols are freed, they should also be
removed from the current interface linked list.
As the list of symbol is a linked list, and parsing only adds new
symbols to the head of the list, all that is needed to track the
previous content of the list is a pointer to its previous head.
This adds such a pointer, and the restoration of the list of symbols
to that pointer on error.
PR fortran/48776
gcc/fortran/ChangeLog:
* gfortran.h (gfc_drop_interface_elements_before): New prototype.
(gfc_current_interface_head): Return a reference to the pointer.
* interface.cc (gfc_current_interface_head): Ditto.
(free_interface_elements_until): New function, generalizing
gfc_free_interface.
(gfc_free_interface): Use free_interface_elements_until.
(gfc_drop_interface_elements_before): New function.
* parse.cc
(current_interface_ptr, previous_interface_head): New static variables.
(current_interface_valid_p, get_current_interface_ptr): New functions.
(decode_statement): Initialize previous_interface_head.
(reject_statement): Restore current interface pointer to point to
previous_interface_head.
gcc/testsuite/ChangeLog:
* gfortran.dg/interface_procedure_1.f90: New test.
---
gcc/fortran/gfortran.h| 3 +-
gcc/fortran/interface.cc | 43 ---
gcc/fortran/parse.cc | 54 +++
.../gfortran.dg/interface_procedure_1.f90 | 23
4 files changed, 115 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/interface_procedure_1.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fd47000a88e..0fabe7badde 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3824,6 +3824,7 @@ bool gfc_ref_dimen_size (gfc_array_ref *, int dimen,
mpz_t *, mpz_t *);
/* interface.cc -- FIXME: some of these should be in symbol.cc */
void gfc_free_interface (gfc_interface *);
+void gfc_drop_interface_elements_before (gfc_interface **, gfc_interface *);
bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
bool gfc_compare_types (gfc_typespec *, gfc_typespec *);
bool gfc_check_dummy_characteristics (gfc_symbol *, gfc_symbol *,
@@ -3843,7 +3844,7 @@ void gfc_free_formal_arglist (gfc_formal_arglist *);
bool gfc_extend_assign (gfc_code *, gfc_namespace *);
bool gfc_check_new_interface (gfc_interface *, gfc_symbol *, locus);
bool gfc_add_interface (gfc_symbol *);
-gfc_interface *gfc_current_interface_head (void);
+gfc_interface *_current_interface_head (void);
void gfc_set_current_interface_head (gfc_interface *);
gfc_symtree* gfc_find_sym_in_symtree (gfc_symbol*);
bool gfc_arglist_matches_symbol (gfc_actual_arglist**, gfc_symbol*);
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index ea82056e9e3..c01df0460d7 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -78,18 +78,47 @@ along with GCC; see the file COPYING3. If not see
gfc_interface_info current_interface;
+/* Free the leading members of the gfc_interface linked list given in INTR
+ up to the END element (exclusive: the END element is not freed).
+ If END is not nullptr, it is assumed that END is in the linked list starting
+ with INTR. */
+
+static void
+free_interface_elements_until (gfc_interface *intr, gfc_interface *end)
+{
+ gfc_interface *next;
+
+ for (; intr != end; intr = next)
+{
+ next = intr->next;
+ free (intr);
+}
+}
+
+
/* Free a singly linked list of gfc_interface structures. */
void
gfc_free_interface (gfc_interface *intr)
{
- gfc_interface *next;
+ free_interface_elements_until (intr, nullptr);
+}
- for (; intr; intr = next)
-{
- next = intr->next;
- free (intr);
-}
+
+/* Update the interface pointer given by IFC_PTR to make it point to TAIL.
+ It is expected that TAIL (if non-null) is in the list pointed to by
+ IFC_PTR, hence the tail of it. The members of the list before TAIL are
+ freed before the pointer reassignment. */
+
+void
+gfc_drop_interface_elements_before (gfc_interface **ifc_ptr,
+ gfc_interface *tail)
+{
+ if (ifc_ptr == nullptr)
+return;
+
+ free_interface_elements_until (*ifc_ptr, tail);
+ *ifc_ptr = tail;
}
@@ -4953,7 +4982,7 @@ gfc_add_interface (gfc_symbol *new_sym)
}
-gfc_interface *
+gfc_interface *&
gfc_current_interface_head (void)
{
switch (current_interface.type)
diff
[PATCH] dg-cmp-results: Escape slash from variant argument
Hello, I ran into a bug recently, running dg-cmp-results.sh with variant unix/-m32. This fixes it. OK for master? -- >8 -- Escape slash characters in $header variable (coming from the variant argument). This avoids runs with say "unix/-m32" as variant resulting in sed errors "unknown command: -". contrib/ChangeLog: * dg-cmp-results.sh: Escape slashes in $header to a new variable. Use the new variable in sed command. --- contrib/dg-cmp-results.sh | 7 +-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/contrib/dg-cmp-results.sh b/contrib/dg-cmp-results.sh index 33e0605dc50..7d17772dc75 100755 --- a/contrib/dg-cmp-results.sh +++ b/contrib/dg-cmp-results.sh @@ -90,8 +90,11 @@ sed $E -e '/^[[:space:]]+===/,$d' $OFILE echo "Newer log file: $NFILE" sed $E -e '/^[[:space:]]+===/,$d' $NFILE +# Escape occurences of / in $header before passing through sed. +header_pattern=`echo "$header" | sed $E -e 's:/:[/]:g'` + # Create a temporary file from the old file's interesting section. -sed $E -e "/$header/,/^[[:space:]]+===.*Summary ===/!d" \ +sed $E -e "/$header_pattern/,/^[[:space:]]+===.*Summary ===/!d" \ -e '/^[A-Z]+:/!d' \ -e '/^(WARNING|ERROR):/d' \ -e 's/\r$//' \ @@ -101,7 +104,7 @@ sed $E -e "/$header/,/^[[:space:]]+===.*Summary ===/!d" \ >$TMPDIR/o$$-$OBASE # Create a temporary file from the new file's interesting section. -sed $E -e "/$header/,/^[[:space:]]+===.*Summary ===/!d" \ +sed $E -e "/$header_pattern/,/^[[:space:]]+===.*Summary ===/!d" \ -e '/^[A-Z]+:/!d' \ -e '/^(WARNING|ERROR):/d' \ -e 's/\r$//' \ -- 2.40.1
[PATCH 3/3] testsuite: Use distinct explicit error codes in value_9.f90
Use distinct error codes, so that we can spot directly from the
testsuite log which case is failing.
gcc/testsuite/ChangeLog:
* gfortran.dg/value_9.f90 (val, val4, sub, sub4): Take the error
codes from the arguments.
(p): Update calls: pass explicit distinct error codes.
---
gcc/testsuite/gfortran.dg/value_9.f90 | 108 +-
1 file changed, 56 insertions(+), 52 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/value_9.f90
b/gcc/testsuite/gfortran.dg/value_9.f90
index 1a2fa80ed0d..4813250ebaa 100644
--- a/gcc/testsuite/gfortran.dg/value_9.f90
+++ b/gcc/testsuite/gfortran.dg/value_9.f90
@@ -20,78 +20,82 @@ program p
! Check len=1 actual argument cases first
ca = "a"; cp = "b"; cd = "c"
ca4 = 4_"d"; cp4 = 4_"e"; cd4 = 4_"f"
- call val ("B","B")
- call val ("A",char(65))
- call val ("A",char(a))
- call val ("A",mychar(65))
- call val ("A",mychar(a))
- call val ("1",c)
- call val ("1",(c))
- call val4 (4_"C",4_"C")
- call val4 (4_"A",char(65,kind=4))
- call val4 (4_"A",char(a, kind=4))
- call val4 (4_"4",c4)
- call val4 (4_"4",(c4))
- call val (ca,ca)
- call val (cp,cp)
- call val (cd,cd)
- call val (ca,(ca))
- call val4 (ca4,ca4)
- call val4 (cp4,cp4)
- call val4 (cd4,cd4)
- call val4 (cd4,(cd4))
- call sub ("S")
- call sub4 (4_"T")
+ call val ("B","B", 1, 2)
+ call val ("A",char(65), 3, 4)
+ call val ("A",char(a), 5, 6)
+ call val ("A",mychar(65), 7, 8)
+ call val ("A",mychar(a), 9, 10)
+ call val ("1",c, 11, 12)
+ call val ("1",(c), 13, 14)
+ call val4 (4_"C",4_"C", 15, 16)
+ call val4 (4_"A",char(65,kind=4), 17, 18)
+ call val4 (4_"A",char(a, kind=4), 19, 20)
+ call val4 (4_"4",c4, 21, 22)
+ call val4 (4_"4",(c4), 23, 24)
+ call val (ca,ca, 25, 26)
+ call val (cp,cp, 27, 28)
+ call val (cd,cd, 29, 30)
+ call val (ca,(ca), 31, 32)
+ call val4 (ca4,ca4, 33, 34)
+ call val4 (cp4,cp4, 35, 36)
+ call val4 (cd4,cd4, 37, 38)
+ call val4 (cd4,(cd4), 39, 40)
+ call sub ("S", 41, 42)
+ call sub4 (4_"T", 43, 44)
! Check that always the first character of the string is finally used
- call val ( "U++", "U--")
- call val4 (4_"V**",4_"V//")
- call sub ( "WTY")
- call sub4 (4_"ZXV")
- call val ( "234", d)
- call val4 (4_"345", d4 )
- call val ( "234", (d) )
- call val4 (4_"345", (d4) )
- call val ( "234", d (1:2))
- call val4 (4_"345", d4(1:2))
- call val ( "234", d (1:l))
- call val4 (4_"345", d4(1:l))
- call val ("1",c // d)
- call val ("1",trim (c // d))
- call val4 (4_"4",c4 // d4)
- call val4 (4_"4",trim (c4 // d4))
+ call val ( "U++", "U--", 45, 46)
+ call val4 (4_"V**",4_"V//", 47, 48)
+ call sub ( "WTY", 49, 50)
+ call sub4 (4_"ZXV", 51, 52)
+ call val ( "234", d, 53, 54)
+ call val4 (4_"345", d4 , 55, 56)
+ call val ( "234", (d) , 57, 58)
+ call val4 (4_"345", (d4) , 59, 60)
+ call val ( "234", d (1:2), 61, 62)
+ call val4 (4_"345", d4(1:2), 63, 64)
+ call val ( "234", d (1:l), 65, 66)
+ call val4 (4_"345", d4(1:l), 67, 68)
+ call val ("1",c // d, 69, 70)
+ call val ("1",trim (c // d), 71, 72)
+ call val4 (4_"4",c4 // d4, 73, 74)
+ call val4 (4_"4",trim (c4 // d4), 75, 76)
cd = "gkl"; cd4 = 4_"hmn"
- call val (cd,cd)
- call val4 (cd4,cd4)
- call sub (cd)
- call sub4 (cd4)
+ call val (cd,cd, 77, 78)
+ call val4 (cd4,cd4, 79, 80)
+ call sub (cd, 81, 82)
+ call sub4 (cd4, 83, 84)
deallocate (ca, cp, ca4, cp4, cd, cd4)
contains
- subroutine val (x, c)
+ subroutine val (x, c, err1, err2)
character(kind=1), intent(in) :: x ! control: pass by reference
character(kind=1), value :: c
+integer, intent(in) :: err1, err2
print *, "by value(kind=1): ", c
-if (c /= x) stop 1
+if (c /= x) stop err1
c = "*"
-if (c /= "*") stop 2
+if (c /= "*") stop err2
end
- subroutine val4 (x, c)
+ subroutine val4 (x, c, err1, err2)
character(kind=4), intent(in) :: x ! control: pass by reference
character(kind=4), value :: c
+integer, intent(in) :: err1, err2
print *, "by value(kind=4): ", c
-if (c /= x) stop 3
+if (c /= x) stop err1
c = 4_"#"
-if (c /= 4_"#") stop 4
+if (c /= 4_"#") stop err2
end
- subroutine sub (s)
+ subroutine sub (s, err1, err2)
character(*), intent(in) :: s
-call val (s, s)
+integer, intent(in) :: err1, err2
+call val (s, s, err1, err2)
end
- subroutine sub4 (s)
+ subroutine sub4 (s, err1, err2)
character(kind=4,len=*), intent(in) :: s
-call val4 (s, s)
+integer, intent(in) :: err1, err2
+call val4 (s, s, err1, err2)
end
character function mychar (i)
--
2.40.1
[PATCH 1/3] fortran: New predicate gfc_length_one_character_type_p
Introduce a new predicate to simplify conditionals checking for
a character type whose length is the constant one.
gcc/fortran/ChangeLog:
* gfortran.h (gfc_length_one_character_type_p): New inline
function.
* check.cc (is_c_interoperable): Use
gfc_length_one_character_type_p.
* decl.cc (verify_bind_c_sym): Same.
* trans-expr.cc (gfc_conv_procedure_call): Same.
---
gcc/fortran/check.cc | 7 +++
gcc/fortran/decl.cc | 4 +---
gcc/fortran/gfortran.h| 15 +++
gcc/fortran/trans-expr.cc | 8 ++--
4 files changed, 21 insertions(+), 13 deletions(-)
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 4086dc71d34..6c45e6542f0 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -5250,10 +5250,9 @@ is_c_interoperable (gfc_expr *expr, const char **msg,
bool c_loc, bool c_f_ptr)
&& !gfc_simplify_expr (expr->ts.u.cl->length, 0))
gfc_internal_error ("is_c_interoperable(): gfc_simplify_expr failed");
-if (!c_loc && expr->ts.u.cl
- && (!expr->ts.u.cl->length
- || expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (expr->ts.u.cl->length->value.integer, 1) != 0))
+if (!c_loc
+ && expr->ts.u.cl
+ && !gfc_length_one_character_type_p (>ts))
{
*msg = "Type shall have a character length of 1";
return false;
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 844345df77e..8182ef29f43 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -6064,9 +6064,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
/* BIND(C) functions cannot return a character string. */
if (bind_c_function && tmp_sym->ts.type == BT_CHARACTER)
- if (tmp_sym->ts.u.cl == NULL || tmp_sym->ts.u.cl->length == NULL
- || tmp_sym->ts.u.cl->length->expr_type != EXPR_CONSTANT
- || mpz_cmp_si (tmp_sym->ts.u.cl->length->value.integer, 1) != 0)
+ if (!gfc_length_one_character_type_p (_sym->ts))
gfc_error ("Return type of BIND(C) function %qs of character "
"type at %L must have length 1", tmp_sym->name,
&(tmp_sym->declared_at));
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6482a885211..d44e5286626 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3181,6 +3181,21 @@ gfc_finalizer;
/ Function prototypes */
+
+/* Returns true if the type specified in TS is a character type whose length
+ is the constant one. Otherwise returns false. */
+
+inline bool
+gfc_length_one_character_type_p (gfc_typespec *ts)
+{
+ return ts->type == BT_CHARACTER
+&& ts->u.cl
+&& ts->u.cl->length
+&& ts->u.cl->length->expr_type == EXPR_CONSTANT
+&& ts->u.cl->length->ts.type == BT_INTEGER
+&& mpz_cmp_ui (ts->u.cl->length->value.integer, 1) == 0;
+}
+
/* decl.cc */
bool gfc_in_match_data (void);
match gfc_match_char_spec (gfc_typespec *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ef3e6d08f78..6da3975f77c 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6453,12 +6453,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
dummy arguments are actually passed by value.
Strings are truncated to length 1.
The BIND(C) case is handled elsewhere. */
- if (fsym->ts.type == BT_CHARACTER
- && !fsym->ts.is_c_interop
- && fsym->ts.u.cl->length->expr_type == EXPR_CONSTANT
- && fsym->ts.u.cl->length->ts.type == BT_INTEGER
- && (mpz_cmp_ui
- (fsym->ts.u.cl->length->value.integer, 1) == 0))
+ if (!fsym->ts.is_c_interop
+ && gfc_length_one_character_type_p (>ts))
{
if (e->expr_type != EXPR_CONSTANT)
{
--
2.40.1
[PATCH 2/3] fortran: Fix length one character dummy arg type [PR110419]
Revision r14-2171-g8736d6b14a4dfdfb58c80ccd398981b0fb5d00aa
changed the argument passing convention for length 1 value dummy
arguments to pass just the single character by value. However, the
procedure declarations weren't updated to reflect the change in the
argument types.
This change does the missing argument type update.
The change of argument types generated an internal error in
gfc_conv_string_parameter with value_9.f90. Indeed, that function is
not prepared for bare character type, so it is updated as well.
The condition guarding the single character argument passing code
is loosened to not exclude non-interoperable kind (this fixes
a regression with c_char_tests_2.f03).
Finally, the constant string argument passing code is updated as well
to extract the single char and pass it instead of passing it as
a length one string. As the code taking care of non-constant arguments
was already doing this, the condition guarding it is just removed.
With these changes, value_9.f90 passes on 32 bits big-endian powerpc.
PR fortran/110360
PR fortran/110419
gcc/fortran/ChangeLog:
* trans-types.cc (gfc_sym_type): Use a bare character type for length
one value character dummy arguments.
* trans-expr.cc (gfc_conv_string_parameter): Handle single character
case.
(gfc_conv_procedure_call): Don't exclude interoperable kinds
from single character handling. For single character dummy arguments,
extend the existing handling of non-constant expressions to constant
expressions.
gcc/testsuite/ChangeLog:
* gfortran.dg/bind_c_usage_13.f03: Update tree dump patterns.
---
gcc/fortran/trans-expr.cc | 35 +++
gcc/fortran/trans-types.cc| 5 ++-
gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 8 ++---
3 files changed, 28 insertions(+), 20 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6da3975f77c..d91cc9da221 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6451,26 +6451,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
/* ABI: actual arguments to CHARACTER(len=1),VALUE
dummy arguments are actually passed by value.
- Strings are truncated to length 1.
- The BIND(C) case is handled elsewhere. */
- if (!fsym->ts.is_c_interop
- && gfc_length_one_character_type_p (>ts))
+ Strings are truncated to length 1. */
+ if (gfc_length_one_character_type_p (>ts))
{
- if (e->expr_type != EXPR_CONSTANT)
- {
- tree slen1 = build_int_cst (gfc_charlen_type_node,
1);
- gfc_conv_string_parameter ();
- parmse.expr = gfc_string_to_single_character (slen1,
-
parmse.expr,
-
e->ts.kind);
- /* Truncate resulting string to length 1. */
- parmse.string_length = slen1;
- }
- else if (e->value.character.length > 1)
+ if (e->expr_type == EXPR_CONSTANT
+ && e->value.character.length > 1)
{
e->value.character.length = 1;
gfc_conv_expr (, e);
}
+
+ tree slen1 = build_int_cst (gfc_charlen_type_node, 1);
+ gfc_conv_string_parameter ();
+ parmse.expr
+ = gfc_string_to_single_character (slen1,
+ parmse.expr,
+ e->ts.kind);
+ /* Truncate resulting string to length 1. */
+ parmse.string_length = slen1;
}
if (fsym->attr.optional
@@ -10610,6 +10608,13 @@ gfc_conv_string_parameter (gfc_se * se)
{
tree type;
+ if (TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE
+ && integer_onep (se->string_length))
+{
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
+ return;
+}
+
if (TREE_CODE (se->expr) == STRING_CST)
{
type = TREE_TYPE (TREE_TYPE (se->expr));
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index 987e3d26c46..084b8c3ae2c 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2313,7 +2313,10 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
&& sym->ns->proc_name
&& sym->ns->proc_name->attr.is_bind_c)
||
[PATCH 0/3] fortran: fix length one character dummy args [PR110419]
Hello, I propose with this patchset a fix for the test value_9.f90 which has been failing on 32 bits powerpc since it was added a few weeks back (see PR110360 and PR110419). The problem is an argument type mismatch between a procedure declaration, and the argument value for a call of that same procedure, in the specific case of length one character dummy arguments with the value attribute. Admittedly, our argument passing conventions [1] for those are currently unspecified. Before PR110360, character dummy arguments with value attribute were arrays passed by value, but the actual argument was still passed as reference. PR110360 changed that to pass length one dummies as bare character (i.e. scalar integer), like in the bind(c) case (but with length argument still present). However, the argument type in the function declaration wasn't changed at the same time, so the test was failing on big-endian 32 bits targets. Surprisingly, on most targets the middle-end, back-end and runtime are happy to get a scalar value passed where a length one array is expected. This can be fixed, either by reverting back to arguments represented as arrays passed by value with calls fixed, or by keeping the new representation with single characters for arguments and fixing the procedure types accordingly. I haven't really tried the first way, this is using the second one. The first patch is a preliminary refactoring. The main change is the second patch. It modifies the types of length one character dummy argsuments with value attribute in the procedure declarations, so that they are scalar integer types, consistently with how arguments are passed for calls. The third patch is a change of error codes in the testcase. I have regression tested this on x86_64-unknown-linux-gnu, and powerpc64-unknown-linux-gnu (both -m32 and -m64). OK for master? [1] https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html Mikael Morin (3): fortran: New predicate gfc_length_one_character_type_p fortran: Fix length one character dummy arg type [PR110419] testsuite: Use distinct explicit error codes in value_9.f90 gcc/fortran/check.cc | 7 +- gcc/fortran/decl.cc | 4 +- gcc/fortran/gfortran.h| 15 +++ gcc/fortran/trans-expr.cc | 39 --- gcc/fortran/trans-types.cc| 5 +- gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 8 +- gcc/testsuite/gfortran.dg/value_9.f90 | 108 +- 7 files changed, 103 insertions(+), 83 deletions(-) -- 2.40.1
[PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618]
Pass already evaluated class container argument from
gfc_conv_procedure_call down to gfc_add_finalizer_call through
gfc_deallocate_scalar_with_status and gfc_deallocate_with_status,
to avoid repeatedly evaluating the same data reference expressions
in the generated code.
PR fortran/110618
gcc/fortran/ChangeLog:
* trans.h (gfc_deallocate_with_status): Add class container
argument.
(gfc_deallocate_scalar_with_status): Ditto.
* trans.cc (gfc_deallocate_with_status): Add class container
argument and pass it down to gfc_add_finalize_call.
(gfc_deallocate_scalar_with_status): Same.
* trans-array.cc (structure_alloc_comps): Update caller.
* trans-stmt.cc (gfc_trans_deallocate): Ditto.
* trans-expr.cc (gfc_conv_procedure_call): Ditto. Pass
pre-evaluated class container argument if it's available.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_22.f90: New test.
---
gcc/fortran/trans-array.cc | 2 +-
gcc/fortran/trans-expr.cc | 7 ++--
gcc/fortran/trans-stmt.cc | 3 +-
gcc/fortran/trans.cc| 11 +++---
gcc/fortran/trans.h | 7 ++--
gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +
6 files changed, 55 insertions(+), 12 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1c2af55d436..951cecfa5d5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9472,7 +9472,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE,
NULL_TREE, NULL_TREE, true,
- NULL, caf_dereg_mode,
+ NULL, caf_dereg_mode, NULL_TREE,
add_when_allocated, caf_token);
gfc_add_expr_to_block (, tmp);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dbb04f8c434..8258543b456 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6706,9 +6706,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (e->ts.type == BT_CLASS)
ptr = gfc_class_data_get (ptr);
+ tree cls = parmse.class_container;
tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE,
NULL_TREE, true,
- e, e->ts);
+ e, e->ts, cls);
gfc_add_expr_to_block (, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
void_type_node, ptr,
@@ -6900,10 +6901,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
ptr = parmse.expr;
ptr = gfc_class_data_get (ptr);
+ tree cls = parmse.class_container;
tmp = gfc_deallocate_with_status (ptr, NULL_TREE,
NULL_TREE, NULL_TREE,
NULL_TREE, true, e,
- GFC_CAF_COARRAY_NOCOARRAY);
+ GFC_CAF_COARRAY_NOCOARRAY,
+ cls);
gfc_add_expr_to_block (, tmp);
tmp = fold_build2_loc (input_location, MODIFY_EXPR,
void_type_node, ptr,
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 7e768343a57..93f36bfb955 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7462,7 +7462,8 @@ gfc_trans_deallocate (gfc_code *code)
{
tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish,
false, al->expr,
- al->expr->ts, is_coarray);
+ al->expr->ts, NULL_TREE,
+ is_coarray);
gfc_add_expr_to_block (, tmp);
/* Set to zero after deallocation. */
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 18965b9cbd2..569fad45031 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1777,8 +1777,8 @@ tree
gfc_deallocate_with_status (tree pointer, tree status, tree errmsg,
tree errlen, tree label_finish,
bool can_fail, gfc_expr* expr,
- int
[PATCH 13/14] fortran: Use pre-evaluated class container if available [PR110618]
Add the possibility to provide a pre-evaluated class container argument
to gfc_add_finalizer to avoid repeatedly evaluating data reference
expressions in the generated code.
PR fortran/110618
gcc/fortran/ChangeLog:
* trans.h (gfc_add_finalizer_call): Add class container argument.
* trans.cc (gfc_add_finalizer_call): Ditto. Pass down new
argument to get_final_proc_ref, get_elem_size, get_var_desc,
and get_vptr.
(get_elem_size): Add class container argument.
Use provided class container if it's available.
(get_var_descr): Same.
(get_vptr): Same.
(get_final_proc_ref): Same. Add boolean telling the class
container argument is used. Set it. Don't try to use
final_wrapper if class container argument was used.
---
gcc/fortran/trans.cc | 61 +---
gcc/fortran/trans.h | 2 +-
2 files changed, 41 insertions(+), 22 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 69e9329c9cb..18965b9cbd2 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1089,14 +1089,20 @@ gfc_call_free (tree var)
with the expression passed as argument in EXPR. */
static void
-get_final_proc_ref (gfc_se *se, gfc_expr *expr)
+get_final_proc_ref (gfc_se *se, gfc_expr *expr, tree class_container)
{
gfc_expr *final_wrapper = NULL;
gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
+ bool using_class_container = false;
if (expr->ts.type == BT_DERIVED)
gfc_is_finalizable (expr->ts.u.derived, _wrapper);
+ else if (class_container)
+{
+ using_class_container = true;
+ se->expr = gfc_class_vtab_final_get (class_container);
+}
else
{
final_wrapper = gfc_copy_expr (expr);
@@ -1104,9 +1110,12 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr)
gfc_add_final_component (final_wrapper);
}
- gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
+ if (!using_class_container)
+{
+ gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
- gfc_conv_expr (se, final_wrapper);
+ gfc_conv_expr (se, final_wrapper);
+}
if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
@@ -1117,7 +1126,7 @@ get_final_proc_ref (gfc_se *se, gfc_expr *expr)
passed as argument in EXPR. */
static void
-get_elem_size (gfc_se *se, gfc_expr *expr)
+get_elem_size (gfc_se *se, gfc_expr *expr, tree class_container)
{
gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
@@ -1127,6 +1136,8 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
se->expr = TYPE_SIZE_UNIT (se->expr);
se->expr = fold_convert (gfc_array_index_type, se->expr);
}
+ else if (class_container)
+se->expr = gfc_class_vtab_size_get (class_container);
else
{
gfc_expr *class_size = gfc_copy_expr (expr);
@@ -1143,7 +1154,7 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
expression passed as argument in VAR. */
static void
-get_var_descr (gfc_se *se, gfc_expr *var)
+get_var_descr (gfc_se *se, gfc_expr *var, tree class_container)
{
gfc_se tmp_se;
@@ -1165,6 +1176,8 @@ get_var_descr (gfc_se *se, gfc_expr *var)
// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
}
}
+ else if (class_container)
+tmp_se.expr = gfc_class_data_get (class_container);
else
{
gfc_expr *array_expr;
@@ -1212,20 +1225,25 @@ get_var_descr (gfc_se *se, gfc_expr *var)
static void
-get_vptr (gfc_se *se, gfc_expr *expr)
+get_vptr (gfc_se *se, gfc_expr *expr, tree class_container)
{
- gfc_expr *vptr_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (vptr_expr);
+ if (class_container)
+se->expr = gfc_class_vptr_get (class_container);
+ else
+{
+ gfc_expr *vptr_expr = gfc_copy_expr (expr);
+ gfc_add_vptr_component (vptr_expr);
- gfc_se tmp_se;
- gfc_init_se (_se, NULL);
- tmp_se.want_pointer = 1;
- gfc_conv_expr (_se, vptr_expr);
- gfc_free_expr (vptr_expr);
+ gfc_se tmp_se;
+ gfc_init_se (_se, NULL);
+ tmp_se.want_pointer = 1;
+ gfc_conv_expr (_se, vptr_expr);
+ gfc_free_expr (vptr_expr);
- gfc_add_block_to_block (>pre, _se.pre);
- gfc_add_block_to_block (>post, _se.post);
- se->expr = tmp_se.expr;
+ gfc_add_block_to_block (>pre, _se.pre);
+ gfc_add_block_to_block (>post, _se.post);
+ se->expr = tmp_se.expr;
+}
}
@@ -1329,7 +1347,8 @@ gfc_add_comp_finalizer_call (stmtblock_t *block, tree
decl, gfc_component *comp,
true when a finalizer call has been inserted. */
bool
-gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2)
+gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2,
+ tree class_container)
{
tree tmp;
gfc_ref *ref;
@@ -1384,17 +1403,17 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_se final_se;
[PATCH 09/14] fortran: Inline variable definition
The variable has_finalizer is only used in one place, inline its
definition there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Inline definition of
variable has_finalizer. Merge nested conditions.
---
gcc/fortran/trans.cc | 16 +++-
1 file changed, 7 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index c6a65c87c5c..99677d37da7 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1321,7 +1321,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tree tmp;
gfc_ref *ref;
gfc_expr *expr;
- bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
return false;
@@ -1361,13 +1360,11 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
ref->next = NULL;
}
- if (expr->ts.type == BT_CLASS)
-{
- has_finalizer = gfc_is_finalizable (expr->ts.u.derived, NULL);
-
- if (!expr2->rank && !expr2->ref && CLASS_DATA
(expr2->symtree->n.sym)->as)
- expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
-}
+ if (expr->ts.type == BT_CLASS
+ && !expr2->rank
+ && !expr2->ref
+ && CLASS_DATA (expr2->symtree->n.sym)->as)
+expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
stmtblock_t tmp_block;
gfc_start_block (_block);
@@ -1398,7 +1395,8 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tmp = gfc_finish_block (_block);
- if (expr->ts.type == BT_CLASS && !has_finalizer)
+ if (expr->ts.type == BT_CLASS
+ && !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
tree cond;
gfc_se se;
--
2.40.1
[PATCH 10/14] fortran: Remove redundant argument in get_var_descr
get_var_descr get passed as argument both expr and expr->ts.
Remove the type argument which can be retrieved from the other
argument.
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): Remove argument ts. Use var->ts
instead.
(gfc_add_finalizer_call): Update caller.
---
gcc/fortran/trans.cc | 9 -
1 file changed, 4 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 99677d37da7..bcf3341fd4b 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1140,11 +1140,10 @@ get_elem_size (gfc_se *se, gfc_expr *expr)
/* Generate the data reference (array) descriptor corresponding to the
- expression passed as argument in VAR. Use type in TS to pilot code
- generation. */
+ expression passed as argument in VAR. */
static void
-get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr *var)
+get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_se tmp_se;
symbol_attribute attr;
@@ -1153,7 +1152,7 @@ get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr
*var)
gfc_init_se (_se, NULL);
- if (ts->type == BT_DERIVED)
+ if (var->ts.type == BT_DERIVED)
{
tmp_se.want_pointer = 1;
if (var->rank)
@@ -1381,7 +1380,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_se desc_se;
gfc_init_se (_se, NULL);
- get_var_descr (_se, >ts, expr);
+ get_var_descr (_se, expr);
gfc_add_block_to_block (_block, _se.pre);
tmp = build_call_expr_loc (input_location, final_se.expr, 3,
--
2.40.1
[PATCH 08/14] fortran: Push final procedure expr gen close to its one usage.
Final procedure pointer expression is generated in gfc_build_final_call
and only used in get_final_proc_ref. Move the generation there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Remove local variable
final_expr. Pass down expr to get_final_proc_ref and move
final procedure expression generation down to its one usage
in get_final_proc_ref.
(get_final_proc_ref): Add argument expr. Remove argument
final_wrapper. Recreate final_wrapper from expr.
---
gcc/fortran/trans.cc | 37 -
1 file changed, 20 insertions(+), 17 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index e5ad67199e7..c6a65c87c5c 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1085,12 +1085,25 @@ gfc_call_free (tree var)
}
-/* Generate the data reference to the finalization procedure pointer passed as
- argument in FINAL_WRAPPER. */
+/* Generate the data reference to the finalization procedure pointer associated
+ with the expression passed as argument in EXPR. */
static void
-get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
+get_final_proc_ref (gfc_se *se, gfc_expr *expr)
{
+ gfc_expr *final_wrapper = NULL;
+
+ gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
+
+ if (expr->ts.type == BT_DERIVED)
+gfc_is_finalizable (expr->ts.u.derived, _wrapper);
+ else
+{
+ final_wrapper = gfc_copy_expr (expr);
+ gfc_add_vptr_component (final_wrapper);
+ gfc_add_final_component (final_wrapper);
+}
+
gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
gfc_conv_expr (se, final_wrapper);
@@ -1308,7 +1321,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
tree tmp;
gfc_ref *ref;
gfc_expr *expr;
- gfc_expr *final_expr = NULL;
bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
@@ -1322,12 +1334,9 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
&& expr2->ts.u.derived->attr.defined_assign_comp)
return false;
- if (expr2->ts.type == BT_DERIVED)
-{
- gfc_is_finalizable (expr2->ts.u.derived, _expr);
- if (!final_expr)
-return false;
-}
+ if (expr2->ts.type == BT_DERIVED
+ && !gfc_is_finalizable (expr2->ts.u.derived, NULL))
+return false;
/* If we have a class array, we need go back to the class
container. */
@@ -1358,20 +1367,14 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
if (!expr2->rank && !expr2->ref && CLASS_DATA
(expr2->symtree->n.sym)->as)
expr->rank = CLASS_DATA (expr2->symtree->n.sym)->as->rank;
-
- final_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (final_expr);
- gfc_add_final_component (final_expr);
}
- gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
-
stmtblock_t tmp_block;
gfc_start_block (_block);
gfc_se final_se;
gfc_init_se (_se, NULL);
- get_final_proc_ref (_se, final_expr);
+ get_final_proc_ref (_se, expr);
gfc_add_block_to_block (block, _se.pre);
gfc_se size_se;
--
2.40.1
[PATCH 12/14] fortran: Factor scalar descriptor generation
The same scalar descriptor generation code is present twice, in the
case of derived type entities, and in the case of polymorphic
non-coarray entities. Factor it in preparation for a future third case
that will also need the same code for scalar descriptor generation.
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): Factor scalar descriptor generation.
---
gcc/fortran/trans.cc | 33 +++--
1 file changed, 15 insertions(+), 18 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 731dfb626ab..69e9329c9cb 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1146,7 +1146,6 @@ static void
get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_se tmp_se;
- symbol_attribute attr;
gcc_assert (var);
@@ -1164,13 +1163,6 @@ get_var_descr (gfc_se *se, gfc_expr *var)
{
gfc_conv_expr (_se, var);
// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
-
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr ();
- tmp_se.expr = gfc_conv_scalar_to_descriptor (_se, tmp_se.expr,
- attr);
- gcc_assert (tmp_se.post.head == NULL_TREE);
}
}
else
@@ -1191,20 +1183,25 @@ get_var_descr (gfc_se *se, gfc_expr *var)
gfc_add_data_component (array_expr);
gfc_conv_expr (_se, array_expr);
gcc_assert (tmp_se.post.head == NULL_TREE);
-
- if (!gfc_is_coarray (array_expr))
- {
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr ();
- tmp_se.expr = gfc_conv_scalar_to_descriptor (_se, tmp_se.expr,
- attr);
- }
- gcc_assert (tmp_se.post.head == NULL_TREE);
}
gfc_free_expr (array_expr);
}
+ if (var->rank == 0)
+{
+ if (var->ts.type == BT_DERIVED
+ || !gfc_is_coarray (var))
+ {
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ symbol_attribute attr;
+ gfc_clear_attr ();
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (_se, tmp_se.expr,
+ attr);
+ }
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+}
+
if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);
--
2.40.1
[PATCH 05/14] fortran: Add missing cleanup blocks
Move cleanup code for the data descriptor after the finalization code as it makes more sense to have it after. Other cleanup blocks should be empty (element size and final pointer are just data references), but add them by the way, just in case. gcc/fortran/ChangeLog: * trans.cc (gfc_add_finalizer_call): Add post code for desc_se after the finalizer call. Add post code for final_se and size_se as well. --- gcc/fortran/trans.cc | 6 +- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index f8ca388ab9f..5c953a07533 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1391,8 +1391,12 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) desc_se.expr, size_se.expr, boolean_false_node); - gfc_add_block_to_block (_block, _se.post); gfc_add_expr_to_block (_block, tmp); + + gfc_add_block_to_block (_block, _se.post); + gfc_add_block_to_block (_block, _se.post); + gfc_add_block_to_block (_block, _se.post); + tmp = gfc_finish_block (_block); if (expr->ts.type == BT_CLASS && !has_finalizer) -- 2.40.1
[PATCH 06/14] fortran: Reuse final procedure pointer expression
Reuse twice the same final procedure pointer expression instead of translating it twice. Final procedure pointer expressions were translated twice, once for the final procedure call, and once for the check for non-nullness (if applicable). gcc/fortran/ChangeLog: * trans.cc (gfc_add_finalizer_call): Move pre and post code for the final procedure pointer expression to the outer block. Reuse the previously evaluated final procedure pointer expression. --- gcc/fortran/trans.cc | 11 +-- 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 5c953a07533..3750d4eca82 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -1375,7 +1375,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_se final_se; gfc_init_se (_se, NULL); get_final_proc_ref (_se, final_expr); - gfc_add_block_to_block (_block, _se.pre); + gfc_add_block_to_block (block, _se.pre); gfc_se size_se; gfc_init_se (_se, NULL); @@ -1395,7 +1395,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) gfc_add_block_to_block (_block, _se.post); gfc_add_block_to_block (_block, _se.post); - gfc_add_block_to_block (_block, _se.post); tmp = gfc_finish_block (_block); @@ -1404,11 +1403,10 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) tree cond; gfc_se se; - gfc_init_se (, NULL); - se.want_pointer = 1; - gfc_conv_expr (, final_expr); + tree ptr = gfc_build_addr_expr (NULL_TREE, final_se.expr); + cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, - se.expr, build_int_cst (TREE_TYPE (se.expr), 0)); + ptr, build_int_cst (TREE_TYPE (ptr), 0)); /* For CLASS(*) not only sym->_vtab->_final can be NULL but already sym->_vtab itself. */ @@ -1437,6 +1435,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr *expr2) } gfc_add_expr_to_block (block, tmp); + gfc_add_block_to_block (block, _se.post); return true; } -- 2.40.1
[PATCH 00/14] fortran: Use precalculated class container for deallocation [PR110618]
Hello, the following patches are abot PR110618, a PR similar to PR92178 from which it is cloned. Both are about a problem of dedendencies between arguments, when one of them is associated to an allocatable intent(out) dummy, and thus deallocated in the process of argument association. PR110618 exposes a case where the data reference finalization code for one argument references deallocated data from another argument. The way I propose to fix this is similar to my recent patches for PR92178 [1,2] (and is dependent on them). Those patches try to use a data reference pointer precalculated at the beginning of the process instead of repeatedly evaluating an expression that becomes invalid at some point in the generated code. Unfortunately, the code for finalization is not prepared for this, as it only manipulates front-end expressions, whereas the precalculated pointer is available as middle-end's generic tree. These patches refactor the finalization code to ease the introduction of the forementioned pre-calculated class container pointer. Basically, four expressions are calculated to build the final procedure call: the final procedure pointer, the element size, the data reference (array) descriptor, and (optionally) the virtual table pointer. Each of the four is outlined stepwise to its own separate function in the following patches. This abstracts away the generation of these expressions and makes it easier to add one other way to generate them. This should also make the impact of the changes more visible, and regressions easier to spot. The main changes are the two last patches introducing an additional precalculated pointer argument in relevant functions and using them if set. Details are in the specific patches. Each patch has been bubble-bootstrapped and partially tested with RUNTESTFLAGS="dg.exp=*final*". The complete set has been fully tested on x86_64-pc-linux-gnu. OK for master? [1] https://gcc.gnu.org/pipermail/fortran/2023-July/059582.html [2] https://gcc.gnu.org/pipermail/fortran/2023-July/059583.html Mikael Morin (14): fortran: Outline final procedure pointer evaluation fortran: Outline element size evaluation fortran: Outline data reference descriptor evaluation fortran: Inline gfc_build_final_call fortran: Add missing cleanup blocks fortran: Reuse final procedure pointer expression fortran: Push element size expression generation close to its usage fortran: Push final procedure expr gen close to its one usage. fortran: Inline variable definition fortran: Remove redundant argument in get_var_descr fortran: Outline virtual table pointer evaluation fortran: Factor scalar descriptor generation fortran: Use pre-evaluated class container if available [PR110618] fortran: Pass pre-calculated class container argument [pr110618] gcc/fortran/trans-array.cc | 2 +- gcc/fortran/trans-expr.cc | 7 +- gcc/fortran/trans-stmt.cc | 3 +- gcc/fortran/trans.cc| 314 gcc/fortran/trans.h | 9 +- gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +++ 6 files changed, 237 insertions(+), 135 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90 -- 2.40.1
[PATCH 11/14] fortran: Outline virtual table pointer evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_vptr): New function.
(gfc_add_finalizer_call): Move virtual table pointer evaluation
to get_vptr.
---
gcc/fortran/trans.cc | 33 ++---
1 file changed, 22 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index bcf3341fd4b..731dfb626ab 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1214,6 +1214,23 @@ get_var_descr (gfc_se *se, gfc_expr *var)
}
+static void
+get_vptr (gfc_se *se, gfc_expr *expr)
+{
+ gfc_expr *vptr_expr = gfc_copy_expr (expr);
+ gfc_add_vptr_component (vptr_expr);
+
+ gfc_se tmp_se;
+ gfc_init_se (_se, NULL);
+ tmp_se.want_pointer = 1;
+ gfc_conv_expr (_se, vptr_expr);
+ gfc_free_expr (vptr_expr);
+
+ gfc_add_block_to_block (>pre, _se.pre);
+ gfc_add_block_to_block (>post, _se.post);
+ se->expr = tmp_se.expr;
+}
+
bool
gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component
*comp,
@@ -1398,7 +1415,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
&& !gfc_is_finalizable (expr->ts.u.derived, NULL))
{
tree cond;
- gfc_se se;
tree ptr = gfc_build_addr_expr (NULL_TREE, final_se.expr);
@@ -1410,19 +1426,14 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
if (UNLIMITED_POLY (expr))
{
tree cond2;
- gfc_expr *vptr_expr;
+ gfc_se vptr_se;
- vptr_expr = gfc_copy_expr (expr);
- gfc_add_vptr_component (vptr_expr);
-
- gfc_init_se (, NULL);
- se.want_pointer = 1;
- gfc_conv_expr (, vptr_expr);
- gfc_free_expr (vptr_expr);
+ gfc_init_se (_se, NULL);
+ get_vptr (_se, expr);
cond2 = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- se.expr,
- build_int_cst (TREE_TYPE (se.expr), 0));
+ vptr_se.expr,
+ build_int_cst (TREE_TYPE (vptr_se.expr), 0));
cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
logical_type_node, cond2, cond);
}
--
2.40.1
[PATCH 04/14] fortran: Inline gfc_build_final_call
Function gfc_build_final_call has been simplified, inline it.
gcc/fortran/ChangeLog:
* trans.cc (gfc_build_final_call): Inline...
(gfc_add_finalizer_call): ... to its one caller.
---
gcc/fortran/trans.cc | 66 +---
1 file changed, 25 insertions(+), 41 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 9807b7eb9d9..f8ca388ab9f 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1201,45 +1201,6 @@ get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr
*var)
-/* Build a call to a FINAL procedure, which finalizes "var". */
-
-static tree
-gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
- bool fini_coarray, gfc_expr *class_size)
-{
- stmtblock_t block;
- gfc_se final_se, size_se, desc_se;
- tree final_fndecl, array, size, tmp;
-
- gcc_assert (var);
-
- gfc_start_block ();
-
- gfc_init_se (_se, NULL);
- get_final_proc_ref (_se, final_wrapper);
- gfc_add_block_to_block (, _se.pre);
- final_fndecl = final_se.expr;
-
- gfc_init_se (_se, NULL);
- get_elem_size (_se, , class_size);
- gfc_add_block_to_block (, _se.pre);
- size = size_se.expr;
-
- gfc_init_se (_se, NULL);
- get_var_descr (_se, , var);
- gfc_add_block_to_block (, _se.pre);
- array = desc_se.expr;
-
- tmp = build_call_expr_loc (input_location,
-final_fndecl, 3, array,
-size, fini_coarray ? boolean_true_node
- : boolean_false_node);
- gfc_add_block_to_block (, _se.post);
- gfc_add_expr_to_block (, tmp);
- return gfc_finish_block ();
-}
-
-
bool
gfc_add_comp_finalizer_call (stmtblock_t *block, tree decl, gfc_component
*comp,
bool fini_coarray)
@@ -1408,8 +1369,31 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
- tmp = gfc_build_final_call (expr->ts, final_expr, expr,
- false, elem_size);
+ stmtblock_t tmp_block;
+ gfc_start_block (_block);
+
+ gfc_se final_se;
+ gfc_init_se (_se, NULL);
+ get_final_proc_ref (_se, final_expr);
+ gfc_add_block_to_block (_block, _se.pre);
+
+ gfc_se size_se;
+ gfc_init_se (_se, NULL);
+ get_elem_size (_se, >ts, elem_size);
+ gfc_add_block_to_block (_block, _se.pre);
+
+ gfc_se desc_se;
+ gfc_init_se (_se, NULL);
+ get_var_descr (_se, >ts, expr);
+ gfc_add_block_to_block (_block, _se.pre);
+
+ tmp = build_call_expr_loc (input_location, final_se.expr, 3,
+desc_se.expr, size_se.expr,
+boolean_false_node);
+
+ gfc_add_block_to_block (_block, _se.post);
+ gfc_add_expr_to_block (_block, tmp);
+ tmp = gfc_finish_block (_block);
if (expr->ts.type == BT_CLASS && !has_finalizer)
{
--
2.40.1
[PATCH 02/14] fortran: Outline element size evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_elem_size): New function.
(gfc_build_final_call): Outline the element size evaluation
to get_elem_size.
---
gcc/fortran/trans.cc | 44 ++--
1 file changed, 30 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index b5f7b16eda3..1e4779f94af 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1100,6 +1100,30 @@ get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
}
+/* Generate the code to obtain the value of the element size whose expression
+ is passed as argument in CLASS_SIZE. */
+
+static void
+get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr *class_size)
+{
+ gcc_assert (ts->type == BT_DERIVED || ts->type == BT_CLASS);
+
+ if (ts->type == BT_DERIVED)
+{
+ gcc_assert (!class_size);
+ se->expr = gfc_typenode_for_spec (ts);
+ se->expr = TYPE_SIZE_UNIT (se->expr);
+ se->expr = fold_convert (gfc_array_index_type, se->expr);
+}
+ else
+{
+ gcc_assert (class_size);
+ gfc_conv_expr (se, class_size);
+ gcc_assert (se->post.head == NULL_TREE);
+}
+}
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1107,7 +1131,7 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
- gfc_se final_se;
+ gfc_se final_se, size_se;
gfc_se se;
tree final_fndecl, array, size, tmp;
symbol_attribute attr;
@@ -1121,15 +1145,13 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
gfc_add_block_to_block (, _se.pre);
final_fndecl = final_se.expr;
+ gfc_init_se (_se, NULL);
+ get_elem_size (_se, , class_size);
+ gfc_add_block_to_block (, _se.pre);
+ size = size_se.expr;
+
if (ts.type == BT_DERIVED)
{
- tree elem_size;
-
- gcc_assert (!class_size);
- elem_size = gfc_typenode_for_spec ();
- elem_size = TYPE_SIZE_UNIT (elem_size);
- size = fold_convert (gfc_array_index_type, elem_size);
-
gfc_init_se (, NULL);
se.want_pointer = 1;
if (var->rank)
@@ -1155,12 +1177,6 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
else
{
gfc_expr *array_expr;
- gcc_assert (class_size);
- gfc_init_se (, NULL);
- gfc_conv_expr (, class_size);
- gfc_add_block_to_block (, );
- gcc_assert (se.post.head == NULL_TREE);
- size = se.expr;
array_expr = gfc_copy_expr (var);
gfc_init_se (, NULL);
--
2.40.1
[PATCH 03/14] fortran: Outline data reference descriptor evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_var_descr): New function.
(gfc_build_final_call): Outline the data reference descriptor
evaluation code to get_var_descr.
---
gcc/fortran/trans.cc | 149 ---
1 file changed, 83 insertions(+), 66 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 1e4779f94af..9807b7eb9d9 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1124,6 +1124,83 @@ get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr
*class_size)
}
+/* Generate the data reference (array) descriptor corresponding to the
+ expression passed as argument in VAR. Use type in TS to pilot code
+ generation. */
+
+static void
+get_var_descr (gfc_se *se, gfc_typespec *ts, gfc_expr *var)
+{
+ gfc_se tmp_se;
+ symbol_attribute attr;
+
+ gcc_assert (var);
+
+ gfc_init_se (_se, NULL);
+
+ if (ts->type == BT_DERIVED)
+{
+ tmp_se.want_pointer = 1;
+ if (var->rank)
+ {
+ tmp_se.descriptor_only = 1;
+ gfc_conv_expr_descriptor (_se, var);
+ }
+ else
+ {
+ gfc_conv_expr (_se, var);
+// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
+
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ gfc_clear_attr ();
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (_se, tmp_se.expr,
+ attr);
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+ }
+}
+ else
+{
+ gfc_expr *array_expr;
+
+ array_expr = gfc_copy_expr (var);
+
+ tmp_se.want_pointer = 1;
+ if (array_expr->rank)
+ {
+ gfc_add_class_array_ref (array_expr);
+ tmp_se.descriptor_only = 1;
+ gfc_conv_expr_descriptor (_se, array_expr);
+ }
+ else
+ {
+ gfc_add_data_component (array_expr);
+ gfc_conv_expr (_se, array_expr);
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+
+ if (!gfc_is_coarray (array_expr))
+ {
+ /* No copy back needed, hence set attr's allocatable/pointer
+to zero. */
+ gfc_clear_attr ();
+ tmp_se.expr = gfc_conv_scalar_to_descriptor (_se, tmp_se.expr,
+ attr);
+ }
+ gcc_assert (tmp_se.post.head == NULL_TREE);
+ }
+ gfc_free_expr (array_expr);
+}
+
+ if (!POINTER_TYPE_P (TREE_TYPE (tmp_se.expr)))
+tmp_se.expr = gfc_build_addr_expr (NULL, tmp_se.expr);
+
+ gfc_add_block_to_block (>pre, _se.pre);
+ gfc_add_block_to_block (>post, _se.post);
+ se->expr = tmp_se.expr;
+}
+
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1131,10 +1208,8 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
- gfc_se final_se, size_se;
- gfc_se se;
+ gfc_se final_se, size_se, desc_se;
tree final_fndecl, array, size, tmp;
- symbol_attribute attr;
gcc_assert (var);
@@ -1150,74 +1225,16 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
gfc_add_block_to_block (, _se.pre);
size = size_se.expr;
- if (ts.type == BT_DERIVED)
-{
- gfc_init_se (, NULL);
- se.want_pointer = 1;
- if (var->rank)
- {
- se.descriptor_only = 1;
- gfc_conv_expr_descriptor (, var);
- array = se.expr;
- }
- else
- {
- gfc_conv_expr (, var);
-// gcc_assert (se.pre.head == NULL_TREE && se.post.head == NULL_TREE);
- array = se.expr;
+ gfc_init_se (_se, NULL);
+ get_var_descr (_se, , var);
+ gfc_add_block_to_block (, _se.pre);
+ array = desc_se.expr;
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr ();
- gfc_init_se (, NULL);
- array = gfc_conv_scalar_to_descriptor (, array, attr);
- gcc_assert (se.post.head == NULL_TREE);
- }
-}
- else
-{
- gfc_expr *array_expr;
-
- array_expr = gfc_copy_expr (var);
- gfc_init_se (, NULL);
- se.want_pointer = 1;
- if (array_expr->rank)
- {
- gfc_add_class_array_ref (array_expr);
- se.descriptor_only = 1;
- gfc_conv_expr_descriptor (, array_expr);
- array = se.expr;
- }
- else
- {
- gfc_add_data_component (array_expr);
- gfc_conv_expr (, array_expr);
- gfc_add_block_to_block (, );
- gcc_assert (se.post.head == NULL_TREE);
- array = se.expr;
-
- if (!gfc_is_coarray (array_expr))
- {
- /* No copy back needed, hence set attr's allocatable/pointer
-to zero. */
- gfc_clear_attr ();
- gfc_init_se (, NULL);
-
[PATCH 07/14] fortran: Push element size expression generation close to its usage
gfc_add_finalizer_call creates one expression which is only used
by the get_final_proc_ref function. Move the expression generation
there.
gcc/fortran/ChangeLog:
* trans.cc (gfc_add_finalizer_call): Remove local variable
elem_size. Pass expression to get_elem_size and move the
element size expression generation close to its usage there.
(get_elem_size): Add argument expr, remove class_size argument
and rebuild it from expr. Remove ts argument and use the
type of expr instead.
---
gcc/fortran/trans.cc | 25 +++--
1 file changed, 11 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 3750d4eca82..e5ad67199e7 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1100,24 +1100,26 @@ get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
}
-/* Generate the code to obtain the value of the element size whose expression
- is passed as argument in CLASS_SIZE. */
+/* Generate the code to obtain the value of the element size of the expression
+ passed as argument in EXPR. */
static void
-get_elem_size (gfc_se *se, gfc_typespec *ts, gfc_expr *class_size)
+get_elem_size (gfc_se *se, gfc_expr *expr)
{
- gcc_assert (ts->type == BT_DERIVED || ts->type == BT_CLASS);
+ gcc_assert (expr->ts.type == BT_DERIVED || expr->ts.type == BT_CLASS);
- if (ts->type == BT_DERIVED)
+ if (expr->ts.type == BT_DERIVED)
{
- gcc_assert (!class_size);
- se->expr = gfc_typenode_for_spec (ts);
+ se->expr = gfc_typenode_for_spec (>ts);
se->expr = TYPE_SIZE_UNIT (se->expr);
se->expr = fold_convert (gfc_array_index_type, se->expr);
}
else
{
- gcc_assert (class_size);
+ gfc_expr *class_size = gfc_copy_expr (expr);
+ gfc_add_vptr_component (class_size);
+ gfc_add_size_component (class_size);
+
gfc_conv_expr (se, class_size);
gcc_assert (se->post.head == NULL_TREE);
}
@@ -1307,7 +1309,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_ref *ref;
gfc_expr *expr;
gfc_expr *final_expr = NULL;
- gfc_expr *elem_size = NULL;
bool has_finalizer = false;
if (!expr2 || (expr2->ts.type != BT_DERIVED && expr2->ts.type != BT_CLASS))
@@ -1361,10 +1362,6 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
final_expr = gfc_copy_expr (expr);
gfc_add_vptr_component (final_expr);
gfc_add_final_component (final_expr);
-
- elem_size = gfc_copy_expr (expr);
- gfc_add_vptr_component (elem_size);
- gfc_add_size_component (elem_size);
}
gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
@@ -1379,7 +1376,7 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2)
gfc_se size_se;
gfc_init_se (_se, NULL);
- get_elem_size (_se, >ts, elem_size);
+ get_elem_size (_se, expr);
gfc_add_block_to_block (_block, _se.pre);
gfc_se desc_se;
--
2.40.1
[PATCH 01/14] fortran: Outline final procedure pointer evaluation
gcc/fortran/ChangeLog:
* trans.cc (get_final_proc_ref): New function.
(gfc_build_final_call): Outline the pointer evaluation code
to get_final_proc_ref.
---
gcc/fortran/trans.cc | 27 +--
1 file changed, 21 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index f1a3aacd850..b5f7b16eda3 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1085,6 +1085,21 @@ gfc_call_free (tree var)
}
+/* Generate the data reference to the finalization procedure pointer passed as
+ argument in FINAL_WRAPPER. */
+
+static void
+get_final_proc_ref (gfc_se *se, gfc_expr *final_wrapper)
+{
+ gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (se, final_wrapper);
+
+ if (POINTER_TYPE_P (TREE_TYPE (se->expr)))
+se->expr = build_fold_indirect_ref_loc (input_location, se->expr);
+}
+
+
/* Build a call to a FINAL procedure, which finalizes "var". */
static tree
@@ -1092,19 +1107,19 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr
*final_wrapper, gfc_expr *var,
bool fini_coarray, gfc_expr *class_size)
{
stmtblock_t block;
+ gfc_se final_se;
gfc_se se;
tree final_fndecl, array, size, tmp;
symbol_attribute attr;
- gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
gcc_assert (var);
gfc_start_block ();
- gfc_init_se (, NULL);
- gfc_conv_expr (, final_wrapper);
- final_fndecl = se.expr;
- if (POINTER_TYPE_P (TREE_TYPE (final_fndecl)))
-final_fndecl = build_fold_indirect_ref_loc (input_location, final_fndecl);
+
+ gfc_init_se (_se, NULL);
+ get_final_proc_ref (_se, final_wrapper);
+ gfc_add_block_to_block (, _se.pre);
+ final_fndecl = final_se.expr;
if (ts.type == BT_DERIVED)
{
--
2.40.1
[PATCH] fortran: Release symbols in reversed order [PR106050]
Hello,
I saw the light regarding this PR after Paul posted a comment yesterday.
Regression test in progress on x86_64-pc-linux-gnu.
I plan to push in the next hours.
Mikael
-- >8 --
Release symbols in reversed order wrt the order they were allocated.
This fixes an error recovery ICE in the case of a misplaced
derived type declaration. Such a declaration creates nested
symbols, one for the derived type and one for each type parameter,
which should be immediately released as the declaration is
rejected. This breaks if the derived type is released first.
As the type parameter symbols are in the namespace of the derived
type, releasing the derived type releases the type parameters, so
one can't access them after that, even to release them. Hence,
the type parameters should be released first.
PR fortran/106050
gcc/fortran/ChangeLog:
* symbol.cc (gfc_restore_last_undo_checkpoint): Release symbols
in reverse order.
gcc/testsuite/ChangeLog:
* gfortran.dg/pdt_33.f90: New test.
---
gcc/fortran/symbol.cc| 2 +-
gcc/testsuite/gfortran.dg/pdt_33.f90 | 15 +++
2 files changed, 16 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/pdt_33.f90
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 37a9e8fa0ae..4a71d84b3fe 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3661,7 +3661,7 @@ gfc_restore_last_undo_checkpoint (void)
gfc_symbol *p;
unsigned i;
- FOR_EACH_VEC_ELT (latest_undo_chgset->syms, i, p)
+ FOR_EACH_VEC_ELT_REVERSE (latest_undo_chgset->syms, i, p)
{
/* Symbol in a common block was new. Or was old and just put in common */
if (p->common_block
diff --git a/gcc/testsuite/gfortran.dg/pdt_33.f90
b/gcc/testsuite/gfortran.dg/pdt_33.f90
new file mode 100644
index 000..0521513f2f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_33.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR fortran/106050
+! The following used to trigger an error recovery ICE by releasing
+! the symbol T before the symbol K which was leading to releasing
+! K twice as it's in T's namespace.
+!
+! Contributed by G. Steinmetz
+
+program p
+ a = 1
+ type t(k) ! { dg-error "Unexpected derived type
declaration" }
+ integer, kind :: k = 4 ! { dg-error "not allowed outside a TYPE
definition" }
+ end type ! { dg-error "Expecting END PROGRAM" }
+end
--
2.40.1
[PATCH 3/3] fortran: Reorder array argument evaluation parts [PR92178]
In the case of an array actual arg passed to a polymorphic array dummy
with INTENT(OUT) attribute, reorder the argument evaluation code to
the following:
- first evaluate arguments' values, and data references,
- deallocate data references associated with an allocatable,
intent(out) dummy,
- create a class container using the freed data references.
The ordering used to be incorrect between the first two items,
when one argument was deallocated before a later argument evaluated
its expression depending on the former argument.
r14-2395-gb1079fc88f082d3c5b583c8822c08c5647810259 fixed it by treating
arguments associated with an allocatable, intent(out) dummy in a
separate, later block. This, however, wasn't working either if the data
reference of such an argument was depending on its own content, as
the class container initialization was trying to use deallocated
content.
This change generates class container initialization code in a separate
block, so that it is moved after the deallocation block without moving
the rest of the argument evaluation code.
This alone is not sufficient to fix the problem, because the class
container generation code repeatedly uses the full expression of
the argument at a place where deallocation might have happened
already. This is non-optimal, but may also be invalid, because the data
reference may depend on its own content. In that case the expression
can't be evaluated after the data has been deallocated.
As in the scalar case previously treated, this is fixed by saving
the data reference to a pointer before any deallocation happens,
and then only refering to the pointer. gfc_reset_vptr is updated
to take into account the already evaluated class container if it's
available.
Contrary to the scalar case, one hunk is needed to wrap the parameter
evaluation in a conditional, to avoid regressing in
optional_class_2.f90. This used to be handled by the class wrapper
construction which wrapped the whole code in a conditional. With
this change the class wrapper construction can't see the parameter
evaluation code, so the latter is updated with an additional handling
for optional arguments.
PR fortran/92178
gcc/fortran/ChangeLog:
* trans.h (gfc_reset_vptr): Add class_container argument.
* trans-expr.cc (gfc_reset_vptr): Ditto. If a valid vptr can
be obtained through class_container argument, bypass evaluation
of e.
(gfc_conv_procedure_call): Wrap the argument evaluation code
in a conditional if the associated dummy is optional. Evaluate
the data reference to a pointer now, and replace later
references with usage of the pointer.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_21.f90: New test.
---
gcc/fortran/trans-expr.cc | 86 -
gcc/fortran/trans.h | 2 +-
gcc/testsuite/gfortran.dg/intent_out_21.f90 | 33
3 files changed, 101 insertions(+), 20 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_21.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 5169fbcd974..dbb04f8c434 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -529,24 +529,32 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool
is_mold,
}
-/* Reset the vptr to the declared type, e.g. after deallocation. */
+/* Reset the vptr to the declared type, e.g. after deallocation.
+ Use the variable in CLASS_CONTAINER if available. Otherwise, recreate
+ one with E. The generated assignment code is added at the end of BLOCK. */
void
-gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
+gfc_reset_vptr (stmtblock_t *block, gfc_expr *e, tree class_container)
{
- gfc_symbol *vtab;
- tree vptr;
- tree vtable;
- gfc_se se;
+ tree vptr = NULL_TREE;
- /* Evaluate the expression and obtain the vptr from it. */
- gfc_init_se (, NULL);
- if (e->rank)
-gfc_conv_expr_descriptor (, e);
- else
-gfc_conv_expr (, e);
- gfc_add_block_to_block (block, );
- vptr = gfc_get_vptr_from_expr (se.expr);
+ if (class_container != NULL_TREE)
+vptr = gfc_get_vptr_from_expr (class_container);
+
+ if (vptr == NULL_TREE)
+{
+ gfc_se se;
+
+ /* Evaluate the expression and obtain the vptr from it. */
+ gfc_init_se (, NULL);
+ if (e->rank)
+ gfc_conv_expr_descriptor (, e);
+ else
+ gfc_conv_expr (, e);
+ gfc_add_block_to_block (block, );
+
+ vptr = gfc_get_vptr_from_expr (se.expr);
+}
/* If a vptr is not found, we can do nothing more. */
if (vptr == NULL_TREE)
@@ -556,6 +564,9 @@ gfc_reset_vptr (stmtblock_t *block, gfc_expr *e)
gfc_add_modify (block, vptr, build_int_cst (TREE_TYPE (vptr), 0));
else
{
+ gfc_symbol *vtab;
+ tree vtable;
+
/* Return the vptr to the address of the declared type. */
vtab = gfc_find_derived_vtab (e->ts.u.derived);
vtable = vtab->backend_decl;
@@
[PATCH 2/3] fortran: Factor data references for scalar class argument wrapping [PR92178]
In the case of a scalar actual arg passed to a polymorphic assumed-rank
dummy with INTENT(OUT) attribute, avoid repeatedly evaluating the actual
argument reference by saving a pointer to it. This is non-optimal, but
may also be invalid, because the data reference may depend on its own
content. In that case the expression can't be evaluated after the data
has been deallocated.
There are two ways redundant expressions are generated:
- parmse.expr, which contains the actual argument expression, is
reused to get or set subfields in gfc_conv_class_to_class.
- gfc_conv_class_to_class, to get the virtual table pointer associated
with the argument, generates a new expression from scratch starting
with the frontend expression.
The first part is fixed by saving parmse.expr to a pointer and using
the pointer instead of the original expression.
The second part is fixed by adding a separate field to gfc_se that
is set to the class container expression when the expression to
evaluate is polymorphic. This needs the same field in gfc_ss_info
so that its value can be propagated to gfc_conv_class_to_class which
is modified to use that value. Finally gfc_conv_procedure saves the
expression in that field to a pointer in between to avoid the same
problem as for the first part.
PR fortran/92178
gcc/fortran/ChangeLog:
* trans.h (struct gfc_se): New field class_container.
(struct gfc_ss_info): Ditto.
(gfc_evaluate_data_ref_now): New prototype.
* trans.cc (gfc_evaluate_data_ref_now): Implement it.
* trans-array.cc (gfc_conv_ss_descriptor): Copy class_container
field from gfc_se struct to gfc_ss_info struct.
(gfc_conv_expr_descriptor): Copy class_container field from
gfc_ss_info struct to gfc_se struct.
* trans-expr.cc (gfc_conv_class_to_class): Use class container
set in class_container field if available.
(gfc_conv_variable): Set class_container field on encountering
class variables or components, clear it on encountering
non-class components.
(gfc_conv_procedure_call): Evaluate data ref to a pointer now,
and replace later references by usage of the pointer.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_20.f90: New test.
---
gcc/fortran/trans-array.cc | 3 ++
gcc/fortran/trans-expr.cc | 26
gcc/fortran/trans.cc| 28 +
gcc/fortran/trans.h | 6
gcc/testsuite/gfortran.dg/intent_out_20.f90 | 33 +
5 files changed, 96 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_20.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e7c51bae052..1c2af55d436 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3271,6 +3271,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss,
int base)
gfc_add_block_to_block (block, );
info->descriptor = se.expr;
ss_info->string_length = se.string_length;
+ ss_info->class_container = se.class_container;
if (base)
{
@@ -7687,6 +7688,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else if (deferred_array_component)
se->string_length = ss_info->string_length;
+ se->class_container = ss_info->class_container;
+
gfc_free_ss_chain (ss);
return;
}
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index b7e95e6d04d..5169fbcd974 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -1266,6 +1266,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e,
gfc_typespec class_ts,
slen = build_zero_cst (size_type_node);
}
+ else if (parmse->class_container != NULL_TREE)
+/* Don't redundantly evaluate the expression if the required information
+ is already available. */
+tmp = parmse->class_container;
else
{
/* Remove everything after the last class reference, convert the
@@ -3078,6 +3082,11 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
return;
}
+ if (sym->ts.type == BT_CLASS
+ && sym->attr.class_ok
+ && sym->ts.u.derived->attr.is_class)
+ se->class_container = se->expr;
+
/* Dereference the expression, where needed. */
se->expr = gfc_maybe_dereference_var (sym, se->expr, se->descriptor_only,
is_classarray);
@@ -3135,6 +3144,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
conv_parent_component_references (se, ref);
gfc_conv_component_ref (se, ref);
+
+ if (ref->u.c.component->ts.type == BT_CLASS
+ && ref->u.c.component->attr.class_ok
+ && ref->u.c.component->ts.u.derived->attr.is_class)
+ se->class_container = se->expr;
+ else if (!(ref->u.c.sym->attr.flavor == FL_DERIVED
+
[PATCH 0/3] Fix argument evaluation order [PR92178]
Hello, this is a followup to Harald's recent work [1] on the evaluation order of arguments, when one of them is passed to an intent(out) allocatable dummy and is deallocated before the call. This extends Harald's fix to support: - scalars passed to assumed rank dummies (patch 1), - scalars passed to assumed rank dummies with the data reference depending on its own content (patch 2), - arrays with the data reference depending on its own content (patch 3). There is one (last?) case which is not supported, for which I have opened a separate PR [2]. Regression tested on x86_64-pc-linux-gnu. OK for master? [1] https://gcc.gnu.org/pipermail/fortran/2023-July/059562.html [2] https://gcc.gnu.org/bugzilla/show_bug.cgi?id=110618 Mikael Morin (3): fortran: defer class wrapper initialization after deallocation [PR92178] fortran: Factor data references for scalar class argument wrapping [PR92178] fortran: Reorder array argument evaluation parts [PR92178] gcc/fortran/trans-array.cc | 3 + gcc/fortran/trans-expr.cc | 130 +--- gcc/fortran/trans.cc| 28 + gcc/fortran/trans.h | 8 +- gcc/testsuite/gfortran.dg/intent_out_19.f90 | 22 gcc/testsuite/gfortran.dg/intent_out_20.f90 | 33 + gcc/testsuite/gfortran.dg/intent_out_21.f90 | 33 + 7 files changed, 236 insertions(+), 21 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_out_19.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_20.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_21.f90 -- 2.40.1
[PATCH 1/3] fortran: defer class wrapper initialization after deallocation [PR92178]
If an actual argument is associated with an INTENT(OUT) dummy, and code
to deallocate it is generated, generate the class wrapper initialization
after the actual argument deallocation.
This is achieved by passing a cleaned up expression to
gfc_conv_class_to_class, so that the class wrapper initialization code
can be isolated and moved independently after the deallocation.
PR fortran/92178
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Use a separate gfc_se
struct, initalized from parmse, to generate the class wrapper.
After the class wrapper code has been generated, copy it back
depending on whether parameter deallocation code has been
generated.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_19.f90: New test.
---
gcc/fortran/trans-expr.cc | 18 -
gcc/testsuite/gfortran.dg/intent_out_19.f90 | 22 +
2 files changed, 39 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_19.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7017b652d6e..b7e95e6d04d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6500,6 +6500,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
{
+ bool defer_to_dealloc_blk = false;
if (e->ts.type == BT_CLASS && fsym
&& fsym->ts.type == BT_CLASS
&& (!CLASS_DATA (fsym)->as
@@ -6661,6 +6662,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
stmtblock_t block;
tree ptr;
+ defer_to_dealloc_blk = true;
+
gfc_init_block ();
ptr = parmse.expr;
if (e->ts.type == BT_CLASS)
@@ -6717,7 +6720,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& ((CLASS_DATA (fsym)->as
&& CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
|| CLASS_DATA (e)->attr.dimension))
- gfc_conv_class_to_class (, e, fsym->ts, false,
+ {
+ gfc_se class_se = parmse;
+ gfc_init_block (_se.pre);
+ gfc_init_block (_se.post);
+
+ gfc_conv_class_to_class (_se, e, fsym->ts, false,
fsym->attr.intent != INTENT_IN
&& (CLASS_DATA (fsym)->attr.class_pointer
|| CLASS_DATA
(fsym)->attr.allocatable),
@@ -6727,6 +6735,14 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
CLASS_DATA (fsym)->attr.class_pointer
|| CLASS_DATA (fsym)->attr.allocatable);
+ parmse.expr = class_se.expr;
+ stmtblock_t *class_pre_block = defer_to_dealloc_blk
+? _blk
+:
+ gfc_add_block_to_block (class_pre_block, _se.pre);
+ gfc_add_block_to_block (, _se.post);
+ }
+
if (fsym && (fsym->ts.type == BT_DERIVED
|| fsym->ts.type == BT_ASSUMED)
&& e->ts.type == BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/intent_out_19.f90
b/gcc/testsuite/gfortran.dg/intent_out_19.f90
new file mode 100644
index 000..03036ed382a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_19.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+!
+! PR fortran/92178
+! Check that if a data reference passed is as actual argument whose dummy
+! has INTENT(OUT) attribute, any other argument depending on the
+! same data reference is evaluated before the data reference deallocation.
+
+program p
+ implicit none
+ class(*), allocatable :: c
+ c = 3
+ call bar (allocated(c), c, allocated (c))
+ if (allocated (c)) stop 14
+contains
+ subroutine bar (alloc, x, alloc2)
+logical :: alloc, alloc2
+class(*), allocatable, intent(out) :: x(..)
+if (allocated (x)) stop 5
+if (.not. alloc) stop 6
+if (.not. alloc2) stop 16
+ end subroutine bar
+end
--
2.40.1
[PATCH v2 6/9] fortran: Support clobbering of SAVE variables [PR87395]
This is in spirit a revert of: r9-3032-gee7fb0588c6361b4d77337ab0f7527be64fcdde2 That commit added a condition to avoid generating ICE with clobbers of variables with the SAVE attribute. The test added at that point continues to pass if we remove that condition now. PR fortran/87395 PR fortran/41453 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Remove condition on SAVE attribute guarding clobber generation. --- gcc/fortran/trans-expr.cc | 2 -- 1 file changed, 2 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 9b2832bdb26..d169df44a71 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6527,8 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !e->symtree->n.sym->attr.dimension && !e->symtree->n.sym->attr.pointer && !e->symtree->n.sym->attr.allocatable - /* FIXME - PR 87395 and PR 41453 */ - && e->symtree->n.sym->attr.save == SAVE_NONE && !e->symtree->n.sym->attr.associate_var && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED -- 2.35.1
[PATCH v2 4/9] fortran: Support clobbering with implicit interfaces [PR105012]
From: Harald Anlauf
Before procedure calls, we clobber actual arguments whose associated
dummy is INTENT(OUT). This only applies to procedures with explicit
interfaces, as the knowledge of the interface is necessary to know
whether an argument has the INTENT(OUT) attribute.
This change also enables clobber generation for procedure calls without
explicit interface, when the procedure has been defined in the same
file because we can use the dummy arguments' characteristics from the
procedure definition in that case.
The knowledge of the dummy characteristics is directly available through
gfc_actual_arglist’s associated_dummy pointers which have been populated
as a side effect of calling gfc_check_externals.
PR fortran/105012
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Use dummy
information from associated_dummy if there is no information
from the procedure interface.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_5.f90: New test.
Co-Authored-By: Mikael Morin
---
gcc/fortran/trans-expr.cc | 19 +++
.../gfortran.dg/intent_optimize_5.f90 | 24 +++
2 files changed, 39 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_5.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a62a3bb642d..2301724729f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6505,10 +6505,21 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
gfc_conv_expr_reference (, e);
- if (fsym
- && fsym->attr.intent == INTENT_OUT
- && !fsym->attr.allocatable
- && !fsym->attr.pointer
+ gfc_symbol *dsym = fsym;
+ gfc_dummy_arg *dummy;
+
+ /* Use associated dummy as fallback for formal
+argument if there is no explicit interface. */
+ if (dsym == NULL
+ && (dummy = arg->associated_dummy)
+ && dummy->intrinsicness == GFC_NON_INTRINSIC_DUMMY_ARG
+ && dummy->u.non_intrinsic->sym)
+ dsym = dummy->u.non_intrinsic->sym;
+
+ if (dsym
+ && dsym->attr.intent == INTENT_OUT
+ && !dsym->attr.allocatable
+ && !dsym->attr.pointer
&& e->expr_type == EXPR_VARIABLE
&& e->ref == NULL
&& e->symtree
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
new file mode 100644
index 000..2f184bf84a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/105012
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before the call to Y in the *.original dump, and the
+! initialization constant to be optimized away in the *.optimized dump,
+! despite the non-explicit interface if the subroutine with the INTENT(OUT)
+! is declared in the same file.
+
+SUBROUTINE Y (Z)
+ integer, intent(out) :: Z
+ Z = 42
+END SUBROUTINE Y
+PROGRAM TEST
+integer :: X
+X = 123456789
+CALL Y (X)
+if (X.ne.42) STOP 1
+END PROGRAM
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "x = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH v2 8/9] fortran: Support clobbering of allocatables and pointers [PR41453]
This adds support for clobbering of allocatable and pointer scalar
variables passed as actual argument to a subroutine when the associated
dummy has the INTENT(OUT) attribute.
Support was explicitly disabled, but the clobber generation code seems
to support it well, as demonstrated by the newly added testcase.
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Remove conditions
on ALLOCATABLE and POINTER attributes guarding clobber
generation.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_7.f90: New test.
---
gcc/fortran/trans-expr.cc | 2 -
.../gfortran.dg/intent_optimize_7.f90 | 42 +++
2 files changed, 42 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_7.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4491465c4d6..ae685157e22 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6525,8 +6525,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree
&& e->symtree->n.sym
&& !e->symtree->n.sym->attr.dimension
- && !e->symtree->n.sym->attr.pointer
- && !e->symtree->n.sym->attr.allocatable
&& e->ts.type != BT_CHARACTER
&& e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
new file mode 100644
index 000..0146dff4e20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before each call to FOO in the *.original dump, and the
+! initialization constants to be optimized away in the *.optimized dump,
+! in the case of scalar allocatables and pointers.
+
+module x
+implicit none
+contains
+ subroutine foo(a)
+integer, intent(out) :: a
+a = 42
+ end subroutine foo
+end module x
+
+program main
+ use x
+ implicit none
+ integer, allocatable :: ca
+ integer, target :: ct
+ integer, pointer :: cp
+
+ allocate(ca)
+ ca = 123456789
+ call foo(ca)
+ if (ca /= 42) stop 1
+ deallocate(ca)
+
+ ct = 987654321
+ cp => ct
+ call foo(cp)
+ if (ct /= 42) stop 2
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+! { dg-final { scan-tree-dump "\\*ca = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "\\*cp = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump-not "987654321" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH v2 3/9] fortran: Move clobbers after evaluation of all arguments [PR106817]
For actual arguments whose dummy is INTENT(OUT), we used to generate
clobbers on them at the same time we generated the argument reference
for the function call. This was wrong if for an argument coming
later, the value expression was depending on the value of the just-
clobbered argument, and we passed an undefined value in that case.
With this change, clobbers are collected separatedly and appended
to the procedure call preliminary code after all the arguments have been
evaluated.
PR fortran/106817
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Collect all clobbers
to their own separate block. Append the block of clobbers to
the procedure preliminary block after the argument evaluation
codes for all the arguments.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_4.f90: New test.
---
gcc/fortran/trans-expr.cc | 6 ++-
.../gfortran.dg/intent_optimize_4.f90 | 43 +++
2 files changed, 47 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_4.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 76c587e3d9f..a62a3bb642d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6018,7 +6018,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
- stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
int arglen;
@@ -6062,7 +6061,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
info = NULL;
+ stmtblock_t post, clobbers;
gfc_init_block ();
+ gfc_init_block ();
gfc_init_interface_mapping ();
if (!comp)
{
@@ -6531,7 +6532,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
var = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
- gfc_add_modify (>pre, var, clobber);
+ gfc_add_modify (, var, clobber);
}
}
/* Catch base objects that are not variables. */
@@ -7400,6 +7401,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
vec_safe_push (arglist, parmse.expr);
}
+ gfc_add_block_to_block (>pre, );
gfc_finish_interface_mapping (, >pre, >post);
if (comp)
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
new file mode 100644
index 000..effbaa12a2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+!
+! PR fortran/106817
+! Check that for an actual argument whose dummy is INTENT(OUT),
+! the clobber that is emitted in the caller before a procedure call
+! happens after any expression depending on the argument value has been
+! evaluated.
+!
+
+module m
+ implicit none
+contains
+ subroutine copy1(out, in)
+integer, intent(in) :: in
+integer, intent(out) :: out
+out = in
+ end subroutine copy1
+ subroutine copy2(in, out)
+integer, intent(in) :: in
+integer, intent(out) :: out
+out = in
+ end subroutine copy2
+end module m
+
+program p
+ use m
+ implicit none
+ integer :: a, b
+
+ ! Clobbering of a should happen after a+1 has been evaluated.
+ a = 3
+ call copy1(a, a+1)
+ if (a /= 4) stop 1
+
+ ! Clobbering order does not depend on the order of arguments.
+ ! It should also come last with reversed arguments.
+ b = 12
+ call copy2(b+1, b)
+ if (b /= 13) stop 2
+
+end program p
--
2.35.1
[PATCH v2 9/9] fortran: Support clobbering of derived types [PR41453]
This is probably the most risky patch in the series.
A previous version of this patch allowing all exactly matching derived
types showed two regressions. One of them uncovered PR106817 for which
I added a fix in this series, and for the other I have excluded
types with allocatable components from clobbering.
I have additionnally excluded finalizable types for similar reasons, and
parameterized derived type because they may not be constant-sized.
I hope we are safe for all the rest.
-- >8 --
This adds support for clobbering of non-polymorphic derived type
variables, when they are passed as actual argument whose associated
dummy has the INTENT(OUT) attribute.
We avoid to play with non-constant type sizes or class descriptors by
requiring that the types are derived (not class) and strictly matching,
and by excluding parameterized derived types.
Types that are used in the callee are also excluded: they are types with
allocatable components (the components will be deallocated), and
finalizable types or types with finalizable components (they will be
passed to finalization routines).
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Allow strictly
matching derived types.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_8.f90: New test.
---
gcc/fortran/trans-expr.cc | 18 -
.../gfortran.dg/intent_optimize_8.f90 | 66 +++
2 files changed, 83 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_8.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ae685157e22..16f14554db3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6526,8 +6526,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree->n.sym
&& !e->symtree->n.sym->attr.dimension
&& e->ts.type != BT_CHARACTER
- && e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS
+ && (e->ts.type != BT_DERIVED
+ || (dsym->ts.type == BT_DERIVED
+ && e->ts.u.derived == dsym->ts.u.derived
+ /* Types with allocatable components are
+excluded from clobbering because we need
+the unclobbered pointers to free the
+allocatable components in the callee.
+Same goes for finalizable types or types
+with finalizable components, we need to
+pass the unclobbered values to the
+finalization routines.
+For parameterized types, it's less clear
+but they may not have a constant size
+so better exclude them in any case. */
+ && !e->ts.u.derived->attr.alloc_comp
+ && !e->ts.u.derived->attr.pdt_type
+ && !gfc_is_finalizable (e->ts.u.derived,
NULL)))
&& !sym->attr.elemental)
{
tree var;
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
new file mode 100644
index 000..d8bc1bb3b7b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes in the case of non-polymorphic
derived type arguments:
+! - one clobber to be emitted in the caller before calls to FOO in the
*.original dump,
+! - no clobber to be emitted in the caller before calls to BAR in the
*.original dump,
+! - the initialization constants to be optimized away in the *.optimized dump.
+
+module x
+ implicit none
+ type :: t
+integer :: c
+ end type t
+ type, extends(t) :: u
+integer :: d
+ end type u
+contains
+ subroutine foo(a)
+type(t), intent(out) :: a
+a = t(42)
+ end subroutine foo
+ subroutine bar(b)
+class(t), intent(out) :: b
+b%c = 24
+ end subroutine bar
+end module x
+
+program main
+ use x
+ implicit none
+ type(t) :: tc
+ type(u) :: uc, ud
+ class(t), allocatable :: te, tf
+
+ tc = t(123456789)
+ call foo(tc)
+ if (tc%c /= 42) stop 1
+
+ uc = u(987654321, 0)
+ call foo(uc%t)
+ if (uc%c /= 42) stop 2
+ if (uc%d /= 0) stop 3
+
+ ud = u(11223344, 0)
+ call bar(ud)
+ if (ud%c /= 24) stop 4
+
+ te = t(55667788)
+ call foo(te)
+ if (te%c /= 42) stop 5
+
+ tf = t(99887766)
+ call bar(tf)
+ if
[PATCH v2 2/9] fortran: Fix invalid function decl clobber ICE [PR105012]
The fortran frontend, as result symbol for a function without
declared result symbol, uses the function symbol itself. This caused
an invalid clobber of a function decl to be emitted, leading to an
ICE, whereas the intended behaviour was to clobber the function result
variable. This change fixes the problem by getting the decl from the
just-retrieved variable reference after the call to
gfc_conv_expr_reference, instead of copying it from the frontend symbol.
PR fortran/105012
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Retrieve variable
from the just calculated variable reference.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_15.f90: New test.
---
gcc/fortran/trans-expr.cc | 3 ++-
gcc/testsuite/gfortran.dg/intent_out_15.f90 | 27 +
2 files changed, 29 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_15.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7902b941c2d..76c587e3d9f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6528,7 +6528,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree var;
/* FIXME: This fails if var is passed by reference,
see PR
41453. */
- var = e->symtree->n.sym->backend_decl;
+ var = build_fold_indirect_ref_loc (input_location,
+parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
gfc_add_modify (>pre, var, clobber);
}
diff --git a/gcc/testsuite/gfortran.dg/intent_out_15.f90
b/gcc/testsuite/gfortran.dg/intent_out_15.f90
new file mode 100644
index 000..64334e6f038
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_15.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/105012
+! The following case was triggering an ICE because of a clobber
+! on the DERFC function decl instead of its result.
+
+module error_function
+integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real
+contains
+SUBROUTINE CALERF_r8(ARG, RESULT, JINT)
+ integer, parameter :: rk = r8
+ real(rk), intent(in) :: arg
+ real(rk), intent(out) :: result
+ IF (Y .LE. THRESH) THEN
+ END IF
+end SUBROUTINE CALERF_r8
+FUNCTION DERFC(X)
+ integer, parameter :: rk = r8 ! 8 byte real
+ real(rk), intent(in) :: X
+ real(rk) :: DERFC
+ CALL CALERF_r8(X, DERFC, JINT)
+END FUNCTION DERFC
+end module error_function
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "__result_derfc = {CLOBBER};" "original" } }
--
2.35.1
[PATCH v2 0/9] fortran: clobber fixes [PR41453]
Hello, this is the second version of a set of changes around the clobber we generate in the caller before a procedure call, for each actual argument whose associated dummy has the INTENT(OUT) attribute. The clobbering of partial variables (array elements, structure components) proved to be unsupported by the middle-end optimizers, even if it seemed to work in practice. So this version just removes it. v1 of the series was posted here: https://gcc.gnu.org/pipermail/gcc-patches/2022-September/601713.html https://gcc.gnu.org/pipermail/fortran/2022-September/058165.html Changes from v1: - patch 9/10 (clobber subreferences) has been dropped. - patch 10/10 (now 9/9): The test has been adjusted because some checks were failing without the dropped patch. Basically there are less clobbers generated. - patch 5: In the test, an explicit kind has been added to integers, so that the dump match is not dependent on the -fdefault-integer-8 option. - patches 3, 4, 5, 8, and 10/10 (now 9/9): The tests have been renamed so that they are numbered in increasing order. The first patch is a refactoring moving the clobber generation in gfc_conv_procedure_call where it feels more appropriate. The second patch is a fix for the ICE originally motivating my work on this topic. The third patch is a fix for some wrong code issue discovered with an earlier version of this series. The following patches are gradual condition loosenings to enable clobber generation in more and more cases. Each patch has been tested through an incremental bootstrap and a partial testsuite run on fortran *intent* tests, and the whole lot has been run through the full fortran regression testsuite. OK for master? Harald Anlauf (1): fortran: Support clobbering with implicit interfaces [PR105012] Mikael Morin (8): fortran: Move the clobber generation code fortran: Fix invalid function decl clobber ICE [PR105012] fortran: Move clobbers after evaluation of all arguments [PR106817] fortran: Support clobbering of reference variables [PR41453] fortran: Support clobbering of SAVE variables [PR87395] fortran: Support clobbering of ASSOCIATE variables [PR87397] fortran: Support clobbering of allocatables and pointers [PR41453] fortran: Support clobbering of derived types [PR41453] gcc/fortran/trans-expr.cc | 81 --- gcc/fortran/trans.h | 3 +- .../gfortran.dg/intent_optimize_4.f90 | 43 ++ .../gfortran.dg/intent_optimize_5.f90 | 24 ++ .../gfortran.dg/intent_optimize_6.f90 | 34 .../gfortran.dg/intent_optimize_7.f90 | 42 ++ .../gfortran.dg/intent_optimize_8.f90 | 66 +++ gcc/testsuite/gfortran.dg/intent_out_15.f90 | 27 +++ 8 files changed, 290 insertions(+), 30 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_15.f90 -- 2.35.1
[PATCH v2 5/9] fortran: Support clobbering of reference variables [PR41453]
This adds support for clobbering of variables passed by reference,
when the reference is forwarded to a subroutine as actual argument
whose associated dummy has the INTENT(OUT) attribute.
This was explicitly disabled and enabling it seems to work, as
demonstrated by the new testcase.
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Remove condition
disabling clobber generation for dummy variables. Remove
obsolete comment.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_6.f90: New test.
---
gcc/fortran/trans-expr.cc | 4 ---
.../gfortran.dg/intent_optimize_6.f90 | 34 +++
2 files changed, 34 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_6.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2301724729f..9b2832bdb26 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6527,8 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& !e->symtree->n.sym->attr.dimension
&& !e->symtree->n.sym->attr.pointer
&& !e->symtree->n.sym->attr.allocatable
- /* See PR 41453. */
- && !e->symtree->n.sym->attr.dummy
/* FIXME - PR 87395 and PR 41453 */
&& e->symtree->n.sym->attr.save == SAVE_NONE
&& !e->symtree->n.sym->attr.associate_var
@@ -6538,8 +6536,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& !sym->attr.elemental)
{
tree var;
- /* FIXME: This fails if var is passed by reference,
see PR
-41453. */
var = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
new file mode 100644
index 000..72fec3db583
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before each call to FOO in the *.original dump, and the
+! initialization constant to be optimized away in the *.optimized dump,
+! in the case of an argument passed by reference to the caller.
+
+module x
+implicit none
+contains
+ subroutine foo(a)
+integer(kind=4), intent(out) :: a
+a = 42
+ end subroutine foo
+ subroutine bar(b)
+integer(kind=4) :: b
+b = 123456789
+call foo(b)
+ end subroutine bar
+end module x
+
+program main
+ use x
+ implicit none
+ integer(kind=4) :: c
+ call bar(c)
+ if (c /= 42) stop 1
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "\\*\\\(integer\\\(kind=4\\\) \\*\\\) b =
{CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH v2 7/9] fortran: Support clobbering of ASSOCIATE variables [PR87397]
This is in spirit a revert of: r9-3051-gc109362313623d83fe0a5194bceaf994cf0c6ce0 That commit added a condition to avoid generating ICE with clobbers of ASSOCIATE variables. The test added at that point continues to pass if we remove that condition now. PR fortran/87397 PR fortran/41453 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Remove condition disabling clobber generation for ASSOCIATE variables. --- gcc/fortran/trans-expr.cc | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d169df44a71..4491465c4d6 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6527,7 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !e->symtree->n.sym->attr.dimension && !e->symtree->n.sym->attr.pointer && !e->symtree->n.sym->attr.allocatable - && !e->symtree->n.sym->attr.associate_var && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED && e->ts.type != BT_CLASS -- 2.35.1
[PATCH v2 1/9] fortran: Move the clobber generation code
This change inlines the clobber generation code from
gfc_conv_expr_reference to the single caller from where the add_clobber
flag can be true, and removes the add_clobber argument.
What motivates this is the standard making the procedure call a cause
for a variable to become undefined, which translates to a clobber
generation, so clobber generation should be closely related to procedure
call generation, whereas it is rather orthogonal to variable reference
generation. Thus the generation of the clobber feels more appropriate
in gfc_conv_procedure_call than in gfc_conv_expr_reference.
Behaviour remains unchanged.
gcc/fortran/ChangeLog:
* trans.h (gfc_conv_expr_reference): Remove add_clobber
argument.
* trans-expr.cc (gfc_conv_expr_reference): Ditto. Inline code
depending on add_clobber and conditions controlling it ...
(gfc_conv_procedure_call): ... to here.
---
gcc/fortran/trans-expr.cc | 58 +--
gcc/fortran/trans.h | 3 +-
2 files changed, 32 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 850007fd2e1..7902b941c2d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6395,7 +6395,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree->n.sym->attr.pointer))
&& fsym && fsym->attr.target)
/* Make sure the function only gets called once. */
- gfc_conv_expr_reference (, e, false);
+ gfc_conv_expr_reference (, e);
else if (e->expr_type == EXPR_FUNCTION
&& e->symtree->n.sym->result
&& e->symtree->n.sym->result != e->symtree->n.sym
@@ -6502,22 +6502,36 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
else
{
- bool add_clobber;
- add_clobber = fsym && fsym->attr.intent == INTENT_OUT
- && !fsym->attr.allocatable && !fsym->attr.pointer
- && e->symtree && e->symtree->n.sym
- && !e->symtree->n.sym->attr.dimension
- && !e->symtree->n.sym->attr.pointer
- && !e->symtree->n.sym->attr.allocatable
- /* See PR 41453. */
- && !e->symtree->n.sym->attr.dummy
- /* FIXME - PR 87395 and PR 41453 */
- && e->symtree->n.sym->attr.save == SAVE_NONE
- && !e->symtree->n.sym->attr.associate_var
- && e->ts.type != BT_CHARACTER && e->ts.type !=
BT_DERIVED
- && e->ts.type != BT_CLASS && !sym->attr.elemental;
+ gfc_conv_expr_reference (, e);
- gfc_conv_expr_reference (, e, add_clobber);
+ if (fsym
+ && fsym->attr.intent == INTENT_OUT
+ && !fsym->attr.allocatable
+ && !fsym->attr.pointer
+ && e->expr_type == EXPR_VARIABLE
+ && e->ref == NULL
+ && e->symtree
+ && e->symtree->n.sym
+ && !e->symtree->n.sym->attr.dimension
+ && !e->symtree->n.sym->attr.pointer
+ && !e->symtree->n.sym->attr.allocatable
+ /* See PR 41453. */
+ && !e->symtree->n.sym->attr.dummy
+ /* FIXME - PR 87395 and PR 41453 */
+ && e->symtree->n.sym->attr.save == SAVE_NONE
+ && !e->symtree->n.sym->attr.associate_var
+ && e->ts.type != BT_CHARACTER
+ && e->ts.type != BT_DERIVED
+ && e->ts.type != BT_CLASS
+ && !sym->attr.elemental)
+ {
+ tree var;
+ /* FIXME: This fails if var is passed by reference,
see PR
+41453. */
+ var = e->symtree->n.sym->backend_decl;
+ tree clobber = build_clobber (TREE_TYPE (var));
+ gfc_add_modify (>pre, var, clobber);
+ }
}
/* Catch base objects that are not variables. */
if (e->ts.type == BT_CLASS
@@ -9485,7 +9499,7 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree
type)
values only. */
void
-gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr, bool add_clobber)
+gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
{
gfc_ss *ss;
tree var;
@@ -9525,16 +9539,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr,
bool add_clobber)
[PATCH 09/10] fortran: Support clobbering of variable subreferences [PR88364]
This adds support for clobbering of partial variable references, when
they are passed as actual argument and the associated dummy has the
INTENT(OUT) attribute.
Support includes array elements, derived type component references,
and complex real or imaginary parts.
This is done by removing the check for lack of subreferences, which is
basically a revert of r9-4911-gbd810d637041dba49a5aca3d085504575374ac6f.
This removal allows more expressions than just array elements,
components and complex parts, but the other expressions are excluded by
other conditions: substrings are excluded by the check on expression
type (CHARACTER is excluded), KIND and LEN references are rejected by
the compiler as not valid in a variable definition context.
The check for scalarness is also updated as it was only valid when there
was no subreference.
PR fortran/88364
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Don’t check for lack
of subreference. Check the global expression rank instead of
the root symbol dimension attribute.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_7.f90: New test.
---
gcc/fortran/trans-expr.cc | 5 +-
.../gfortran.dg/intent_optimize_7.f90 | 65 +++
2 files changed, 66 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_7.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index ae685157e22..f1026d7f309 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6521,10 +6521,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& !dsym->attr.allocatable
&& !dsym->attr.pointer
&& e->expr_type == EXPR_VARIABLE
- && e->ref == NULL
- && e->symtree
- && e->symtree->n.sym
- && !e->symtree->n.sym->attr.dimension
+ && e->rank == 0
&& e->ts.type != BT_CHARACTER
&& e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
new file mode 100644
index 000..14dcfd9961b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_7.f90
@@ -0,0 +1,65 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before each call to FOO or BAR in the *.original dump, and the
+! initialization constants to be optimized away in the *.optimized dump,
+! in the case of scalar array elements, derived type components,
+! and complex real and imaginary part.
+
+module x
+implicit none
+contains
+ subroutine foo(a)
+integer, intent(out) :: a
+a = 42
+ end subroutine foo
+ subroutine bar(a)
+real, intent(out) :: a
+a = 24.0
+ end subroutine bar
+end module x
+
+program main
+ use x
+ implicit none
+ type :: t
+integer :: c
+ end type t
+ type(t) :: dc
+ integer :: ac(3)
+ complex :: xc, xd
+
+ dc = t(123456789)
+ call foo(dc%c)
+ if (dc%c /= 42) stop 1
+
+ ac = 100
+ ac(2) = 987654321
+ call foo(ac(2))
+ if (any(ac /= [100, 42, 100])) stop 2
+
+ xc = (12345.0, 11.0)
+ call bar(xc%re)
+ if (xc /= (24.0, 11.0)) stop 3
+
+ xd = (17.0, 67890.0)
+ call bar(xd%im)
+ if (xd /= (17.0, 24.0)) stop 4
+
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 4 "original" } }
+! { dg-final { scan-tree-dump "dc\\.c = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "ac\\\[1\\\] = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "REALPART_EXPR = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "IMAGPART_EXPR = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "123456789" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump "987654321" "original" } }
+! { dg-final { scan-tree-dump-not "987654321" "optimized" { target
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump "1\\.2345e\\+4" "original" } }
+! { dg-final { scan-tree-dump-not "1\\.2345e\\+4" "optimized" { target
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump "6\\.789e\\+4" "original" } }
+! { dg-final { scan-tree-dump-not "6\\.789e\\+4" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH 07/10] fortran: Support clobbering of ASSOCIATE variables [PR87397]
This is in spirit a revert of: r9-3051-gc109362313623d83fe0a5194bceaf994cf0c6ce0 That commit added a condition to avoid generating ICE with clobbers of ASSOCIATE variables. The test added at that point continues to pass if we remove that condition now. PR fortran/87397 PR fortran/41453 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Remove condition disabling clobber generation for ASSOCIATE variables. --- gcc/fortran/trans-expr.cc | 1 - 1 file changed, 1 deletion(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index d169df44a71..4491465c4d6 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6527,7 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !e->symtree->n.sym->attr.dimension && !e->symtree->n.sym->attr.pointer && !e->symtree->n.sym->attr.allocatable - && !e->symtree->n.sym->attr.associate_var && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED && e->ts.type != BT_CLASS -- 2.35.1
[PATCH 10/10] fortran: Support clobbering of derived types [PR41453]
This is probably the most risky patch in the series.
A previous version of this patch allowing all exactly matching derived
types showed two regressions. One of them uncovered PR106817 for which
I added a fix in this series, and for the other I have excluded
types with allocatable components from clobbering.
I have additionnally excluded finalizable types for similar reasons, and
parameterized derived type because they may not be constant-sized.
I hope we are safe for all the rest.
-- >8 --
This adds support for clobbering of non-polymorphic derived type
variables, when they are passed as actual argument whose associated
dummy has the INTENT(OUT) attribute.
We avoid to play with non-constant type sizes or class descriptors by
requiring that the types are derived (not class) and strictly matching,
and by excluding parameterized derived types.
Types that are used in the callee are also excluded: they are types with
allocatable components (the components will be deallocated), and
finalizable types or types with finalizable components (they will be
passed to finalization routines).
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Allow strictly
matching derived types.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_8.f90: New test.
---
gcc/fortran/trans-expr.cc | 18 -
.../gfortran.dg/intent_optimize_8.f90 | 67 +++
2 files changed, 84 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_8.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index f1026d7f309..f8fcd2d97d9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6523,8 +6523,24 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->expr_type == EXPR_VARIABLE
&& e->rank == 0
&& e->ts.type != BT_CHARACTER
- && e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS
+ && (e->ts.type != BT_DERIVED
+ || (dsym->ts.type == BT_DERIVED
+ && e->ts.u.derived == dsym->ts.u.derived
+ /* Types with allocatable components are
+excluded from clobbering because we need
+the unclobbered pointers to free the
+allocatable components in the callee.
+Same goes for finalizable types or types
+with finalizable components, we need to
+pass the unclobbered values to the
+finalization routines.
+For parameterized types, it's less clear
+but they may not have a constant size
+so better exclude them in any case. */
+ && !e->ts.u.derived->attr.alloc_comp
+ && !e->ts.u.derived->attr.pdt_type
+ && !gfc_is_finalizable (e->ts.u.derived,
NULL)))
&& !sym->attr.elemental)
{
tree var;
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
new file mode 100644
index 000..584592842e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_8.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes in the case of non-polymorphic
derived type arguments:
+! - one clobber to be emitted in the caller before calls to FOO in the
*.original dump,
+! - no clobber to be emitted in the caller before calls to BAR in the
*.original dump,
+! - the initialization constants to be optimized away in the *.optimized dump.
+
+module x
+ implicit none
+ type :: t
+integer :: c
+ end type t
+ type, extends(t) :: u
+integer :: d
+ end type u
+contains
+ subroutine foo(a)
+type(t), intent(out) :: a
+a = t(42)
+ end subroutine foo
+ subroutine bar(b)
+class(t), intent(out) :: b
+b%c = 24
+ end subroutine bar
+end module x
+
+program main
+ use x
+ implicit none
+ type(t) :: tc
+ type(u) :: uc, ud
+ class(t), allocatable :: te, tf
+
+ tc = t(123456789)
+ call foo(tc)
+ if (tc%c /= 42) stop 1
+
+ uc = u(987654321, 0)
+ call foo(uc%t)
+ if (uc%c /= 42) stop 2
+ if (uc%d /= 0) stop 3
+
+ ud = u(11223344, 0)
+ call bar(ud)
+ if (ud%c /= 24) stop 4
+
+ te = t(55667788)
+ call foo(te)
+ if (te%c /= 42) stop 5
+
+ tf = t(99887766)
+ call bar(tf)
+ if (tf%c /= 24)
[PATCH 05/10] fortran: Support clobbering of reference variables [PR41453]
This adds support for clobbering of variables passed by reference,
when the reference is forwarded to a subroutine as actual argument
whose associated dummy has the INTENT(OUT) attribute.
This was explicitly disabled and enabling it seems to work, as
demonstrated by the new testcase.
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Remove condition
disabling clobber generation for dummy variables. Remove
obsolete comment.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_5.f90: New test.
---
gcc/fortran/trans-expr.cc | 4 ---
.../gfortran.dg/intent_optimize_5.f90 | 34 +++
2 files changed, 34 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_5.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 2301724729f..9b2832bdb26 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6527,8 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& !e->symtree->n.sym->attr.dimension
&& !e->symtree->n.sym->attr.pointer
&& !e->symtree->n.sym->attr.allocatable
- /* See PR 41453. */
- && !e->symtree->n.sym->attr.dummy
/* FIXME - PR 87395 and PR 41453 */
&& e->symtree->n.sym->attr.save == SAVE_NONE
&& !e->symtree->n.sym->attr.associate_var
@@ -6538,8 +6536,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& !sym->attr.elemental)
{
tree var;
- /* FIXME: This fails if var is passed by reference,
see PR
-41453. */
var = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
new file mode 100644
index 000..1633b681fc3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_5.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before each call to FOO in the *.original dump, and the
+! initialization constant to be optimized away in the *.optimized dump,
+! in the case of an argument passed by reference to the caller.
+
+module x
+implicit none
+contains
+ subroutine foo(a)
+integer, intent(out) :: a
+a = 42
+ end subroutine foo
+ subroutine bar(b)
+integer :: b
+b = 123456789
+call foo(b)
+ end subroutine bar
+end module x
+
+program main
+ use x
+ implicit none
+ integer :: c
+ call bar(c)
+ if (c /= 42) stop 1
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "\\*\\\(integer\\\(kind=4\\\) \\*\\\) b =
{CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH 08/10] fortran: Support clobbering of allocatables and pointers [PR41453]
This adds support for clobbering of allocatable and pointer scalar
variables passed as actual argument to a subroutine when the associated
dummy has the INTENT(OUT) attribute.
Support was explicitly disabled, but the clobber generation code seems
to support it well, as demonstrated by the newly added testcase.
PR fortran/41453
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Remove conditions
on ALLOCATABLE and POINTER attributes guarding clobber
generation.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_6.f90: New test.
---
gcc/fortran/trans-expr.cc | 2 -
.../gfortran.dg/intent_optimize_6.f90 | 42 +++
2 files changed, 42 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_6.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 4491465c4d6..ae685157e22 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6525,8 +6525,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree
&& e->symtree->n.sym
&& !e->symtree->n.sym->attr.dimension
- && !e->symtree->n.sym->attr.pointer
- && !e->symtree->n.sym->attr.allocatable
&& e->ts.type != BT_CHARACTER
&& e->ts.type != BT_DERIVED
&& e->ts.type != BT_CLASS
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
new file mode 100644
index 000..0146dff4e20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_6.f90
@@ -0,0 +1,42 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/41453
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before each call to FOO in the *.original dump, and the
+! initialization constants to be optimized away in the *.optimized dump,
+! in the case of scalar allocatables and pointers.
+
+module x
+implicit none
+contains
+ subroutine foo(a)
+integer, intent(out) :: a
+a = 42
+ end subroutine foo
+end module x
+
+program main
+ use x
+ implicit none
+ integer, allocatable :: ca
+ integer, target :: ct
+ integer, pointer :: cp
+
+ allocate(ca)
+ ca = 123456789
+ call foo(ca)
+ if (ca /= 42) stop 1
+ deallocate(ca)
+
+ ct = 987654321
+ cp => ct
+ call foo(cp)
+ if (ct /= 42) stop 2
+end program main
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+! { dg-final { scan-tree-dump "\\*ca = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump "\\*cp = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
+! { dg-final { scan-tree-dump-not "987654321" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH 04/10] fortran: Support clobbering with implicit interfaces [PR105012]
From: Harald Anlauf
Before procedure calls, we clobber actual arguments whose associated
dummy is INTENT(OUT). This only applies to procedures with explicit
interfaces, as the knowledge of the interface is necessary to know
whether an argument has the INTENT(OUT) attribute.
This change also enables clobber generation for procedure calls without
explicit interface, when the procedure has been defined in the same
file because we can use the dummy arguments' characteristics from the
procedure definition in that case.
The knowledge of the dummy characteristics is directly available through
gfc_actual_arglist’s associated_dummy pointers which have been populated
as a side effect of calling gfc_check_externals.
PR fortran/105012
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Use dummy
information from associated_dummy if there is no information
from the procedure interface.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_4.f90: New test.
Co-Authored-By: Mikael Morin
---
gcc/fortran/trans-expr.cc | 19 +++
.../gfortran.dg/intent_optimize_4.f90 | 24 +++
2 files changed, 39 insertions(+), 4 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_4.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a62a3bb642d..2301724729f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6505,10 +6505,21 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
{
gfc_conv_expr_reference (, e);
- if (fsym
- && fsym->attr.intent == INTENT_OUT
- && !fsym->attr.allocatable
- && !fsym->attr.pointer
+ gfc_symbol *dsym = fsym;
+ gfc_dummy_arg *dummy;
+
+ /* Use associated dummy as fallback for formal
+argument if there is no explicit interface. */
+ if (dsym == NULL
+ && (dummy = arg->associated_dummy)
+ && dummy->intrinsicness == GFC_NON_INTRINSIC_DUMMY_ARG
+ && dummy->u.non_intrinsic->sym)
+ dsym = dummy->u.non_intrinsic->sym;
+
+ if (dsym
+ && dsym->attr.intent == INTENT_OUT
+ && !dsym->attr.allocatable
+ && !dsym->attr.pointer
&& e->expr_type == EXPR_VARIABLE
&& e->ref == NULL
&& e->symtree
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
new file mode 100644
index 000..2f184bf84a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_4.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-additional-options "-fno-inline -fno-ipa-modref -fdump-tree-optimized
-fdump-tree-original" }
+!
+! PR fortran/105012
+! Check that the INTENT(OUT) attribute causes one clobber to be emitted in
+! the caller before the call to Y in the *.original dump, and the
+! initialization constant to be optimized away in the *.optimized dump,
+! despite the non-explicit interface if the subroutine with the INTENT(OUT)
+! is declared in the same file.
+
+SUBROUTINE Y (Z)
+ integer, intent(out) :: Z
+ Z = 42
+END SUBROUTINE Y
+PROGRAM TEST
+integer :: X
+X = 123456789
+CALL Y (X)
+if (X.ne.42) STOP 1
+END PROGRAM
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "x = {CLOBBER};" "original" } }
+! { dg-final { scan-tree-dump-not "123456789" "optimized" { target
__OPTIMIZE__ } } }
--
2.35.1
[PATCH 06/10] fortran: Support clobbering of SAVE variables [PR87395]
This is in spirit a revert of: r9-3032-gee7fb0588c6361b4d77337ab0f7527be64fcdde2 That commit added a condition to avoid generating ICE with clobbers of variables with the SAVE attribute. The test added at that point continues to pass if we remove that condition now. PR fortran/87395 PR fortran/41453 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_procedure_call): Remove condition on SAVE attribute guarding clobber generation. --- gcc/fortran/trans-expr.cc | 2 -- 1 file changed, 2 deletions(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 9b2832bdb26..d169df44a71 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6527,8 +6527,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && !e->symtree->n.sym->attr.dimension && !e->symtree->n.sym->attr.pointer && !e->symtree->n.sym->attr.allocatable - /* FIXME - PR 87395 and PR 41453 */ - && e->symtree->n.sym->attr.save == SAVE_NONE && !e->symtree->n.sym->attr.associate_var && e->ts.type != BT_CHARACTER && e->ts.type != BT_DERIVED -- 2.35.1
[PATCH 00/10] fortran: clobber fixes [PR41453]
Hello, this is a set of changes around the clobber we generate in the caller before a procedure call, for each actual argument whose associated dummy has the INTENT(OUT) attribute. The first patch is a refactoring moving the clobber generation in gfc_conv_procedure_call where it feels more appropriate. The second patch is a fix for the ICE originally motivating my work on this topic. The third patch is a fix for some wrong code issue discovered with an earlier version of this series. The following patches are gradual condition loosenings to enable clobber generation in more and more cases. Each patch has been tested through an incremental bootstrap and a partial testsuite run on fortran *intent* tests, and the whole lot has been run through the full fortran regression testsuite. OK for master? Harald Anlauf (1): fortran: Support clobbering with implicit interfaces [PR105012] Mikael Morin (9): fortran: Move the clobber generation code fortran: Fix invalid function decl clobber ICE [PR105012] fortran: Move clobbers after evaluation of all arguments [PR106817] fortran: Support clobbering of reference variables [PR41453] fortran: Support clobbering of SAVE variables [PR87395] fortran: Support clobbering of ASSOCIATE variables [PR87397] fortran: Support clobbering of allocatables and pointers [PR41453] fortran: Support clobbering of variable subreferences [PR88364] fortran: Support clobbering of derived types [PR41453] gcc/fortran/trans-expr.cc | 78 --- gcc/fortran/trans.h | 3 +- .../gfortran.dg/intent_optimize_4.f90 | 24 ++ .../gfortran.dg/intent_optimize_5.f90 | 34 .../gfortran.dg/intent_optimize_6.f90 | 42 ++ .../gfortran.dg/intent_optimize_7.f90 | 65 .../gfortran.dg/intent_optimize_8.f90 | 67 .../gfortran.dg/intent_optimize_9.f90 | 43 ++ gcc/testsuite/gfortran.dg/intent_out_15.f90 | 27 +++ 9 files changed, 353 insertions(+), 30 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_9.f90 create mode 100644 gcc/testsuite/gfortran.dg/intent_out_15.f90 -- 2.35.1
[PATCH 02/10] fortran: Fix invalid function decl clobber ICE [PR105012]
The fortran frontend, as result symbol for a function without
declared result symbol, uses the function symbol itself. This caused
an invalid clobber of a function decl to be emitted, leading to an
ICE, whereas the intended behaviour was to clobber the function result
variable. This change fixes the problem by getting the decl from the
just-retrieved variable reference after the call to
gfc_conv_expr_reference, instead of copying it from the frontend symbol.
PR fortran/105012
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Retrieve variable
from the just calculated variable reference.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_out_15.f90: New test.
---
gcc/fortran/trans-expr.cc | 3 ++-
gcc/testsuite/gfortran.dg/intent_out_15.f90 | 27 +
2 files changed, 29 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_out_15.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7902b941c2d..76c587e3d9f 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6528,7 +6528,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tree var;
/* FIXME: This fails if var is passed by reference,
see PR
41453. */
- var = e->symtree->n.sym->backend_decl;
+ var = build_fold_indirect_ref_loc (input_location,
+parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
gfc_add_modify (>pre, var, clobber);
}
diff --git a/gcc/testsuite/gfortran.dg/intent_out_15.f90
b/gcc/testsuite/gfortran.dg/intent_out_15.f90
new file mode 100644
index 000..64334e6f038
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_out_15.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/105012
+! The following case was triggering an ICE because of a clobber
+! on the DERFC function decl instead of its result.
+
+module error_function
+integer, parameter :: r8 = selected_real_kind(12) ! 8 byte real
+contains
+SUBROUTINE CALERF_r8(ARG, RESULT, JINT)
+ integer, parameter :: rk = r8
+ real(rk), intent(in) :: arg
+ real(rk), intent(out) :: result
+ IF (Y .LE. THRESH) THEN
+ END IF
+end SUBROUTINE CALERF_r8
+FUNCTION DERFC(X)
+ integer, parameter :: rk = r8 ! 8 byte real
+ real(rk), intent(in) :: X
+ real(rk) :: DERFC
+ CALL CALERF_r8(X, DERFC, JINT)
+END FUNCTION DERFC
+end module error_function
+
+! { dg-final { scan-tree-dump-times "CLOBBER" 1 "original" } }
+! { dg-final { scan-tree-dump "__result_derfc = {CLOBBER};" "original" } }
--
2.35.1
[PATCH 01/10] fortran: Move the clobber generation code
This change inlines the clobber generation code from
gfc_conv_expr_reference to the single caller from where the add_clobber
flag can be true, and removes the add_clobber argument.
What motivates this is the standard making the procedure call a cause
for a variable to become undefined, which translates to a clobber
generation, so clobber generation should be closely related to procedure
call generation, whereas it is rather orthogonal to variable reference
generation. Thus the generation of the clobber feels more appropriate
in gfc_conv_procedure_call than in gfc_conv_expr_reference.
Behaviour remains unchanged.
gcc/fortran/ChangeLog:
* trans.h (gfc_conv_expr_reference): Remove add_clobber
argument.
* trans-expr.cc (gfc_conv_expr_reference): Ditto. Inline code
depending on add_clobber and conditions controlling it ...
(gfc_conv_procedure_call): ... to here.
---
gcc/fortran/trans-expr.cc | 58 +--
gcc/fortran/trans.h | 3 +-
2 files changed, 32 insertions(+), 29 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 850007fd2e1..7902b941c2d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6395,7 +6395,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& e->symtree->n.sym->attr.pointer))
&& fsym && fsym->attr.target)
/* Make sure the function only gets called once. */
- gfc_conv_expr_reference (, e, false);
+ gfc_conv_expr_reference (, e);
else if (e->expr_type == EXPR_FUNCTION
&& e->symtree->n.sym->result
&& e->symtree->n.sym->result != e->symtree->n.sym
@@ -6502,22 +6502,36 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
}
else
{
- bool add_clobber;
- add_clobber = fsym && fsym->attr.intent == INTENT_OUT
- && !fsym->attr.allocatable && !fsym->attr.pointer
- && e->symtree && e->symtree->n.sym
- && !e->symtree->n.sym->attr.dimension
- && !e->symtree->n.sym->attr.pointer
- && !e->symtree->n.sym->attr.allocatable
- /* See PR 41453. */
- && !e->symtree->n.sym->attr.dummy
- /* FIXME - PR 87395 and PR 41453 */
- && e->symtree->n.sym->attr.save == SAVE_NONE
- && !e->symtree->n.sym->attr.associate_var
- && e->ts.type != BT_CHARACTER && e->ts.type !=
BT_DERIVED
- && e->ts.type != BT_CLASS && !sym->attr.elemental;
+ gfc_conv_expr_reference (, e);
- gfc_conv_expr_reference (, e, add_clobber);
+ if (fsym
+ && fsym->attr.intent == INTENT_OUT
+ && !fsym->attr.allocatable
+ && !fsym->attr.pointer
+ && e->expr_type == EXPR_VARIABLE
+ && e->ref == NULL
+ && e->symtree
+ && e->symtree->n.sym
+ && !e->symtree->n.sym->attr.dimension
+ && !e->symtree->n.sym->attr.pointer
+ && !e->symtree->n.sym->attr.allocatable
+ /* See PR 41453. */
+ && !e->symtree->n.sym->attr.dummy
+ /* FIXME - PR 87395 and PR 41453 */
+ && e->symtree->n.sym->attr.save == SAVE_NONE
+ && !e->symtree->n.sym->attr.associate_var
+ && e->ts.type != BT_CHARACTER
+ && e->ts.type != BT_DERIVED
+ && e->ts.type != BT_CLASS
+ && !sym->attr.elemental)
+ {
+ tree var;
+ /* FIXME: This fails if var is passed by reference,
see PR
+41453. */
+ var = e->symtree->n.sym->backend_decl;
+ tree clobber = build_clobber (TREE_TYPE (var));
+ gfc_add_modify (>pre, var, clobber);
+ }
}
/* Catch base objects that are not variables. */
if (e->ts.type == BT_CLASS
@@ -9485,7 +9499,7 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree
type)
values only. */
void
-gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr, bool add_clobber)
+gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
{
gfc_ss *ss;
tree var;
@@ -9525,16 +9539,6 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr,
bool add_clobber)
[PATCH 03/10] fortran: Move clobbers after evaluation of all arguments [PR106817]
For actual arguments whose dummy is INTENT(OUT), we used to generate
clobbers on them at the same time we generated the argument reference
for the function call. This was wrong if for an argument coming
later, the value expression was depending on the value of the just-
clobbered argument, and we passed an undefined value in that case.
With this change, clobbers are collected separatedly and appended
to the procedure call preliminary code after all the arguments have been
evaluated.
PR fortran/106817
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_conv_procedure_call): Collect all clobbers
to their own separate block. Append the block of clobbers to
the procedure preliminary block after the argument evaluation
codes for all the arguments.
gcc/testsuite/ChangeLog:
* gfortran.dg/intent_optimize_9.f90: New test.
---
gcc/fortran/trans-expr.cc | 6 ++-
.../gfortran.dg/intent_optimize_9.f90 | 43 +++
2 files changed, 47 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/intent_optimize_9.f90
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 76c587e3d9f..a62a3bb642d 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6018,7 +6018,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gfc_charlen cl;
gfc_expr *e;
gfc_symbol *fsym;
- stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
gfc_component *comp = NULL;
int arglen;
@@ -6062,7 +6061,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
else
info = NULL;
+ stmtblock_t post, clobbers;
gfc_init_block ();
+ gfc_init_block ();
gfc_init_interface_mapping ();
if (!comp)
{
@@ -6531,7 +6532,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
var = build_fold_indirect_ref_loc (input_location,
parmse.expr);
tree clobber = build_clobber (TREE_TYPE (var));
- gfc_add_modify (>pre, var, clobber);
+ gfc_add_modify (, var, clobber);
}
}
/* Catch base objects that are not variables. */
@@ -7400,6 +7401,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
vec_safe_push (arglist, parmse.expr);
}
+ gfc_add_block_to_block (>pre, );
gfc_finish_interface_mapping (, >pre, >post);
if (comp)
diff --git a/gcc/testsuite/gfortran.dg/intent_optimize_9.f90
b/gcc/testsuite/gfortran.dg/intent_optimize_9.f90
new file mode 100644
index 000..effbaa12a2d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/intent_optimize_9.f90
@@ -0,0 +1,43 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-final { scan-tree-dump-times "CLOBBER" 2 "original" } }
+!
+! PR fortran/106817
+! Check that for an actual argument whose dummy is INTENT(OUT),
+! the clobber that is emitted in the caller before a procedure call
+! happens after any expression depending on the argument value has been
+! evaluated.
+!
+
+module m
+ implicit none
+contains
+ subroutine copy1(out, in)
+integer, intent(in) :: in
+integer, intent(out) :: out
+out = in
+ end subroutine copy1
+ subroutine copy2(in, out)
+integer, intent(in) :: in
+integer, intent(out) :: out
+out = in
+ end subroutine copy2
+end module m
+
+program p
+ use m
+ implicit none
+ integer :: a, b
+
+ ! Clobbering of a should happen after a+1 has been evaluated.
+ a = 3
+ call copy1(a, a+1)
+ if (a /= 4) stop 1
+
+ ! Clobbering order does not depend on the order of arguments.
+ ! It should also come last with reversed arguments.
+ b = 12
+ call copy2(b+1, b)
+ if (b /= 13) stop 2
+
+end program p
--
2.35.1
[PATCH 4/4] fortran: Use pointer arithmetic to index arrays [PR102043]
The code generated for array references used to be ARRAY_REF trees as
could be expected. However, the middle-end may conclude from those
trees that the indexes used are non-negative (more precisely not below
the lower bound), which is a wrong assumption in the case of "reversed-
order" arrays.
The problematic arrays are those with a descriptor and having a negative
stride for at least one dimension. The descriptor data points to the
first element in array order (which is not the first in memory order in
that case), and the negative stride(s) makes walking the array backwards
(towards lower memory addresses), and we can access elements with
negative index wrt data pointer.
With this change, pointer arithmetic is generated by default for array
references, unless we are in a case where negative indexes can’t happen
(array descriptor’s dim element, substrings, explicit shape,
allocatable, or assumed shape contiguous). A new flag is added to
choose between array indexing and pointer arithmetic, and it’s set
if the context can tell array indexing is safe (descriptor dim
element, substring, temporary array), or a new method is called
to decide on whether the flag should be set for one given array
expression.
PR fortran/102043
gcc/fortran/ChangeLog:
* trans.h (gfc_build_array_ref): Add non_negative_offset
argument.
* trans.cc (gfc_build_array_ref): Ditto. Use pointer arithmetic
if non_negative_offset is false.
* trans-expr.cc (gfc_conv_substring): Set flag in the call to
gfc_build_array_ref.
* trans-array.cc (gfc_get_cfi_dim_item,
gfc_conv_descriptor_dimension): Same.
(build_array_ref): Decide on whether to set the flag and update
the call.
(gfc_conv_scalarized_array_ref): Same. New argument tmp_array.
(gfc_conv_tmp_array_ref): Update call to
gfc_conv_scalarized_ref.
(non_negative_strides_array_p): New function.
gcc/testsuite/ChangeLog:
* gfortran.dg/array_reference_3.f90: New.
* gfortran.dg/negative_stride_1.f90: New.
* gfortran.dg/vector_subscript_8.f90: New.
* gfortran.dg/vector_subscript_9.f90: New.
* gfortran.dg/c_loc_test_22.f90: Update dump patterns.
* gfortran.dg/finalize_10.f90: Same.
Co-Authored-By: Richard Biener
---
gcc/fortran/trans-array.cc| 58 +-
gcc/fortran/trans-expr.cc | 2 +-
gcc/fortran/trans.cc | 42 +++-
gcc/fortran/trans.h | 4 +-
.../gfortran.dg/array_reference_3.f90 | 195 ++
gcc/testsuite/gfortran.dg/c_loc_test_22.f90 | 4 +-
gcc/testsuite/gfortran.dg/finalize_10.f90 | 2 +-
.../gfortran.dg/negative_stride_1.f90 | 25 +++
.../gfortran.dg/vector_subscript_8.f90| 16 ++
.../gfortran.dg/vector_subscript_9.f90| 21 ++
10 files changed, 354 insertions(+), 15 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/array_reference_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/negative_stride_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/vector_subscript_8.f90
create mode 100644 gcc/testsuite/gfortran.dg/vector_subscript_9.f90
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 11e47c0c1ca..e4b6270ccf8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -172,7 +172,7 @@ static tree
gfc_get_cfi_dim_item (tree desc, tree idx, unsigned field_idx)
{
tree tmp = gfc_get_cfi_descriptor_field (desc, CFI_FIELD_DIM);
- tmp = gfc_build_array_ref (tmp, idx, NULL);
+ tmp = gfc_build_array_ref (tmp, idx, NULL_TREE, true);
tree field = gfc_advance_chain (TYPE_FIELDS (TREE_TYPE (tmp)), field_idx);
gcc_assert (field != NULL_TREE);
return fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
@@ -424,7 +424,7 @@ gfc_conv_descriptor_dimension (tree desc, tree dim)
tmp = gfc_get_descriptor_dimension (desc);
- return gfc_build_array_ref (tmp, dim, NULL);
+ return gfc_build_array_ref (tmp, dim, NULL_TREE, true);
}
@@ -3664,10 +3664,51 @@ build_class_array_ref (gfc_se *se, tree base, tree
index)
}
+/* Indicates that the tree EXPR is a reference to an array that can’t
+ have any negative stride. */
+
+static bool
+non_negative_strides_array_p (tree expr)
+{
+ if (expr == NULL_TREE)
+return false;
+
+ tree type = TREE_TYPE (expr);
+ if (POINTER_TYPE_P (type))
+type = TREE_TYPE (type);
+
+ if (TYPE_LANG_SPECIFIC (type))
+{
+ gfc_array_kind array_kind = GFC_TYPE_ARRAY_AKIND (type);
+
+ if (array_kind == GFC_ARRAY_ALLOCATABLE
+ || array_kind == GFC_ARRAY_ASSUMED_SHAPE_CONT)
+ return true;
+}
+
+ /* An array with descriptor can have negative strides.
+ We try to be conservative and return false by default here
+ if we don’t recognize a contiguous array instead of
+ returning false if we can identify a non-contiguous
[PATCH 3/4] fortran: Generate an array temporary reference [PR102043]
This avoids regressing on char_cast_1.f90 and char_cast_2.f90 later in
the patch series when the code generation for array references is
changed to use pointer arithmetic.
The regressing testcases match part of an array reference in the
generated tree dump and it’s not clear how the pattern should be
rewritten to match the equivalent with pointer arithmetic.
This change uses a method specific to array temporaries to generate
array-references, so that these array references are flagged as safe
for array indexing and will not be updated to use pointer arithmetic.
PR fortran/102043
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_expr_descriptor): Use
gfc_conv_tmp_array_ref.
---
gcc/fortran/trans-array.cc | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index b3f8871ff22..11e47c0c1ca 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7723,7 +7723,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
lse.ss = loop.temp_ss;
rse.ss = ss;
- gfc_conv_scalarized_array_ref (, NULL);
+ gfc_conv_tmp_array_ref ();
if (expr->ts.type == BT_CHARACTER)
{
gfc_conv_expr (, expr);
--
2.35.1
[PATCH 2/4] fortran: Update index extraction code. [PR102043]
This avoids a regression on hollerith4.f90 and hollerith6.f90 later in
the patch series when code generation for array references is changed
to use pointer arithmetic.
The problem comes from the extraction of the array index from an
ARRAY_REF tree, which doesn’t work if the tree is not an ARRAY_REF
any more.
This updates the code generated for remaining size evaluation to work
with a source tree that uses either array indexing or pointer
arithmetic.
PR fortran/102043
gcc/fortran/ChangeLog:
* trans-io.cc: Add handling for the case where the array
is referenced using pointer arithmetic.
---
gcc/fortran/trans-io.cc | 48 +++--
1 file changed, 37 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 732221f848b..9f86815388c 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -737,7 +737,6 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t
*postblock,
static void
gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
{
- tree size;
if (e->rank == 0)
{
@@ -755,12 +754,13 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
array = sym->backend_decl;
type = TREE_TYPE (array);
+ tree elts_count;
if (GFC_ARRAY_TYPE_P (type))
- size = GFC_TYPE_ARRAY_SIZE (type);
+ elts_count = GFC_TYPE_ARRAY_SIZE (type);
else
{
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
- size = gfc_conv_array_stride (array, rank);
+ tree stride = gfc_conv_array_stride (array, rank);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
gfc_array_index_type,
gfc_conv_array_ubound (array, rank),
@@ -768,23 +768,49 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
tmp = fold_build2_loc (input_location, PLUS_EXPR,
gfc_array_index_type, tmp,
gfc_index_one_node);
+ elts_count = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, stride);
+ }
+ gcc_assert (elts_count);
+
+ tree elt_size = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+ elt_size = fold_convert (gfc_array_index_type, elt_size);
+
+ tree size;
+ if (TREE_CODE (se->expr) == ARRAY_REF)
+ {
+ tree index = TREE_OPERAND (se->expr, 1);
+ index = fold_convert (gfc_array_index_type, index);
+
+ elts_count = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ elts_count, index);
+
size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, tmp, size);
+ gfc_array_index_type, elts_count, elt_size);
+ }
+ else
+ {
+ gcc_assert (TREE_CODE (se->expr) == INDIRECT_REF);
+ tree ptr = TREE_OPERAND (se->expr, 0);
+
+ gcc_assert (TREE_CODE (ptr) == POINTER_PLUS_EXPR);
+ tree offset = fold_convert_loc (input_location, gfc_array_index_type,
+ TREE_OPERAND (ptr, 1));
+
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, elts_count, elt_size);
+ size = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, size, offset);
}
gcc_assert (size);
- size = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, size,
- TREE_OPERAND (se->expr, 1));
se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
- tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- fold_convert (gfc_array_index_type, tmp));
se->string_length = fold_convert (gfc_charlen_type_node, size);
return;
}
+ tree size;
gfc_conv_array_parameter (se, e, true, NULL, NULL, );
se->string_length = fold_convert (gfc_charlen_type_node, size);
}
--
2.35.1
[PATCH 1/4] fortran: Pre-evaluate string pointers. [PR102043]
This avoids a regression on deferred_character_23.f90 later in the
patch series when array references are rewritten to use pointer
arithmetic.
The problem is a SAVE_EXPR tree as TYPE_SIZE_UNIT of one array element
type, which is used by the pointer arithmetic expressions. As these
expressions appear in both branches of an if-then-else block, the tree
is lowered to a variable in one of the branches but it’s used in both
branches, which is invalid middle-end code.
This change pre-evaluates the array references or pointer arithmetics
to variables before the if-then-else block, so that the SAVE_EXPR are
expanded to variables in the parent scope of the if-then-else block,
and expressions referencing the variables remain valid in both
branches.
PR fortran/102043
gcc/fortran/ChangeLog:
* trans-expr.cc: Pre-evaluate src and dest to variables
before using them.
gcc/testsuite/ChangeLog:
* gfortran.dg/dependency_49.f90: Update variable occurence
count.
---
gcc/fortran/trans-expr.cc | 7 +++
gcc/testsuite/gfortran.dg/dependency_49.f90 | 3 ++-
2 files changed, 9 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 06713f24f95..3962b6848ce 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8093,6 +8093,13 @@ gfc_trans_string_copy (stmtblock_t * block, tree
dlength, tree dest,
cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node, slen,
dlen);
+ /* Pre-evaluate pointers unless one of the IF arms will be optimized away.
*/
+ if (!CONSTANT_CLASS_P (cond2))
+{
+ dest = gfc_evaluate_now (dest, block);
+ src = gfc_evaluate_now (src, block);
+}
+
/* Copy and pad with spaces. */
tmp3 = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMMOVE),
diff --git a/gcc/testsuite/gfortran.dg/dependency_49.f90
b/gcc/testsuite/gfortran.dg/dependency_49.f90
index 73d517e8f76..9638f65c069 100644
--- a/gcc/testsuite/gfortran.dg/dependency_49.f90
+++ b/gcc/testsuite/gfortran.dg/dependency_49.f90
@@ -11,4 +11,5 @@ program main
a%x = a%x(2:3)
print *,a%x
end program main
-! { dg-final { scan-tree-dump-times "__var_1" 4 "original" } }
+! The temporary var appears three times: declaration, copy-in and copy-out
+! { dg-final { scan-tree-dump-times "__var_1" 3 "original" } }
--
2.35.1
[PATCH 0/4] Use pointer arithmetic for array references [PR102043]
Hello, this is a fix for PR102043, which is a wrong code bug caused by the middle-end concluding from array indexing that the array index is non-negative. This is a wrong assumption for "reversed arrays", that is arrays whose descriptor makes accesses to the array from last element to first element. More generally the wrong cases are arrays with a descriptor having a negative stride for at least one dimension. I have been trying to fix this by stopping the front-end from generating bogus code, by either stripping array-ness from descriptor data pointers, or by changing the initialization of data pointers to point to the first element in memory order instead of the first element in access order (which is the last in memory order for reversed arrays). Both ways are very impacting changes to the frontend and I haven’t been able to eliminate all the regressions in time using either way. However, Richi showed with a patch attached to the PR that array references are crucial for the problem to appear, and everything works if array indexing is replaced with pointer arithmetic. This is much simpler and doesn’t imply invasive changes to the frontend. I have built on top of his patch to keep the array indexing in cases where the change to pointer arithmetic is not necessary, either because the array is not a fortran array with a descriptor, or because it’s known to be contiguous. This has the benefit of reducing the churn in the dumped code patterns used in the testsuite. It also avoids ICE regression such as interface_12.f90 or result_in_spec.f90, but I can’t exclude that those could be a real problem made latent. Patches 1 to 3 are preliminary changes to avoid regressions. The main change is number 4, the last in the series. Regression tested on x86_64-pc-linux-gnu. OK for master? Mikael Morin (4): fortran: Pre-evaluate string pointers. [PR102043] fortran: Update index extraction code. [PR102043] fortran: Generate an array temporary reference [PR102043] fortran: Use pointer arithmetic to index arrays [PR102043] gcc/fortran/trans-array.cc| 60 +- gcc/fortran/trans-expr.cc | 9 +- gcc/fortran/trans-io.cc | 48 - gcc/fortran/trans.cc | 42 +++- gcc/fortran/trans.h | 4 +- .../gfortran.dg/array_reference_3.f90 | 195 ++ gcc/testsuite/gfortran.dg/c_loc_test_22.f90 | 4 +- gcc/testsuite/gfortran.dg/dependency_49.f90 | 3 +- gcc/testsuite/gfortran.dg/finalize_10.f90 | 2 +- .../gfortran.dg/negative_stride_1.f90 | 25 +++ .../gfortran.dg/vector_subscript_8.f90| 16 ++ .../gfortran.dg/vector_subscript_9.f90| 21 ++ 12 files changed, 401 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_reference_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/negative_stride_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/vector_subscript_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/vector_subscript_9.f90 -- 2.35.1
[pushed 3/3] testsuite: Enrich tests with variants failing on the branch.
Backporting the fix for pr103789 on the 11 branch revealed a lack of test coverage for the tests provided with that fix. Indeed, the tests use the KIND argument of the respective intrinsics only with keyword arguments. This adds variants with non-keyword arguments. The tests enriched this way fail on the branch if the fix is cherry-picked straightforwardly. The fix will have to be tweaked slightly there. PR fortran/103789 PR fortran/87711 PR fortran/97896 gcc/testsuite/ChangeLog: * gfortran.dg/maskl_1.f90: Enrich test with usages of MASKL with a non-keyword KIND argument. * gfortran.dg/maskr_1.f90: Same for MASKR. * gfortran.dg/scan_3.f90: Same for SCAN. * gfortran.dg/verify_3.f90: Same for VERIFY. (cherry picked from commit 15630e6e9eb019477d1fc5c0966b43979e18ae18) --- gcc/testsuite/gfortran.dg/maskl_1.f90 | 3 ++- gcc/testsuite/gfortran.dg/maskr_1.f90 | 3 ++- gcc/testsuite/gfortran.dg/scan_3.f90 | 5 - gcc/testsuite/gfortran.dg/verify_3.f90 | 5 - 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/maskl_1.f90 b/gcc/testsuite/gfortran.dg/maskl_1.f90 index 9e25c2c9cdc..56350e269da 100644 --- a/gcc/testsuite/gfortran.dg/maskl_1.f90 +++ b/gcc/testsuite/gfortran.dg/maskl_1.f90 @@ -4,7 +4,8 @@ ! Check the absence of ICE when generating calls to MASKL with a KIND argument. program p - integer :: z(2), y(2) + integer :: z(2), y(2), x(2) y = [1, 13] z = maskl(y, kind=4) + 1 + x = maskl(y, 4) + 1 end program p diff --git a/gcc/testsuite/gfortran.dg/maskr_1.f90 b/gcc/testsuite/gfortran.dg/maskr_1.f90 index ebfd3dbba33..f8ccdd11ab3 100644 --- a/gcc/testsuite/gfortran.dg/maskr_1.f90 +++ b/gcc/testsuite/gfortran.dg/maskr_1.f90 @@ -4,7 +4,8 @@ ! Check the absence of ICE when generating calls to MASKR with a KIND argument. program p - integer :: z(2), y(2) + integer :: z(2), y(2), x(2) y = [1, 13] z = maskr(y, kind=4) + 1 + x = maskr(y, 4) + 1 end program p diff --git a/gcc/testsuite/gfortran.dg/scan_3.f90 b/gcc/testsuite/gfortran.dg/scan_3.f90 index 80262ae2167..2a9ed080957 100644 --- a/gcc/testsuite/gfortran.dg/scan_3.f90 +++ b/gcc/testsuite/gfortran.dg/scan_3.f90 @@ -5,7 +5,10 @@ program p character(len=10) :: y(2) - integer :: z(2) + integer :: z(2), x(2), w(2), v(2) y = ['abc', 'def'] z = scan(y, 'e', kind=4) + 1 + x = scan(y, 'e', back=.false., kind=4) + 1 + w = scan(y, 'e', .false., kind=4) + 1 + v = scan(y, 'e', .false., 4) + 1 end program p diff --git a/gcc/testsuite/gfortran.dg/verify_3.f90 b/gcc/testsuite/gfortran.dg/verify_3.f90 index f01e24e199e..c8b26b70614 100644 --- a/gcc/testsuite/gfortran.dg/verify_3.f90 +++ b/gcc/testsuite/gfortran.dg/verify_3.f90 @@ -5,7 +5,10 @@ program p character(len=10) :: y(2) - integer :: z(2) + integer :: z(2), x(2), w(2), v(2) y = ['abc', 'def'] z = verify(y, 'e', kind=4) + 1 + x = verify(y, 'e', back=.false., kind=4) + 1 + w = verify(y, 'e', .false., kind=4) + 1 + x = verify(y, 'e', .false., 4) + 1 end program p
[pushed 2/3] Fortran: Ignore KIND argument of a few more intrinsics. [PR103789]
After PR97896 for which some code was added to ignore the KIND argument
of the INDEX intrinsics, and PR87711 for which that was extended to LEN_TRIM
as well, this propagates it further to MASKL, MASKR, SCAN and VERIFY.
PR fortran/103789
gcc/fortran/ChangeLog:
* trans-array.c (arg_evaluated_for_scalarization): Add MASKL, MASKR,
SCAN and VERIFY to the list of intrinsics whose KIND argument is to be
ignored.
gcc/testsuite/ChangeLog:
* gfortran.dg/maskl_1.f90: New test.
* gfortran.dg/maskr_1.f90: New test.
* gfortran.dg/scan_3.f90: New test.
* gfortran.dg/verify_3.f90: New test.
(cherry picked from commit c1c17a43e172ebc28f2cd247f6e83c5fdbc6219f)
---
gcc/fortran/trans-array.c | 4
gcc/testsuite/gfortran.dg/maskl_1.f90 | 10 ++
gcc/testsuite/gfortran.dg/maskr_1.f90 | 10 ++
gcc/testsuite/gfortran.dg/scan_3.f90 | 11 +++
gcc/testsuite/gfortran.dg/verify_3.f90 | 11 +++
5 files changed, 46 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/maskl_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/maskr_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/scan_3.f90
create mode 100644 gcc/testsuite/gfortran.dg/verify_3.f90
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index e187a08f8f0..308213c57e3 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11225,11 +11225,15 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
switch (function->id)
{
case GFC_ISYM_INDEX:
+ case GFC_ISYM_SCAN:
+ case GFC_ISYM_VERIFY:
if (arg_num == 3)
return false;
break;
case GFC_ISYM_LEN_TRIM:
+ case GFC_ISYM_MASKL:
+ case GFC_ISYM_MASKR:
if (arg_num == 1)
return false;
diff --git a/gcc/testsuite/gfortran.dg/maskl_1.f90 b/gcc/testsuite/gfortran.dg/maskl_1.f90
new file mode 100644
index 000..9e25c2c9cdc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maskl_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/103789
+! Check the absence of ICE when generating calls to MASKL with a KIND argument.
+
+program p
+ integer :: z(2), y(2)
+ y = [1, 13]
+ z = maskl(y, kind=4) + 1
+end program p
diff --git a/gcc/testsuite/gfortran.dg/maskr_1.f90 b/gcc/testsuite/gfortran.dg/maskr_1.f90
new file mode 100644
index 000..ebfd3dbba33
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maskr_1.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+!
+! PR fortran/103789
+! Check the absence of ICE when generating calls to MASKR with a KIND argument.
+
+program p
+ integer :: z(2), y(2)
+ y = [1, 13]
+ z = maskr(y, kind=4) + 1
+end program p
diff --git a/gcc/testsuite/gfortran.dg/scan_3.f90 b/gcc/testsuite/gfortran.dg/scan_3.f90
new file mode 100644
index 000..80262ae2167
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/scan_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/103789
+! Check the absence of ICE when generating calls to SCAN with a KIND argument.
+
+program p
+ character(len=10) :: y(2)
+ integer :: z(2)
+ y = ['abc', 'def']
+ z = scan(y, 'e', kind=4) + 1
+end program p
diff --git a/gcc/testsuite/gfortran.dg/verify_3.f90 b/gcc/testsuite/gfortran.dg/verify_3.f90
new file mode 100644
index 000..f01e24e199e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/verify_3.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+! PR fortran/103789
+! Check the absence of ICE when generating calls to VERIFY with a KIND argument.
+
+program p
+ character(len=10) :: y(2)
+ integer :: z(2)
+ y = ['abc', 'def']
+ z = verify(y, 'e', kind=4) + 1
+end program p
[pushed 1/3] Fortran: Fix KIND argument index for LEN_TRIM.
The mainline code to check whether an argument has to be included in
scalarization uses only the name of a dummy argument object to recognize a
specific argument of an intrinsic procedure. On the 11 branch, the dummy
argument object is not available and the code uses a mix of check for
argument name (for keyword arguments) and argument index (for non-keyword ones).
This makes backports non-straightforward in this area, as the argument indexes
depend on the intrinsics.
This change fixes a bogus backport for LEN_TRIM, whose KIND argument index
should be different from that of INDEX.
PR fortran/87711
PR fortran/97896
gcc/fortran/ChangeLog:
* trans-array.c (arg_evaluated_for_scalarization): Handle keyword and
non-keyword arguments separatedly. Adapt the expected argument index
for KIND to each intrinsic in the non-keyword case.
gcc/testsuite/ChangeLog:
* gfortran.dg/index_5.f90: Enrich test with usages of INDEX with
a non-keyword KIND argument.
* gfortran.dg/len_trim.f90: Same for LEN_TRIM.
(tests cherry picked from commit 15630e6e9eb019477d1fc5c0966b43979e18ae18)
---
gcc/fortran/trans-array.c | 41 +++---
gcc/testsuite/gfortran.dg/index_5.f90 | 2 ++
gcc/testsuite/gfortran.dg/len_trim.f90 | 6
3 files changed, 39 insertions(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index db14daca459..e187a08f8f0 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11220,18 +11220,39 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
{
if (function != NULL)
{
- switch (function->id)
+ if (actual_arg.name == NULL)
{
- case GFC_ISYM_INDEX:
- case GFC_ISYM_LEN_TRIM:
- if ((actual_arg.name == NULL && arg_num == 3)
- || (actual_arg.name != NULL
- && strcmp ("kind", actual_arg.name) == 0))
- return false;
- /* Fallthrough. */
+ switch (function->id)
+ {
+ case GFC_ISYM_INDEX:
+ if (arg_num == 3)
+ return false;
+ break;
- default:
- break;
+ case GFC_ISYM_LEN_TRIM:
+ if (arg_num == 1)
+ return false;
+
+ /* Fallthrough. */
+
+ default:
+ break;
+ }
+ }
+ else
+ {
+ switch (function->id)
+ {
+ case GFC_ISYM_INDEX:
+ case GFC_ISYM_LEN_TRIM:
+ if (strcmp ("kind", actual_arg.name) == 0)
+ return false;
+
+ /* Fallthrough. */
+
+ default:
+ break;
+ }
}
}
diff --git a/gcc/testsuite/gfortran.dg/index_5.f90 b/gcc/testsuite/gfortran.dg/index_5.f90
index e039455d175..4dc2ce4c0a1 100644
--- a/gcc/testsuite/gfortran.dg/index_5.f90
+++ b/gcc/testsuite/gfortran.dg/index_5.f90
@@ -19,5 +19,7 @@ program p
d = index ('xyxyz','yx', back=a, kind=8)
b = index ('xyxyz','yx', back=a, kind=8)
d = index ('xyxyz','yx', back=a, kind=4)
+ b = index ('xyxyz','yx', a, 4)
+ d = index ('xyxyz','yx', a, 8)
end
diff --git a/gcc/testsuite/gfortran.dg/len_trim.f90 b/gcc/testsuite/gfortran.dg/len_trim.f90
index 2252b81f084..77e3d30c669 100644
--- a/gcc/testsuite/gfortran.dg/len_trim.f90
+++ b/gcc/testsuite/gfortran.dg/len_trim.f90
@@ -17,11 +17,17 @@ program main
kk = len_trim (a)
mm = len_trim (a, kind=4)
nn = len_trim (a, kind=8)
+ mm = len_trim (a, 4)
+ nn = len_trim (a, 8)
kk = len_trim ([b])
mm = len_trim ([b],kind=4)
nn = len_trim ([b],kind=8)
+ mm = len_trim ([b], 4)
+ nn = len_trim ([b], 8)
kk = len_trim (c)
mm = len_trim (c, kind=4)
nn = len_trim (c, kind=8)
+ mm = len_trim (c, 4)
+ nn = len_trim (c, 8)
if (any (l4 /= 2_4) .or. any (l8 /= 2_8)) stop 1
end program main
[pushed 0/3][gcc11] fortran: Backpoprt KIND arg of intrinsics fix [PR103789]
Hello, I noticed a bug while backporting the fix for PR103789 on the 11 branch. It makes the cherry-pick not exactly straightforward. The bug is fixed in the first patch, the backport comes in the second, and additional test coverage (pushed earlier today on master) is added in the third. Tested on x86_64-linux on the 11 branch, pushed. Mikael Morin (3): Fortran: Fix KIND argument index for LEN_TRIM. Fortran: Ignore KIND argument of a few more intrinsics. [PR103789] testsuite: Enrich tests with variants failing on the branch. gcc/fortran/trans-array.c | 45 -- gcc/testsuite/gfortran.dg/index_5.f90 | 2 ++ gcc/testsuite/gfortran.dg/len_trim.f90 | 6 gcc/testsuite/gfortran.dg/maskl_1.f90 | 11 +++ gcc/testsuite/gfortran.dg/maskr_1.f90 | 11 +++ gcc/testsuite/gfortran.dg/scan_3.f90 | 14 gcc/testsuite/gfortran.dg/verify_3.f90 | 14 7 files changed, 93 insertions(+), 10 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/maskl_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/maskr_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/scan_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/verify_3.f90 -- 2.34.1
[PATCH v3 5/5] fortran: Identify arguments by their names
This provides a new function to get the name of a dummy argument,
so that identifying an argument can be made using just its name
instead of a mix of name matching (for keyword actual arguments)
and argument counting (for other actual arguments).
gcc/fortran/ChangeLog:
* interface.c (gfc_dummy_arg_get_name): New function.
* gfortran.h (gfc_dummy_arg_get_name): Declare it.
* trans-array.c (arg_evaluated_for_scalarization): Pass a dummy
argument wrapper as argument instead of an actual argument
and an index number. Check it’s non-NULL. Use its name
to identify it.
(gfc_walk_elemental_function_args): Update call to
arg_evaluated for scalarization. Remove argument counting.
---
gcc/fortran/gfortran.h| 1 +
gcc/fortran/interface.c | 17 +
gcc/fortran/trans-array.c | 16 +---
3 files changed, 23 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4879805ff0b..ac4b3a8b6d4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2328,6 +2328,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 36b7a852066..d87088f988d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -5500,6 +5500,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.intrinsicness)
+{
+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 d37c1e7ad7f..2090adf01e7 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11492,16 +11492,14 @@ gfc_get_intrinsic_for_expr (gfc_expr *call)
static bool
arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
- gfc_actual_arglist _arg, int arg_num)
+ gfc_dummy_arg *dummy_arg)
{
- if (function != NULL)
+ if (function != NULL && dummy_arg != 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))
+ if (strcmp ("kind", gfc_dummy_arg_get_name (*dummy_arg)) == 0)
return false;
/* Fallthrough. */
@@ -11532,15 +11530,14 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
head = gfc_ss_terminator;
tail = NULL;
- int arg_num = 0;
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
- || !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num))
- goto loop_continue;
+ || !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg))
+ continue;
newss = gfc_walk_subexpr (head, arg->expr);
if (newss == head)
@@ -11570,9 +11567,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
while (tail->next != gfc_ss_terminator)
tail = tail->next;
}
-
-loop_continue:
- arg_num++;
}
if (scalar)
[PATCH 2/2] 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
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
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 _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
[PATCH 1/2] Revert "Remove KIND argument from INDEX so it does not mess up scalarization."
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(-)
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 7511df1..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,
[PATCH 0/2] fortran: Ignore unused arguments for scalarisation [PR97896]
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 v3 3/5] fortran: simplify elemental arguments walking
This adds two functions working with the wrapper struct 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/ChangeLog:
* 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 | 19 ++-
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, 48 insertions(+), 39 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d678c6b56dc..7e76e482b98 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2333,6 +2333,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 c4ec0d89a58..db0b3b01b8c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -5503,3 +5503,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.intrinsicness)
+{
+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.intrinsicness)
+{
+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 79321854498..d37c1e7ad7f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3010,7 +3010,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;
@@ -11521,9 +11522,8 @@ arg_evaluated_for_scalarization (gfc_intrinsic_sym *function,
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_ss_type type)
{
- gfc_formal_arglist *dummy_arg;
int scalar;
gfc_ss *head;
gfc_ss *tail;
@@ -11532,15 +11532,11 @@ 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;
-
int arg_num = 0;
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
|| !arg_evaluated_for_scalarization (intrinsic_sym, *arg, arg_num))
@@ -11554,13 +11550,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)
-
[PATCH v3 4/5] 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/ChangeLog:
* 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(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7e76e482b98..4879805ff0b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1210,11 +1210,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 db0b3b01b8c..36b7a852066 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3681,11 +3681,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 f6d061a847c..3018315ed78 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4405,10 +4405,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 e7aec3845d3..bc502c0f43c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6157,7 +6157,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);
}
@@ -6174,7 +6177,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|| !CLASS_DATA (fsym)->attr.allocatable));
gfc_init_se (, 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
[PATCH v3 2/5] 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 from gfc_intrinsic_arg and adds instead
a new field associated_dummy in gfc_actual_arglist.
The new field has as type a new wrapper struct 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).
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/ChangeLog:
* gfortran.h (gfc_dummy_arg_kind, gfc_dummy_arg): New.
(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 | 31 +++--
gcc/fortran/interface.c | 21 ++--
gcc/fortran/intrinsic.c | 43 ++---
3 files changed, 80 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8c11cf6d18d..d678c6b56dc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1199,6 +1199,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
@@ -1215,6 +1218,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;
@@ -2298,14 +2306,33 @@ 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;
-
}
gfc_intrinsic_arg;
+typedef enum {
+ GFC_UNDEFINED_DUMMY_ARG = 0,
+ GFC_INTRINSIC_DUMMY_ARG,
+ GFC_NON_INTRINSIC_DUMMY_ARG
+}
+gfc_dummy_arg_intrinsicness;
+
+/* dummy arg of either an intrinsic or a user-defined procedure. */
+struct gfc_dummy_arg
+{
+ gfc_dummy_arg_intrinsicness intrinsicness;
+
+ union {
+gfc_intrinsic_arg *intrinsic;
+gfc_formal_arglist *non_intrinsic;
+ } 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
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 24698be8364..c4ec0d89a58 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3043,6 +3043,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->intrinsicness = 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
@@ -3150,6 +3162,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)
{
@@ -3646,9 +3660,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 ();
+
[PATCH v3 0/5] fortran: Ignore unused arguments for scalarisation [PR97896]
Hello, This is the third submit of this patch series. After submitting the v2 [2] for master, and a somewhat different variant for backport [3], I thought it was defeating the purpose of the backporting process. So I have decided to rebase the master patches on the backport patches, so that the backport patchs can get some testing on master first. 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 patches put the workaround where I think it is more appropriate, namely at the beginning of the scalarisation procedure. That’s what is done by the series [3] initially intended for backport only, and now for master too. This series is a followup to them. What are left in this series are a couple of refactoring for the master branch only. They aim at being able to identify the KIND argument of the INDEX intrinsic by its name, rather than counting the right number of next->next->next indirections starting with the first argument. It may seem overkill for just this use case, but I think it’s worth having that facility in the long term. Regression-tested on x86_64-linux-gnu. Ok for master? Changes from v2 [2]: Rebase on the backport variant of the series. Changes from v1 [1]: Use C structs and enums instead of C++ classes. [1] https://gcc.gnu.org/pipermail/fortran/2021-August/056303.html [2] https://gcc.gnu.org/pipermail/fortran/2021-August/056317.html [3] https://gcc.gnu.org/pipermail/fortran/2021-August/056329.html Mikael Morin (5): 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 fortran: Identify arguments by their names gcc/fortran/gfortran.h| 41 +++ gcc/fortran/interface.c | 77 +++ gcc/fortran/intrinsic.c | 53 gcc/fortran/trans-array.c | 35 +--- gcc/fortran/trans-array.h | 2 +- gcc/fortran/trans-expr.c | 9 +++- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans-stmt.c | 22 -- gcc/fortran/trans.h | 4 +- 9 files changed, 161 insertions(+), 84 deletions(-) -- 2.33.0
[PATCH v3 1/5] fortran: Tiny sort_actual internal refactoring
Preliminary refactoring to make further changes more obvious.
No functional change.
gcc/fortran/ChangeLog:
* 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 a6a18a471e3..49ef3b2a3d2 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4378,19 +4378,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/2] 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 219f04f2317..577e25a7671 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 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 0/2] fortran: Ignore unused arguments for scalarisation [PR97896]
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
[PATCH 2/2] 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
* 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/
PR fortran/97896
* 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
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c5d61f0065c..aae79c8cbd4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -11177,6 +11177,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 _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.
@@ -11184,6 +11237,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;
@@ -11200,10 +11254,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);
@@ -11236,6 +11293,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;
}
@@ -11296,6 +11354,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
[PATCH v2 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
* 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
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
+
[PATCH v2 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 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,
+
[PATCH v2 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 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(-)
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 (, 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
[PATCH v2 4/7] fortran: simplify elemental arguments walking
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(-)
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 =
[PATCH v2 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 (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(-)
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
[PATCH v2 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 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;
[PATCH v2 1/7] fortran: new wrapper class gfc_dummy_arg
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(-)
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
[PATCH v2 0/7] fortran: Ignore unused arguments for scalarisation [PR97896]
Hello, This is the second submit of a patch series whose first version[1] was not welcome because of its C++ usage. After some thought I figured out that rewriting the series without C++ features would not be that impacting after all. So here you go, the (not so) good old-fashioned way. 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. 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? [1] https://gcc.gnu.org/pipermail/fortran/2021-August/056303.html Mikael Morin (7): fortran: new wrapper 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| 41 +-- gcc/fortran/interface.c | 77 ++-- gcc/fortran/intrinsic.c | 101 +++--- gcc/fortran/intrinsic.h | 3 +- gcc/fortran/iresolve.c| 21 +- gcc/fortran/trans-array.c | 74 ++- gcc/fortran/trans-array.h | 5 +- gcc/fortran/trans-decl.c | 24 +- gcc/fortran/trans-expr.c | 9 ++- 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 ++ 13 files changed, 262 insertions(+), 153 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/index_5.f90 -- 2.30.2
[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",
[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 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 (, 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 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, >declared_at);
}
+
+
+const gfc_typespec &
+gfc_intrinsic_arg::get_typespec () const
+{
+ return ts;
+}
+
+bool
+gfc_intrinsic_arg::is_optional () const
+{
+ return optional;
+}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 6d61bf4982b..59f0d0385a0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -5259,3 +5259,16 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
return dummies;
}
+
+
+const gfc_typespec &
+gfc_formal_arglist::get_typespec () const
+{
+ return sym->ts;
+}
+
+bool
+gfc_formal_arglist::is_optional () const
+{
+ return sym->attr.optional;
+}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0d013defdbb..7d85abb181f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2879,7 +2879,7 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info)
/* If the expression is of polymorphic type, it's actual size is not known,
so we avoid copying it anywhere. */
if (ss_info->data.scalar.dummy_arg
- && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS
+ && ss_info->data.scalar.dummy_arg->get_typespec ().type == BT_CLASS
&& ss_info->expr->ts.type == BT_CLASS)
return true;
@@ -11207,9 +11207,8 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref)
gfc_ss *
gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg,
- gfc_symbol *proc_ifc, gfc_ss_type type)
+ gfc_ss_type type)
{
- gfc_formal_arglist *dummy_arg;
int scalar;
gfc_ss *head;
[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 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 (, );
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 (, );
- 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 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 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
