[gcc] Deleted branch 'mikael/heads/pr99798_v66' in namespace 'refs/users'
The branch 'mikael/heads/pr99798_v66' in namespace 'refs/users' was deleted. It previously pointed to: 4b2e3dff5615... fortran: Fix leaked symbol Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 4b2e3df... fortran: Fix leaked symbol 934742d... fortran: Assume there is no cyclic reference with submodule
[gcc] Deleted branch 'mikael/heads/dummy_back_minmaxloc_final02' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_final02' in namespace 'refs/users' was deleted. It previously pointed to: 40122a405386... fortran: Support optional dummy as BACK argument of MINLOC/ Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 40122a4... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc] Deleted branch 'mikael/heads/dummy_back_minmaxloc_v01' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_v01' in namespace 'refs/users' was deleted. It previously pointed to: baba12c6c972... fortran: Support optional dummy as BACK argument of MINLOC/ Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- baba12c... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc] Deleted branch 'mikael/heads/dummy_back_minmaxloc_final' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_final' in namespace 'refs/users' was deleted. It previously pointed to: 999b16301553... fortran: Support optional dummy as BACK argument of MINLOC/ Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 999b163... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc r15-2701] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:a10436a8404ad2f0cc5aa4d6a0cc850abe5ef49e
commit r15-2701-ga10436a8404ad2f0cc5aa4d6a0cc850abe5ef49e
Author: Mikael Morin
Date: Fri Aug 2 14:24:34 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 83 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 801 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..150cb9ff963b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,29 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ /* This should have been checked already by
+maybe_absent_optional_variable. */
+ gcc_checking_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+ gfc_add_block_to_block (>pre, );
+ back = gfc_evaluate_now_loc (input_location, back, >pre);
+ gfc_add_block_to_block
[gcc(refs/users/mikael/heads/dummy_back_minmaxloc_final02)] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:40122a405386a8b67c11bbaad523ffce5c1c7855
commit 40122a405386a8b67c11bbaad523ffce5c1c7855
Author: Mikael Morin
Date: Fri Aug 2 14:24:34 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 83 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 801 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..150cb9ff963b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,29 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ /* This should have been checked already by
+maybe_absent_optional_variable. */
+ gcc_checking_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+ gfc_add_block_to_block (>pre, );
+ back = gfc_evaluate_now_loc (input_location, back, >pre);
+ gfc_add_block_to_block (>pre, );
[gcc] Created branch 'mikael/heads/dummy_back_minmaxloc_final02' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_final02' was created in namespace 'refs/users' pointing to: 40122a405386... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc(refs/users/mikael/heads/dummy_back_minmaxloc_final)] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:999b16301553cce5778173fca530722ba5a8bf73
commit 999b16301553cce5778173fca530722ba5a8bf73
Author: Mikael Morin
Date: Fri Aug 2 14:24:34 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 83 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 801 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..11d4503d401c 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,29 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ /* This should have been checked already by
+ maybe_absent_optional_variable. */
+ gcc_checking_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+ gfc_add_block_to_block (>pre, );
+ back = gfc_evaluate_now_loc (input_location, back, >pre);
+ gfc_add_block_to_block (>pre, );
[gcc] Created branch 'mikael/heads/dummy_back_minmaxloc_final' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_final' was created in namespace 'refs/users' pointing to: 999b16301553... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc] Deleted branch 'mikael/heads/fortran-dev' in namespace 'refs/users'
The branch 'mikael/heads/fortran-dev' in namespace 'refs/users' was deleted. It previously pointed to: d089c4a37a7f... Merge from trunk (r239915 to r240230)
[gcc] Deleted branch 'mikael/heads/backport_103789' in namespace 'refs/users'
The branch 'mikael/heads/backport_103789' in namespace 'refs/users' was deleted. It previously pointed to: 1791f19b8c5f... Fortran: Fix KIND argument index for LEN_TRIM. Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 1791f19... Fortran: Fix KIND argument index for LEN_TRIM. 6b52847... Fortran: Ignore KIND argument of a few more intrinsics. [PR
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Continue MINLOC/MAXLOC second loop where the first stopped [PR90608]
https://gcc.gnu.org/g:b8a4ddbd04b3137ab6c7fb9e377f7e8573f75062
commit b8a4ddbd04b3137ab6c7fb9e377f7e8573f75062
Author: Mikael Morin
Date: Wed Jul 31 10:11:02 2024 +0200
fortran: Continue MINLOC/MAXLOC second loop where the first stopped
[PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Continue the second set of loops where the first one stopped in the
generated inline MINLOC/MAXLOC code in the cases where the generated code
contains two sets of loops. This fixes a regression that was introduced
when enabling the generation of inline MINLOC/MAXLOC code with ARRAY of rank
greater than 1, no DIM argument, and either non-scalar MASK or floating-
point ARRAY.
In the cases where two sets of loops are generated as inline MINLOC/MAXLOC
code, we previously generated code such as (for rank 2 ARRAY, so with two
levels of nesting):
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in lower1..upper1)
{
for (idx22 in lower2..upper2)
{
...
}
}
which means we process the first elements twice, once in the first set
of loops and once in the second one. This change avoids this duplicate
processing by using a conditional as lower bound for the second set of
loops, generating code like:
second_loop_entry = false;
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
second_loop_entry = true;
goto second_loop;
}
}
}
second_loop:
for (idx21 in (second_loop_entry ? idx11 : lower1)..upper1)
{
for (idx22 in (second_loop_entry ? idx12 : lower2)..upper2)
{
...
second_loop_entry = false;
}
}
It was expected that the compiler optimizations would be able to remove the
state variable second_loop_entry. It is the case if ARRAY has rank 1 (so
without loop nesting), the variable is removed and the loop bounds become
unconditional, which restores previously generated code, fully fixing the
regression. For larger rank, unfortunately, the state variable and
conditional loop bounds remain, but those cases were previously using
library calls, so it's not a regression.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate a set
of index variables. Set them using the loop indexes before leaving
the first set of loops. Generate a new loop entry predicate.
Initialize it. Set it before leaving the first set of loops. Clear
it in the body of the second set of loops. For the second set of
loops, update each loop lower bound to use the corresponding index
variable if the predicate variable is set.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 33 +++--
1 file changed, 31 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 3a6a73d42417..89134b1190ba 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5342,6 +5342,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = 0;
pos1 = 0;
S1 = from1;
+second_loop_entry = false;
while (S1 <= to1) {
S0 = from0;
while (s0 <= to0 {
@@ -5354,6 +5355,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
limit = a[S1][S0];
pos0 = S0 + (1 - from0);
pos1 = S1 + (1 - from1);
+second_loop_entry = true;
goto lab1;
}
}
@@ -5363,9 +5365,9 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
}
goto lab2;
lab1:;
-S1 = from1;
+S1 = second_loop_entry ? S1 : from1;
while (S1 <= to1) {
- S0 = from0;
+ S0 = second_loop_entry ? S0 : from0;
while (S0 <= to0) {
if (mask[S1][S0])
if (a[S1][S0] < limit) {
@@ -5373,6 +5375,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = S + (1 - from0);
pos1
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
https://gcc.gnu.org/g:d3d4a1c4f55bdd97ed3acd4eda1547343d9b9066
commit d3d4a1c4f55bdd97ed3acd4eda1547343d9b9066
Author: Mikael Morin
Date: Wed Jul 31 10:10:33 2024 +0200
fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Enable the generation of inline code for MINLOC/MAXLOC when argument ARRAY
is of integral type, DIM is not present, and MASK is present and is scalar
(only absent MASK or rank 1 ARRAY were inlined before).
Scalar masks are implemented with a wrapping condition around the code one
would generate if MASK wasn't present, so they are easy to support once
inline code without MASK is working.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate
variable initialization for each dimension in the else branch of
the toplevel condition.
(gfc_inline_intrinsic_function_p): Return TRUE for scalar MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_7.f90: Additionally accept the error
message
reported by the scalarizer.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 13 -
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 4 ++--
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac8bd2d48123..855208717973 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5886,7 +5886,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskss == NULL)
{
- gcc_assert (loop.dimen == 1);
tree ifmask;
gfc_init_se (, NULL);
@@ -5901,7 +5900,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
the pos variable the same way as above. */
gfc_init_block ();
- gfc_add_modify (, pos[0], gfc_index_zero_node);
+ for (int i = 0; i < loop.dimen; i++)
+ gfc_add_modify (, pos[i], gfc_index_zero_node);
elsetmp = gfc_finish_block ();
ifmask = conv_mask_condition (, maskexpr, optional_mask);
tmp = build3_v (COND_EXPR, ifmask, tmp, elsetmp);
@@ -11795,9 +11795,12 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
if (array->rank == 1)
return true;
- if (array->ts.type == BT_INTEGER
- && dim == nullptr
- && mask == nullptr)
+ if (array->ts.type != BT_INTEGER
+ || dim != nullptr)
+ return false;
+
+ if (mask == nullptr
+ || mask->rank == 0)
return true;
return false;
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
index 206a29b149da..3aa9d3dcebee 100644
--- a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
@@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2|Array bound mismatch for dimension 1 of array 'res' .3/2." }
module tst
contains
subroutine foo(res)
@@ -18,4 +18,4 @@ program main
integer :: res(3)
call foo(res)
end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2|Array bound mismatch for dimension 1 of
array 'res' .3/2." }
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
https://gcc.gnu.org/g:89794e9294e7dfa937ebf92080001cb0bcecfeec
commit 89794e9294e7dfa937ebf92080001cb0bcecfeec
Author: Mikael Morin
Date: Wed Jul 31 10:10:49 2024 +0200
fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Enable generation of inline MINLOC/MAXLOC code in the case where DIM
is not present, and either ARRAY is of floating point type or MASK is an
array. Those cases are the remaining bits to fully support inlining of
non-CHARACTER MINLOC/MAXLOC without DIM. They are treated together because
they generate similar code, the NANs for REAL types being handled a bit like
a second level of masking. These are the cases for which we generate two
sets of loops.
This change affects the code generating the second loop, that was previously
accessible only in the cases ARRAY has rank 1 only. The single variable
initialization and update are changed to apply to multiple variables, one
per dimension.
The code generated is as follows (if ARRAY has rank 2):
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in lower1..upper1)
{
for (idx22 in lower2..upper2)
{
...
}
}
This code leads to processing the first elements redundantly, both in the
first set of loops and in the second one. The loop over idx22 could
start from idx12 the first time it is run, but as it has to start from
lower2 for the rest of the runs, this change uses the same bounds for both
set of loops for simplicity. In the rank 1 case, this makes the generated
code worse compared to the inline code that was generated before. A later
change will introduce conditionals to avoid the duplicate processing and
restore the generated code in that case.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Initialize
and update all the variables. Put the label and goto in the
outermost scalarizer loop. Don't start the second loop where the
first stopped.
(gfc_inline_intrinsic_function_p): Also return TRUE for array MASK
or for any REAL type.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_5.f90: Additionally accept error
messages reported by the scalarizer.
* gfortran.dg/maxloc_bounds_6.f90: Ditto.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 127 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 | 4 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 | 4 +-
3 files changed, 87 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 855208717973..3a6a73d42417 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5332,12 +5332,55 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
S++;
}
- B: ARRAY has rank 1, and DIM is absent. Use the same code as the scalar
- case and wrap the result in an array.
- C: ARRAY has rank > 1, NANs are not supported, and DIM and MASK are absent.
- Generate code similar to the single loop scalar case, but using one
- variable per dimension, for example if ARRAY has rank 2:
- 4) NAN's aren't supported, no MASK:
+ B: Array result, non-CHARACTER type, DIM absent
+ Generate similar code as in the scalar case, using a collection of
+ variables (one per dimension) instead of a single variable as result.
+ Picking only cases 1) and 4) with ARRAY of rank 2, the generated code
+ becomes:
+ 1) Array mask is used and NaNs need to be supported:
+limit = Infinity;
+pos0 = 0;
+pos1 = 0;
+S1 = from1;
+while (S1 <= to1) {
+ S0 = from0;
+ while (s0 <= to0 {
+if (mask[S1][S0]) {
+ if (pos0 == 0) {
+pos0 = S0 + (1 - from0);
+pos1 = S1 + (1 - from1);
+ }
+ if (a[S1][S0] <= limit) {
+limit = a[S1][S0];
+pos0 = S0 + (1 - from0);
+pos1 = S1 + (1 - from1);
+goto lab1;
+ }
+}
+S0++;
+ }
+ S1++;
+}
+goto lab2;
+lab1:;
+S1 = from1;
+while (S1 <= to1) {
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
https://gcc.gnu.org/g:7738e6287f90905786a7ecb31238978efba6923d
commit 7738e6287f90905786a7ecb31238978efba6923d
Author: Mikael Morin
Date: Wed Jul 31 10:10:19 2024 +0200
fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Enable generation of inline code for the MINLOC and MAXLOC intrinsic,
if the ARRAY argument is of integral type and of any rank (only the rank 1
case was previously inlined), and neither DIM nor MASK arguments are
present.
This needs a few adjustments in gfc_conv_intrinsic_minmaxloc,
mainly to replace the single variables POS and OFFSET, with collections
of variables, one variable per dimension each.
The restriction to integral ARRAY and absent MASK limits the scope of
the change to the cases where we generate single loop inline code. The
code generation for the second loop is only accessible with ARRAY of rank
1, so it can continue using a single variable. A later change will extend
inlining to the double loop cases.
There is some bounds checking code that was previously handled by the
library, and that needed some changes in the scalarizer to avoid regressing.
The bounds check code generation was already supported by the scalarizer,
but it was only applying to array reference sections, checking both
for array bound violation and for shape conformability between all the
involved arrays. With this change, for MINLOC or MAXLOC, enable the
conformability check between all the scalarized arrays, and disable the
array bound violation check.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the MINLOC/MAXLOC
result upper bound using the rank of the ARRAY argument. Ajdust
the error message for intrinsic result arrays. Only check array
bounds for array references. Move bound check decision code...
(bounds_check_needed): ... here as a new predicate. Allow bound
check for MINLOC/MAXLOC intrinsic results.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Change the
result array upper bound to the rank of ARRAY. Update the NONEMPTY
variable to depend on the non-empty extent of every dimension. Use
one variable per dimension instead of a single variable for the
position and the offset. Update their declaration, initialization,
and update to affect the variable of each dimension. Use the first
variable only in areas only accessed with rank 1 ARRAY argument.
Set every element of the result using its corresponding variable.
(gfc_inline_intrinsic_function_p): Return true for integral ARRAY
and absent DIM and MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_4.f90: Additionally accept the error
message emitted by the scalarizer.
Diff:
---
gcc/fortran/trans-array.cc| 68 +---
gcc/fortran/trans-intrinsic.cc| 150 +++---
gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 4 +-
3 files changed, 165 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 99a603a3afb2..76448c8ac0e3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4876,6 +4876,35 @@ add_check_section_in_array_bounds (stmtblock_t *inner,
gfc_ss_info *ss_info,
}
+/* Tells whether we need to generate bounds checking code for the array
+ associated with SS. */
+
+bool
+bounds_check_needed (gfc_ss *ss)
+{
+ /* Catch allocatable lhs in f2003. */
+ if (flag_realloc_lhs && ss->no_bounds_check)
+return false;
+
+ gfc_ss_info *ss_info = ss->info;
+ if (ss_info->type == GFC_SS_SECTION)
+return true;
+
+ if (!(ss_info->type == GFC_SS_INTRINSIC
+ && ss_info->expr
+ && ss_info->expr->expr_type == EXPR_FUNCTION))
+return false;
+
+ gfc_intrinsic_sym *isym = ss_info->expr->value.function.isym;
+ if (!(isym
+ && (isym->id == GFC_ISYM_MAXLOC
+ || isym->id == GFC_ISYM_MINLOC)))
+return false;
+
+ return gfc_inline_intrinsic_function_p (ss_info->expr);
+}
+
+
/* Calculates the range start and stride for a SS chain. Also gets the
descriptor and data pointer. The range of vector subscripts is the size
of the vector. Array bounds are also checked. */
@@ -4977,10 +5006,17 @@ done:
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, _loop->pre);
- info->offset = gfc_index_zero_node;
+ gfc_expr *array = expr->value.function.actual->expr;
+ tree rank = build_int_cst (gfc_array_index_type, array->rank);
+
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Outline array bound check generation code
https://gcc.gnu.org/g:fc60928404feeb01833a25da79518a60e80c5ede
commit fc60928404feeb01833a25da79518a60e80c5ede
Author: Mikael Morin
Date: Wed Jul 31 10:10:06 2024 +0200
fortran: Outline array bound check generation code
The next patch will need reindenting of the array bound check generation
code. This outlines it to its own function beforehand, reducing the churn
in the next patch.
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Move array bound check
generation code...
(add_check_section_in_array_bounds): ... here as a new function.
Diff:
---
gcc/fortran/trans-array.cc | 297 ++---
1 file changed, 143 insertions(+), 154 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0c78e1fecd8f..99a603a3afb2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4736,6 +4736,146 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
}
+/* Generate in INNER the bounds checking code along the dimension DIM for
+ the array associated with SS_INFO. */
+
+static void
+add_check_section_in_array_bounds (stmtblock_t *inner, gfc_ss_info *ss_info,
+ int dim)
+{
+ gfc_expr *expr = ss_info->expr;
+ locus *expr_loc = >where;
+ const char *expr_name = expr->symtree->name;
+
+ gfc_array_info *info = _info->data.array;
+
+ bool check_upper;
+ if (dim == info->ref->u.ar.dimen - 1
+ && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+check_upper = false;
+ else
+check_upper = true;
+
+ /* Zero stride is not allowed. */
+ tree tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ info->stride[dim], gfc_index_zero_node);
+ char * msg = xasprintf ("Zero stride is not allowed, for dimension %d "
+ "of array '%s'", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg);
+ free (msg);
+
+ tree desc = info->descriptor;
+
+ /* This is the run-time equivalent of resolve.cc's
+ check_dimension. The logical is more readable there
+ than it is here, with all the trees. */
+ tree lbound = gfc_conv_array_lbound (desc, dim);
+ tree end = info->end[dim];
+ tree ubound = check_upper ? gfc_conv_array_ubound (desc, dim) : NULL_TREE;
+
+ /* non_zerosized is true when the selected range is not
+ empty. */
+ tree stride_pos = fold_build2_loc (input_location, GT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_pos, tmp);
+
+ tree stride_neg = fold_build2_loc (input_location, LT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_neg, tmp);
+ tree non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, stride_pos,
+ stride_neg);
+
+ /* Check the start of the range against the lower and upper
+ bounds of the array, if the range is not empty.
+ If upper bound is present, include both bounds in the
+ error message. */
+ if (check_upper)
+{
+ tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+info->start[dim], lbound);
+ tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
+non_zerosized, tmp);
+ tree tmp2 = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
+ info->start[dim], ubound);
+ tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
logical_type_node,
+ non_zerosized, tmp2);
+ msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' outside of "
+ "expected range (%%ld:%%ld)", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+ fold_convert (long_integer_type_node, ubound));
+ gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
https://gcc.gnu.org/g:c272e51bf329761491185835bf26f5a8a53c0247
commit c272e51bf329761491185835bf26f5a8a53c0247
Author: Mikael Morin
Date: Wed Jul 31 10:09:53 2024 +0200
fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Enable inline code generation for the MINLOC and MAXLOC intrinsic, if the
DIM argument is not present and ARRAY has rank 1. This case is similar to
the case where the result is scalar (DIM present and rank 1 ARRAY), which
already supports inline expansion of the intrinsic. Both cases return
the same value, with the difference that the result is an array of size 1 if
DIM is absent, whereas it's a scalar if DIM is present. So all there is
to do for the new case to work is hook the inline expansion with the
scalarizer.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the scalarization
rank based on the MINLOC/MAXLOC rank if needed. Call the inline
code generation and setup the scalarizer array descriptor info
in the MINLOC and MAXLOC cases.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Return the
result array element if the scalarizer is setup and we are inside
the loops. Restrict library function call dispatch to the case
where inline expansion is not supported. Declare an array result
if the expression isn't scalar. Initialize the array result single
element and return the result variable if the expression isn't
scalar.
(walk_inline_intrinsic_minmaxloc): New function.
(walk_inline_intrinsic_function): Add MINLOC and MAXLOC cases,
dispatching to walk_inline_intrinsic_minmaxloc.
(gfc_add_intrinsic_ss_code): Add MINLOC and MAXLOC cases.
(gfc_inline_intrinsic_function_p): Return true if ARRAY has rank 1,
regardless of DIM.
Diff:
---
gcc/fortran/trans-array.cc | 25 ++
gcc/fortran/trans-intrinsic.cc | 198 +++--
2 files changed, 155 insertions(+), 68 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c93a5f1e7543..0c78e1fecd8f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4771,6 +4771,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
case GFC_ISYM_UBOUND:
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_MAXLOC:
+ case GFC_ISYM_MINLOC:
case GFC_ISYM_SHAPE:
case GFC_ISYM_THIS_IMAGE:
loop->dimen = ss->dimen;
@@ -4820,6 +4822,29 @@ done:
case GFC_SS_INTRINSIC:
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_MINLOC:
+ case GFC_ISYM_MAXLOC:
+ {
+ gfc_se se;
+ gfc_init_se (, nullptr);
+ se.loop = loop;
+ se.ss = ss;
+ gfc_conv_intrinsic_function (, expr);
+ gfc_add_block_to_block (_loop->pre, );
+ gfc_add_block_to_block (_loop->post, );
+
+ info->descriptor = se.expr;
+
+ info->data = gfc_conv_array_data (info->descriptor);
+ info->data = gfc_evaluate_now (info->data, _loop->pre);
+
+ info->offset = gfc_index_zero_node;
+ info->start[0] = gfc_index_zero_node;
+ info->end[0] = gfc_index_zero_node;
+ info->stride[0] = gfc_index_one_node;
+ continue;
+ }
+
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cc0d00f4e399..a947dd1ba0b2 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5273,66 +5273,69 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
we need to handle. For performance reasons we sometimes create two
loops instead of one, where the second one is much simpler.
Examples for minloc intrinsic:
- 1) Result is an array, a call is generated
- 2) Array mask is used and NaNs need to be supported:
- limit = Infinity;
- pos = 0;
- S = from;
- while (S <= to) {
- if (mask[S]) {
- if (pos == 0) pos = S + (1 - from);
- if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
- }
- S++;
- }
- goto lab2;
- lab1:;
- while (S <= to) {
- if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
- S++;
- }
- lab2:;
- 3) NaNs need to be supported, but it is known at compile time or cheaply
- at runtime whether array is nonempty
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
https://gcc.gnu.org/g:41e22a74ed2a25592a4618d57b1c4af228546cf8
commit 41e22a74ed2a25592a4618d57b1c4af228546cf8
Author: Mikael Morin
Date: Wed Jul 31 10:09:39 2024 +0200
fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Disable rewriting of MINLOC/MAXLOC expressions for which inline code
generation is supported. Update the gfc_inline_intrinsic_function_p
predicate (already existing) for that, with the current state of
MINLOC/MAXLOC inlining support, that is only the cases of a scalar
result and non-CHARACTER argument for now.
This change has no effect currently, as the MINLOC/MAXLOC front-end passes
only change expressions of rank 1, but the inlining control predicate
gfc_inline_intrinsic_function_p returns false for those. However, later
changes will extend MINLOC/MAXLOC inline expansion support to array
expressions and update the inlining control predicate, and this will become
effective.
gcc/fortran/ChangeLog:
* frontend-passes.cc (optimize_minmaxloc): Skip if we can generate
inline code for the unmodified expression.
* trans-intrinsic.cc (gfc_inline_intrinsic_function_p): Add
MINLOC and MAXLOC cases.
Diff:
---
gcc/fortran/frontend-passes.cc | 3 ++-
gcc/fortran/trans-intrinsic.cc | 23 +++
2 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 3c06018fdbbf..8e4c6310ba8d 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -2277,7 +2277,8 @@ optimize_minmaxloc (gfc_expr **e)
|| fn->value.function.actual == NULL
|| fn->value.function.actual->expr == NULL
|| fn->value.function.actual->expr->ts.type == BT_CHARACTER
- || fn->value.function.actual->expr->rank != 1)
+ || fn->value.function.actual->expr->rank != 1
+ || gfc_inline_intrinsic_function_p (fn))
return;
*e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, >where);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9f3c3ce47bc5..cc0d00f4e399 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11650,6 +11650,29 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
case GFC_ISYM_TRANSPOSE:
return true;
+case GFC_ISYM_MINLOC:
+case GFC_ISYM_MAXLOC:
+ {
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ gfc_actual_arglist *array_arg = expr->value.function.actual;
+ gfc_actual_arglist *dim_arg = array_arg->next;
+
+ gfc_expr *array = array_arg->expr;
+ gfc_expr *dim = dim_arg->expr;
+
+ if (!(array->ts.type == BT_INTEGER
+ || array->ts.type == BT_REAL))
+ return false;
+
+ if (array->rank == 1 && dim != nullptr)
+ return true;
+
+ return false;
+ }
+
default:
return false;
}
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v08)] fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
https://gcc.gnu.org/g:29c4b48d6b407d0eb410235169cf1ae9d63a0179
commit 29c4b48d6b407d0eb410235169cf1ae9d63a0179
Author: Mikael Morin
Date: Wed Jul 31 10:09:25 2024 +0200
fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
Tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Add the tests covering the various cases for which we are about to implement
inline expansion of MINLOC and MAXLOC. Those are cases where the DIM
argument is not present.
PR fortran/90608
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_7.f90: New test.
* gfortran.dg/maxloc_with_mask_1.f90: New test.
* gfortran.dg/minloc_8.f90: New test.
* gfortran.dg/minloc_with_mask_1.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/maxloc_7.f90 | 220 +
gcc/testsuite/gfortran.dg/maxloc_with_mask_1.f90 | 393 +++
gcc/testsuite/gfortran.dg/minloc_8.f90 | 220 +
gcc/testsuite/gfortran.dg/minloc_with_mask_1.f90 | 392 ++
4 files changed, 1225 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/maxloc_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_7.f90
new file mode 100644
index ..a875083052a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_7.f90
@@ -0,0 +1,220 @@
+! { dg-do run }
+!
+! PR fortran/90608
+! Check the correct behaviour of the inline maxloc implementation,
+! when there is no optional argument.
+
+program p
+ implicit none
+ integer, parameter :: data5(*) = (/ 1, 7, 2, 7, 0 /)
+ integer, parameter :: data64(*) = (/ 2, 5, 4, 6, 0, 9, 3, 5, &
+ 4, 4, 1, 7, 3, 2, 1, 2, &
+ 5, 4, 6, 0, 9, 3, 5, 4, &
+ 4, 1, 7, 3, 2, 1, 2, 5, &
+ 4, 6, 0, 9, 3, 5, 4, 4, &
+ 1, 7, 3, 2, 1, 2, 5, 4, &
+ 6, 0, 9, 3, 5, 4, 4, 1, &
+ 7, 3, 2, 1, 2, 5, 4, 6 /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_int_alloc_empty_4
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+ call check_real_alloc_empty_4
+ call check_int_lower_bounds
+ call check_real_lower_bounds
+ call check_all_nans
+ call check_dependencies
+contains
+ subroutine check_int_const_shape_rank_1()
+integer :: a(5)
+integer, allocatable :: m(:)
+a = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 11
+if (any(m /= (/ 2 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+integer :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 21
+if (any(m /= (/ 2, 2, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+integer :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 31
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 32
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+integer, allocatable :: a(:)
+integer, allocatable :: m(:)
+allocate(a(5))
+a(:) = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 41
+if (any(m /= (/ 2 /))) stop 42
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+integer, allocatable :: a(:,:,:)
+integer, allocatable :: m(:)
+allocate(a(4,4,4))
+a(:,:,:) = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 51
+if (any(m /= (/ 2, 2, 1 /))) stop 52
+ end subroutine
+ subroutine check_int_alloc_empty_4()
+integer, allocatable :: a(:,:,:,:)
+integer, allocatable :: m(:)
+allocate(a(9,3,0,7))
+a(:,:,:,:) = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 61
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 62
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+real :: a(5)
+integer, allocatable :: m(:)
+a = (/ real:: data5 /)
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 71
+if (any(m /= (/ 2 /))) stop 72
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+real :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape((/ real:: data64 /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 81
+if (any(m /= (/ 2, 2, 1 /))) stop 82
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+real :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ real:: /), shape(a))
+m = maxloc(a)
+if (size(m,
[gcc] Created branch 'mikael/heads/inline_minmaxloc_without_dim_v08' in namespace 'refs/users'
The branch 'mikael/heads/inline_minmaxloc_without_dim_v08' was created in namespace 'refs/users' pointing to: b8a4ddbd04b3... fortran: Continue MINLOC/MAXLOC second loop where the first
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Continue MINLOC/MAXLOC second loop where the first stopped [PR90608]
https://gcc.gnu.org/g:215d87c9e87f09f7b49dd679fdccb6fa22c02f74
commit 215d87c9e87f09f7b49dd679fdccb6fa22c02f74
Author: Mikael Morin
Date: Thu Jul 25 12:27:09 2024 +0200
fortran: Continue MINLOC/MAXLOC second loop where the first stopped
[PR90608]
Continue the second set of loops where the first one stopped in the
generated inline MINLOC/MAXLOC code in the cases where the generated code
contains two sets of loops. This fixes a regression that was introduced
when enabling the generation of inline MINLOC/MAXLOC code with ARRAY of rank
greater than 1, non-scalar MASK and no DIM arguments.
In the cases where two sets of loops are generated as inline MINLOC/MAXLOC
code, we previously generated code such as (for rank 2 ARRAY, so with two
levels of nesting):
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in lower1..upper1)
{
for (idx22 in lower2..upper2)
{
...
}
}
which means we process the first elements twice, once in the first set
of loops and once in the second one. This change avoids this duplicate
processing by using a conditional as lower bound for the second set of
loops, generating code like:
second_loop_entry = false;
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
second_loop_entry = true;
goto second_loop;
}
}
}
second_loop:
for (idx21 in (second_loop_entry ? idx11 : lower1)..upper1)
{
for (idx22 in (second_loop_entry ? idx12 : lower2)..upper2)
{
...
second_loop_entry = false;
}
}
It was expected that the compiler optimizations would be able to remove the
state variable second_loop_entry. It is the case if ARRAY has rank 1 (so
without loop nesting), the variable is removed and the loop bounds become
unconditional, which restores previously generated code, fully fixing the
regression. For larger rank, unfortunately, the state variable and
conditional loop bounds remain, but those cases were previously using
library calls, so it's not a regression.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate a set
of index variables. Set them using the loop indexes before leaving
the first set of loops. Generate a new loop entry predicate.
Set it before leaving the first set of loops. Clear it in the body
of the second set of loops. For the second set of loops, update
each loop variable to use the corresponding index variable if the
predicate variable is set.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 33 +++--
1 file changed, 31 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index bae3b49a9498..29367c69d16b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5342,6 +5342,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = 0;
pos1 = 1
S1 = from1;
+second_loop_entry = false;
while (S1 <= to1) {
S0 = from0;
while (s0 <= to0 {
@@ -5354,6 +5355,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
limit = a[S1][S0];
pos0 = S0 + (1 - from0);
pos1 = S1 + (1 - from1);
+second_loop_entry = true;
goto lab1;
}
}
@@ -5363,9 +5365,9 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
}
goto lab2;
lab1:;
-S1 = from1;
+S1 = second_loop_entry ? S1 : from1;
while (S1 <= to1) {
- S0 = from0;
+ S0 = second_loop_entry ? S0 : from0;
while (S0 <= to0) {
if (mask[S1][S0])
if (a[S1][S0] < limit) {
@@ -5373,6 +5375,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = S + (1 - from0);
pos1 = S + (1 - from1);
}
+second_loop_entry = false;
S0++;
}
S1++;
@@ -5444,6 +5447,7
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
https://gcc.gnu.org/g:ebde7ff486ec700d59eb2cc530c3ece3f9a07f67
commit ebde7ff486ec700d59eb2cc530c3ece3f9a07f67
Author: Mikael Morin
Date: Fri Nov 17 16:47:26 2023 +0100
fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
Enable generation of inline MINLOC/MAXLOC code in the case where DIM
is not present, and either ARRAY is of floating point type or MASK is an
array. Those cases are the remaining bits to fully support inlining of
non-CHARACTER MINLOC/MAXLOC without DIM. They are treated together because
they generate similar code, the NANs for REAL types being handled a bit like
a second level of masking. These are the cases for which we generate two
sets of loops.
This change affects the code generating the second loop, that was previously
accessible only in the cases ARRAY has rank rank 1. The single variable
initialization and update are changed to apply to multiple variables, one
per dimension.
This change generates slightly worse code if ARRAY has rank 1. Indeed
the code we used to generate was:
for (idx1 in lower..upper)
{
...
if (...)
{
...
break;
}
}
for (idx2 in idx1..upper)
{
...
}
which avoided starting the second loop from lower, skipping in the second
loop the elements already processed in the first one. Unfortunately,
extending that code the obvious way to apply to rank > 1 leads to wrong
code:
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in index11..upper1)
{
for (idx22 in index12..upper2)
{
...
}
}
That code is incorrect, as the loop over idx22, being nested, may be run
more than once, and the second run should restart from lower2, not index12.
So with this change, we generate instead as second set of loops:
...
second_loop:
for (idx21 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
}
}
which means the second set of loops processes again elements already
processed by the first one, and the rank 1 case becomes:
for (idx1 in lower..upper)
{
...
if (...)
{
...
break;
}
}
for (idx2 in lower..upper)
{
...
}
processing the first elements twice as well, which was not the case
before. A later change will avoid the duplicate processing and restore
the generated code in the rank 1 case.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Initialize
and update all the variables. Put the label and goto in the
outermost scalarizer loop. Don't start the second loop where the
first stopped.
(gfc_inline_intrinsic_function_p): Also return TRUE for array MASK
or for any REAL type.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_5.f90: Additionally accept error
messages reported by the scalarizer.
* gfortran.dg/maxloc_bounds_6.f90: Ditto.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 127 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 | 4 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 | 4 +-
3 files changed, 87 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 855208717973..bae3b49a9498 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5332,12 +5332,55 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
S++;
}
- B: ARRAY has rank 1, and DIM is absent. Use the same code as the scalar
- case and wrap the result in an array.
- C: ARRAY has rank > 1, NANs are not supported, and DIM and MASK are absent.
- Generate code similar to the single loop scalar case, but using one
- variable per dimension, for example if ARRAY has rank 2:
- 4) NAN's aren't supported, no MASK:
+ B: Array result, non-CHARACTER type,
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
https://gcc.gnu.org/g:64fa63b902146982db4fd81d8240aef16d24311d
commit 64fa63b902146982db4fd81d8240aef16d24311d
Author: Mikael Morin
Date: Fri Nov 17 15:40:55 2023 +0100
fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
Enable the generation of inline code for MINLOC/MAXLOC when argument ARRAY
is of integral type, DIM is not present, and MASK is present and is scalar
(only absent MASK or rank 1 ARRAY were inlined before).
Scalar masks are implemented with a wrapping condition around the code one
would generate if MASK wasn't present, so they are easy to support once
inline code without MASK is working.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate
variable initialization for each dimension in the else branch of
the toplevel condition.
(gfc_inline_intrinsic_function_p): Return TRUE for scalar MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_7.f90: Additionally accept the error
message
reported by the scalarizer.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 13 -
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 4 ++--
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac8bd2d48123..855208717973 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5886,7 +5886,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskss == NULL)
{
- gcc_assert (loop.dimen == 1);
tree ifmask;
gfc_init_se (, NULL);
@@ -5901,7 +5900,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
the pos variable the same way as above. */
gfc_init_block ();
- gfc_add_modify (, pos[0], gfc_index_zero_node);
+ for (int i = 0; i < loop.dimen; i++)
+ gfc_add_modify (, pos[i], gfc_index_zero_node);
elsetmp = gfc_finish_block ();
ifmask = conv_mask_condition (, maskexpr, optional_mask);
tmp = build3_v (COND_EXPR, ifmask, tmp, elsetmp);
@@ -11795,9 +11795,12 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
if (array->rank == 1)
return true;
- if (array->ts.type == BT_INTEGER
- && dim == nullptr
- && mask == nullptr)
+ if (array->ts.type != BT_INTEGER
+ || dim != nullptr)
+ return false;
+
+ if (mask == nullptr
+ || mask->rank == 0)
return true;
return false;
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
index 206a29b149da..3aa9d3dcebee 100644
--- a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
@@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2|Array bound mismatch for dimension 1 of array 'res' .3/2." }
module tst
contains
subroutine foo(res)
@@ -18,4 +18,4 @@ program main
integer :: res(3)
call foo(res)
end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2|Array bound mismatch for dimension 1 of
array 'res' .3/2." }
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
https://gcc.gnu.org/g:081f12a1d9d1bd793e3571daf5ab25db594ff57a
commit 081f12a1d9d1bd793e3571daf5ab25db594ff57a
Author: Mikael Morin
Date: Thu Nov 16 22:14:41 2023 +0100
fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
Enable generation of inline code for the MINLOC and MAXLOC intrinsic,
if the ARRAY argument is of integral type and of any rank (only the rank 1
case was previously inlined), and neither DIM nor MASK arguments are
present.
This needs a few adjustments in gfc_conv_intrinsic_minmaxloc,
mainly to replace the single variables POS and OFFSET, with collections
of variables, one variable per dimension each.
The restriction to integral ARRAY and absent MASK limits the scope of
the change to the cases where we generate single loop inline code. The
code generation for the second loop is only accessible with ARRAY of rank
1, so it can continue using a single variable. A later change will extend
inlining to the double loop cases.
There is some bounds checking code that was previously handled by the
library, and that needed some changes in the scalarizer to avoid regressing.
The bounds check code generation was already by the scalarizer, but it was
only applying to array reference sections, checking both individual array
bounds and shape conformability between all the array involved. For MINLOC
or MAXLOC, enable the conformability check between all the scalarized
arrays, and disable the check that the array reference is within its bounds.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the MINLOC/MAXLOC
result upper bound using the ARRAY argument rank. Ajdust the error
message for intrinsic result arrays. Only check array bounds for
array references. Move bound check decision code...
(bounds_check_needed): ... here as a new predicate. Allow bound
check for MINLOC/MAXLOC intrinsic results.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Change the
result array upper bound to the rank of ARRAY. Update the NONEMPTY
variable to depend on the non-empty extent of every dimension. Use
one variable per dimension instead of a single variable for the
position and the offset. Update their declaration, initialization,
and update to affect the variable of each dimension. Use the first
variable only in areas only accessed with rank 1 ARRAY argument.
Set every element of the result using its corresponding variable.
(gfc_inline_intrinsic_function_p): Return true for integral ARRAY
and absent DIM and MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_4.f90: Additionally accept the error
message emitted by the scalarizer.
Diff:
---
gcc/fortran/trans-array.cc| 70 +---
gcc/fortran/trans-intrinsic.cc| 150 +++---
gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 4 +-
3 files changed, 167 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 99a603a3afb2..c9d63d13509d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4876,6 +4876,35 @@ add_check_section_in_array_bounds (stmtblock_t *inner,
gfc_ss_info *ss_info,
}
+/* Tells whether we need to generate bounds checking code for the array
+ associated with SS. */
+
+bool
+bounds_check_needed (gfc_ss *ss)
+{
+ /* Catch allocatable lhs in f2003. */
+ if (flag_realloc_lhs && ss->no_bounds_check)
+return false;
+
+ gfc_ss_info *ss_info = ss->info;
+ if (ss_info->type == GFC_SS_SECTION)
+return true;
+
+ if (!(ss_info->type == GFC_SS_INTRINSIC
+ && ss_info->expr
+ && ss_info->expr->expr_type == EXPR_FUNCTION))
+return false;
+
+ gfc_intrinsic_sym *isym = ss_info->expr->value.function.isym;
+ if (!(isym
+ && (isym->id == GFC_ISYM_MAXLOC
+ || isym->id == GFC_ISYM_MINLOC)))
+return false;
+
+ return gfc_inline_intrinsic_function_p (ss_info->expr);
+}
+
+
/* Calculates the range start and stride for a SS chain. Also gets the
descriptor and data pointer. The range of vector subscripts is the size
of the vector. Array bounds are also checked. */
@@ -4977,10 +5006,19 @@ done:
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, _loop->pre);
- info->offset = gfc_index_zero_node;
+ gfc_expr *array = expr->value.function.actual->expr;
+ tree rank = build_int_cst (gfc_array_index_type, array->rank);
+
+ tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Outline array bound check generation code
https://gcc.gnu.org/g:b06cfb12ade15dd221f4a3ffbe707da5597e172e
commit b06cfb12ade15dd221f4a3ffbe707da5597e172e
Author: Mikael Morin
Date: Wed Apr 10 21:18:03 2024 +0200
fortran: Outline array bound check generation code
The next patch will need reindenting of the array bound check generation
code. This outlines it to its own function beforehand, reducing the churn
in the next patch.
-- >8 --
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Move array bound check
generation code...
(add_check_section_in_array_bounds): ... here as a new function.
Diff:
---
gcc/fortran/trans-array.cc | 297 ++---
1 file changed, 143 insertions(+), 154 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0c78e1fecd8f..99a603a3afb2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4736,6 +4736,146 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
}
+/* Generate in INNER the bounds checking code along the dimension DIM for
+ the array associated with SS_INFO. */
+
+static void
+add_check_section_in_array_bounds (stmtblock_t *inner, gfc_ss_info *ss_info,
+ int dim)
+{
+ gfc_expr *expr = ss_info->expr;
+ locus *expr_loc = >where;
+ const char *expr_name = expr->symtree->name;
+
+ gfc_array_info *info = _info->data.array;
+
+ bool check_upper;
+ if (dim == info->ref->u.ar.dimen - 1
+ && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+check_upper = false;
+ else
+check_upper = true;
+
+ /* Zero stride is not allowed. */
+ tree tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ info->stride[dim], gfc_index_zero_node);
+ char * msg = xasprintf ("Zero stride is not allowed, for dimension %d "
+ "of array '%s'", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg);
+ free (msg);
+
+ tree desc = info->descriptor;
+
+ /* This is the run-time equivalent of resolve.cc's
+ check_dimension. The logical is more readable there
+ than it is here, with all the trees. */
+ tree lbound = gfc_conv_array_lbound (desc, dim);
+ tree end = info->end[dim];
+ tree ubound = check_upper ? gfc_conv_array_ubound (desc, dim) : NULL_TREE;
+
+ /* non_zerosized is true when the selected range is not
+ empty. */
+ tree stride_pos = fold_build2_loc (input_location, GT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_pos, tmp);
+
+ tree stride_neg = fold_build2_loc (input_location, LT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_neg, tmp);
+ tree non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, stride_pos,
+ stride_neg);
+
+ /* Check the start of the range against the lower and upper
+ bounds of the array, if the range is not empty.
+ If upper bound is present, include both bounds in the
+ error message. */
+ if (check_upper)
+{
+ tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+info->start[dim], lbound);
+ tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
+non_zerosized, tmp);
+ tree tmp2 = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
+ info->start[dim], ubound);
+ tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
logical_type_node,
+ non_zerosized, tmp2);
+ msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' outside of "
+ "expected range (%%ld:%%ld)", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+ fold_convert (long_integer_type_node, ubound));
+ gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+ fold_convert (long_integer_type_node, ubound));
+ free (msg);
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
https://gcc.gnu.org/g:7c8dc5220170816e9c44fb1e42e3feb80831c740
commit 7c8dc5220170816e9c44fb1e42e3feb80831c740
Author: Mikael Morin
Date: Tue Jul 9 21:05:40 2024 +0200
fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
Enable inline code generation for the MINLOC and MAXLOC intrinsic, if the
DIM argument is not present and ARRAY has rank 1. This case is similar to
the case where the result is scalar (DIM present and rank 1 ARRAY), which
already supports inline expansion of the intrinsic. Both cases return
the same value, with the difference that the result is an array of size 1 if
DIM is absent, whereas it's a scalar if DIM is present. So all there is
to do for this case to work is hook the inline expansion with the
scalarizer.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the scalarization
rank based on the MINLOC/MAXLOC rank if needed. Call the inline
code generation and setup the scalarizer array descriptor info
in the MINLOC and MAXLOC cases.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Return the
result array element if the scalarizer is setup and we are inside
the loop. Restrict library function call dispatch to the case
where inline expansion is not supported. Declare an array result
if the expression isn't scalar. Initialize the array result single
element and return the result variable if the expression isn't
scalar.
(walk_inline_intrinsic_minmaxloc): New function.
(walk_inline_intrinsic_function): Add MINLOC and MAXLOC cases,
dispatching to walk_inline_intrinsic_minmaxloc.
(gfc_add_intrinsic_ss_code): Add MINLOC and MAXLOC cases.
(gfc_inline_intrinsic_function_p): Return true if ARRAY has rank 1,
regardless of DIM.
Diff:
---
gcc/fortran/trans-array.cc | 25 ++
gcc/fortran/trans-intrinsic.cc | 198 +++--
2 files changed, 155 insertions(+), 68 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c93a5f1e7543..0c78e1fecd8f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4771,6 +4771,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
case GFC_ISYM_UBOUND:
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_MAXLOC:
+ case GFC_ISYM_MINLOC:
case GFC_ISYM_SHAPE:
case GFC_ISYM_THIS_IMAGE:
loop->dimen = ss->dimen;
@@ -4820,6 +4822,29 @@ done:
case GFC_SS_INTRINSIC:
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_MINLOC:
+ case GFC_ISYM_MAXLOC:
+ {
+ gfc_se se;
+ gfc_init_se (, nullptr);
+ se.loop = loop;
+ se.ss = ss;
+ gfc_conv_intrinsic_function (, expr);
+ gfc_add_block_to_block (_loop->pre, );
+ gfc_add_block_to_block (_loop->post, );
+
+ info->descriptor = se.expr;
+
+ info->data = gfc_conv_array_data (info->descriptor);
+ info->data = gfc_evaluate_now (info->data, _loop->pre);
+
+ info->offset = gfc_index_zero_node;
+ info->start[0] = gfc_index_zero_node;
+ info->end[0] = gfc_index_zero_node;
+ info->stride[0] = gfc_index_one_node;
+ continue;
+ }
+
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cc0d00f4e399..a947dd1ba0b2 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5273,66 +5273,69 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
we need to handle. For performance reasons we sometimes create two
loops instead of one, where the second one is much simpler.
Examples for minloc intrinsic:
- 1) Result is an array, a call is generated
- 2) Array mask is used and NaNs need to be supported:
- limit = Infinity;
- pos = 0;
- S = from;
- while (S <= to) {
- if (mask[S]) {
- if (pos == 0) pos = S + (1 - from);
- if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
- }
- S++;
- }
- goto lab2;
- lab1:;
- while (S <= to) {
- if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
- S++;
- }
- lab2:;
- 3) NaNs need to be supported, but it is known at compile time or cheaply
- at runtime whether array is nonempty or not:
- limit = Infinity;
- pos = 0;
- S = from;
- while (S <= to) {
-
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
https://gcc.gnu.org/g:0c6f911ae6433ab0c3cc668083bd45aee52723bf
commit 0c6f911ae6433ab0c3cc668083bd45aee52723bf
Author: Mikael Morin
Date: Wed Nov 15 10:23:32 2023 +0100
fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
Disable rewriting of MINLOC/MAXLOC expressions for which inline code
generation is supported. Update the gfc_inline_intrinsic_function_p
predicate (already existing) for that, with the current state of
MINLOC/MAXLOC inlining support, that is only the cases of a scalar
result and non-CHARACTER argument for now.
This change has no effect currently, as the MINLOC/MAXLOC front-end passes
only change expressions of rank 1, but the inlining control predicate
gfc_inline_intrinsic_function_p returns false for those. However, later
changes will extend MINLOC/MAXLOC inline expansion support to array
expressions and update the inlining control predicate, and this will become
effective.
gcc/fortran/ChangeLog:
* frontend-passes.cc (optimize_minmaxloc): Skip if we can generate
inline code for the unmodified expression.
* trans-intrinsic.cc (gfc_inline_intrinsic_function_p): Add
MINLOC and MAXLOC cases.
Diff:
---
gcc/fortran/frontend-passes.cc | 3 ++-
gcc/fortran/trans-intrinsic.cc | 23 +++
2 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 3c06018fdbbf..8e4c6310ba8d 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -2277,7 +2277,8 @@ optimize_minmaxloc (gfc_expr **e)
|| fn->value.function.actual == NULL
|| fn->value.function.actual->expr == NULL
|| fn->value.function.actual->expr->ts.type == BT_CHARACTER
- || fn->value.function.actual->expr->rank != 1)
+ || fn->value.function.actual->expr->rank != 1
+ || gfc_inline_intrinsic_function_p (fn))
return;
*e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, >where);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9f3c3ce47bc5..cc0d00f4e399 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11650,6 +11650,29 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
case GFC_ISYM_TRANSPOSE:
return true;
+case GFC_ISYM_MINLOC:
+case GFC_ISYM_MAXLOC:
+ {
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ gfc_actual_arglist *array_arg = expr->value.function.actual;
+ gfc_actual_arglist *dim_arg = array_arg->next;
+
+ gfc_expr *array = array_arg->expr;
+ gfc_expr *dim = dim_arg->expr;
+
+ if (!(array->ts.type == BT_INTEGER
+ || array->ts.type == BT_REAL))
+ return false;
+
+ if (array->rank == 1 && dim != nullptr)
+ return true;
+
+ return false;
+ }
+
default:
return false;
}
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
https://gcc.gnu.org/g:c1eb87cb9470518cf499765fd72c8810f943c239
commit c1eb87cb9470518cf499765fd72c8810f943c239
Author: Mikael Morin
Date: Thu Jul 25 18:04:13 2024 +0200
fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
Add the tests covering the various cases for which we are about to implement
inline expansion of MINLOC and MAXLOC. Those are cases where the DIM
argument is not present.
PR fortran/90608
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_7.f90: New test.
* gfortran.dg/maxloc_with_mask_1.f90: New test.
* gfortran.dg/minloc_8.f90: New test.
* gfortran.dg/minloc_with_mask_1.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/maxloc_7.f90 | 220 +
gcc/testsuite/gfortran.dg/maxloc_with_mask_1.f90 | 393 +++
gcc/testsuite/gfortran.dg/minloc_8.f90 | 220 +
gcc/testsuite/gfortran.dg/minloc_with_mask_1.f90 | 392 ++
4 files changed, 1225 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/maxloc_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_7.f90
new file mode 100644
index ..a875083052a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_7.f90
@@ -0,0 +1,220 @@
+! { dg-do run }
+!
+! PR fortran/90608
+! Check the correct behaviour of the inline maxloc implementation,
+! when there is no optional argument.
+
+program p
+ implicit none
+ integer, parameter :: data5(*) = (/ 1, 7, 2, 7, 0 /)
+ integer, parameter :: data64(*) = (/ 2, 5, 4, 6, 0, 9, 3, 5, &
+ 4, 4, 1, 7, 3, 2, 1, 2, &
+ 5, 4, 6, 0, 9, 3, 5, 4, &
+ 4, 1, 7, 3, 2, 1, 2, 5, &
+ 4, 6, 0, 9, 3, 5, 4, 4, &
+ 1, 7, 3, 2, 1, 2, 5, 4, &
+ 6, 0, 9, 3, 5, 4, 4, 1, &
+ 7, 3, 2, 1, 2, 5, 4, 6 /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_int_alloc_empty_4
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+ call check_real_alloc_empty_4
+ call check_int_lower_bounds
+ call check_real_lower_bounds
+ call check_all_nans
+ call check_dependencies
+contains
+ subroutine check_int_const_shape_rank_1()
+integer :: a(5)
+integer, allocatable :: m(:)
+a = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 11
+if (any(m /= (/ 2 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+integer :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 21
+if (any(m /= (/ 2, 2, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+integer :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 31
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 32
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+integer, allocatable :: a(:)
+integer, allocatable :: m(:)
+allocate(a(5))
+a(:) = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 41
+if (any(m /= (/ 2 /))) stop 42
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+integer, allocatable :: a(:,:,:)
+integer, allocatable :: m(:)
+allocate(a(4,4,4))
+a(:,:,:) = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 51
+if (any(m /= (/ 2, 2, 1 /))) stop 52
+ end subroutine
+ subroutine check_int_alloc_empty_4()
+integer, allocatable :: a(:,:,:,:)
+integer, allocatable :: m(:)
+allocate(a(9,3,0,7))
+a(:,:,:,:) = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 61
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 62
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+real :: a(5)
+integer, allocatable :: m(:)
+a = (/ real:: data5 /)
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 71
+if (any(m /= (/ 2 /))) stop 72
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+real :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape((/ real:: data64 /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 81
+if (any(m /= (/ 2, 2, 1 /))) stop 82
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+real :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ real:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 91
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 92
+ end
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:826cbd802b72c2a5d450493f86e7ee0106432282
commit 826cbd802b72c2a5d450493f86e7ee0106432282
Author: Mikael Morin
Date: Mon Jul 22 13:27:24 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Hello,
this fixes a null pointer dereference with absent optional dummy passed
as BACK argument of MINLOC/MAXLOC.
Tested for regression on x86_64-linux.
OK for master?
-- >8 --
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 81 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 799 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..9f3c3ce47bc5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,27 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ gcc_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+
[gcc] Created branch 'mikael/heads/inline_minmaxloc_without_dim_v06' in namespace 'refs/users'
The branch 'mikael/heads/inline_minmaxloc_without_dim_v06' was created in namespace 'refs/users' pointing to: 215d87c9e87f... fortran: Continue MINLOC/MAXLOC second loop where the first
[gcc] Deleted branch 'mikael/heads/inline_minmaxloc_without_dim_v06' in namespace 'refs/users'
The branch 'mikael/heads/inline_minmaxloc_without_dim_v06' in namespace 'refs/users' was deleted. It previously pointed to: b2a5e99f9fb7... fortran: Continue MINLOC/MAXLOC second loop where the first Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- b2a5e99... fortran: Continue MINLOC/MAXLOC second loop where the first c8f... fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR9060 26fc4fb... fortran: Inline integral MINLOC/MAXLOC with no DIM and scal 31aa4cd... fortran: Inline integral MINLOC/MAXLOC with no DIM and no M 0090c54... fortran: Outline array bound check generation code 243591a... fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 0c6f911... fortran: Disable frontend passes for MINLOC/MAXLOC if it's c1eb87c... fortran: Add tests covering inline MINLOC/MAXLOC without DI 826cbd8... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Continue MINLOC/MAXLOC second loop where the first stopped [PR90608]
https://gcc.gnu.org/g:b2a5e99f9fb724b9838533c1eed5f4fc024be633
commit b2a5e99f9fb724b9838533c1eed5f4fc024be633
Author: Mikael Morin
Date: Thu Jul 25 12:27:09 2024 +0200
fortran: Continue MINLOC/MAXLOC second loop where the first stopped
[PR90608]
Continue the second set of loops where the first one stopped in the
generated inline MINLOC/MAXLOC code in the cases where the generated code
contains two sets of loops. This fixes a regression that was introduced
when enabling the generation of inline MINLOC/MAXLOC code with ARRAY of rank
greater than 1, non-scalar MASK and no DIM arguments.
In the cases where two sets of loops are generated as inline MINLOC/MAXLOC
code, we previously generated code such as (for rank 2 ARRAY, so with two
levels of nesting):
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in lower1..upper1)
{
for (idx22 in lower2..upper2)
{
...
}
}
which means we process the first elements twice, once in the first set
of loops and once in the second one. This change avoids this duplicate
processing by using a conditional as lower bound for the second set of
loops, generating code like:
second_loop_entry = false;
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
second_loop_entry = true;
goto second_loop;
}
}
}
second_loop:
for (idx21 in (second_loop_entry ? idx11 : lower1)..upper1)
{
for (idx22 in (second_loop_entry ? idx12 : lower2)..upper2)
{
...
second_loop_entry = false;
}
}
It was expected that the compiler optimizations would be able to remove the
state variable second_loop_entry. It is the case if ARRAY has rank 1 (so
without loop nesting), the variable is removed and the loop bounds become
unconditional, which restores previously generated code, fully fixing the
regression. For larger rank, unfortunately, the state variable and
conditional loop bounds remain, but those cases were previously using
library calls, so it's not a regression.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate a set
of index variables. Set them using the loop indexes before leaving
the first set of loops. Generate a new loop entry predicate.
Set it before leaving the first set of loops. Clear it in the body
of the second set of loops. For the second set of loops, update
each loop variable to use the corresponding index variable if the
predicate variable is set.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 33 +++--
1 file changed, 31 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index bae3b49a9498..29367c69d16b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5342,6 +5342,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = 0;
pos1 = 1
S1 = from1;
+second_loop_entry = false;
while (S1 <= to1) {
S0 = from0;
while (s0 <= to0 {
@@ -5354,6 +5355,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
limit = a[S1][S0];
pos0 = S0 + (1 - from0);
pos1 = S1 + (1 - from1);
+second_loop_entry = true;
goto lab1;
}
}
@@ -5363,9 +5365,9 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
}
goto lab2;
lab1:;
-S1 = from1;
+S1 = second_loop_entry ? S1 : from1;
while (S1 <= to1) {
- S0 = from0;
+ S0 = second_loop_entry ? S0 : from0;
while (S0 <= to0) {
if (mask[S1][S0])
if (a[S1][S0] < limit) {
@@ -5373,6 +5375,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = S + (1 - from0);
pos1 = S + (1 - from1);
}
+second_loop_entry = false;
S0++;
}
S1++;
@@ -5444,6 +5447,7
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
https://gcc.gnu.org/g:c8f1b21681c6d3e4f313044545d5426f50cb
commit c8f1b21681c6d3e4f313044545d5426f50cb
Author: Mikael Morin
Date: Fri Nov 17 16:47:26 2023 +0100
fortran: Inline all MINLOC/MAXLOC calls with no DIM [PR90608]
Enable generation of inline MINLOC/MAXLOC code in the case where DIM
is not present, and either ARRAY is of floating point type or MASK is an
array. Those cases are the remaining bits to fully support inlining of
non-CHARACTER MINLOC/MAXLOC without DIM. They are treated together because
they generate similar code, the NANs for REAL types being handled a bit like
a second level of masking. These are the cases for which we generate two
sets of loops.
This change affects the code generating the second loop, that was previously
accessible only in the cases ARRAY has rank rank 1. The single variable
initialization and update are changed to apply to multiple variables, one
per dimension.
This change generates slightly worse code if ARRAY has rank 1. Indeed
the code we used to generate was:
for (idx1 in lower..upper)
{
...
if (...)
{
...
break;
}
}
for (idx2 in idx1..upper)
{
...
}
which avoided starting the second loop from lower, skipping in the second
loop the elements already processed in the first one. Unfortunately,
extending that code the obvious way to apply to rank > 1 leads to wrong
code:
for (idx11 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
if (...)
{
...
goto second_loop;
}
}
}
second_loop:
for (idx21 in index11..upper1)
{
for (idx22 in index12..upper2)
{
...
}
}
That code is incorrect, as the loop over idx22, being nested, may be run
more than once, and the second run should restart from lower2, not index12.
So with this change, we generate instead as second set of loops:
...
second_loop:
for (idx21 in lower1..upper1)
{
for (idx12 in lower2..upper2)
{
...
}
}
which means the second set of loops processes again elements already
processed by the first one, and the rank 1 case becomes:
for (idx1 in lower..upper)
{
...
if (...)
{
...
break;
}
}
for (idx2 in lower..upper)
{
...
}
processing the first elements twice as well, which was not the case
before. A later change will avoid the duplicate processing and restore
the generated code in the rank 1 case.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Initialize
and update all the variables. Put the label and goto in the
outermost scalarizer loop. Don't start the second loop where the
first stopped.
(gfc_inline_intrinsic_function_p): Also return TRUE for array MASK
or for any REAL type.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_5.f90: Additionally accept error
messages reported by the scalarizer.
* gfortran.dg/maxloc_bounds_6.f90: Ditto.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 127 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 | 4 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 | 4 +-
3 files changed, 87 insertions(+), 48 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 855208717973..bae3b49a9498 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5332,12 +5332,55 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
S++;
}
- B: ARRAY has rank 1, and DIM is absent. Use the same code as the scalar
- case and wrap the result in an array.
- C: ARRAY has rank > 1, NANs are not supported, and DIM and MASK are absent.
- Generate code similar to the single loop scalar case, but using one
- variable per dimension, for example if ARRAY has rank 2:
- 4) NAN's aren't supported, no MASK:
+ B: Array result, non-CHARACTER type,
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
https://gcc.gnu.org/g:26fc4fb4228dc6584ee9153498cc85a16a5ec822
commit 26fc4fb4228dc6584ee9153498cc85a16a5ec822
Author: Mikael Morin
Date: Fri Nov 17 15:40:55 2023 +0100
fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
Enable the generation of inline code for MINLOC/MAXLOC when argument ARRAY
is of integral type, DIM is not present, and MASK is present and is scalar
(only absent MASK or rank 1 ARRAY were inlined before).
Scalar masks are implemented with a wrapping condition around the code one
would generate if MASK wasn't present, so they are easy to support once
inline code without MASK is working.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Generate
variable initialization for each dimension in the else branch of
the toplevel condition.
(gfc_inline_intrinsic_function_p): Return TRUE for scalar MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_7.f90: Additionally accept the error
message
reported by the scalarizer.
Diff:
---
gcc/fortran/trans-intrinsic.cc| 13 -
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 4 ++--
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index ac8bd2d48123..855208717973 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5886,7 +5886,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
/* For a scalar mask, enclose the loop in an if statement. */
if (maskexpr && maskss == NULL)
{
- gcc_assert (loop.dimen == 1);
tree ifmask;
gfc_init_se (, NULL);
@@ -5901,7 +5900,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
the pos variable the same way as above. */
gfc_init_block ();
- gfc_add_modify (, pos[0], gfc_index_zero_node);
+ for (int i = 0; i < loop.dimen; i++)
+ gfc_add_modify (, pos[i], gfc_index_zero_node);
elsetmp = gfc_finish_block ();
ifmask = conv_mask_condition (, maskexpr, optional_mask);
tmp = build3_v (COND_EXPR, ifmask, tmp, elsetmp);
@@ -11795,9 +11795,12 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
if (array->rank == 1)
return true;
- if (array->ts.type == BT_INTEGER
- && dim == nullptr
- && mask == nullptr)
+ if (array->ts.type != BT_INTEGER
+ || dim != nullptr)
+ return false;
+
+ if (mask == nullptr
+ || mask->rank == 0)
return true;
return false;
diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
index 206a29b149da..3aa9d3dcebee 100644
--- a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
+++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
@@ -1,6 +1,6 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
-! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2" }
+! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3,
should be 2|Array bound mismatch for dimension 1 of array 'res' .3/2." }
module tst
contains
subroutine foo(res)
@@ -18,4 +18,4 @@ program main
integer :: res(3)
call foo(res)
end program main
-! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of
MAXLOC intrinsic: is 3, should be 2|Array bound mismatch for dimension 1 of
array 'res' .3/2." }
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
https://gcc.gnu.org/g:31aa4cd8489361a61cbf1f92327934bcc860a2f2
commit 31aa4cd8489361a61cbf1f92327934bcc860a2f2
Author: Mikael Morin
Date: Thu Nov 16 22:14:41 2023 +0100
fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
Enable generation of inline code for the MINLOC and MAXLOC intrinsic,
if the ARRAY argument is of integral type and of any rank (only the rank 1
case was previously inlined), and neither DIM nor MASK arguments are
present.
This needs a few adjustments in gfc_conv_intrinsic_minmaxloc,
mainly to replace the single variables POS and OFFSET, with collections
of variables, one variable per dimension each.
The restriction to integral ARRAY and absent MASK limits the scope of
the change to the cases where we generate single loop inline code. The
code generation for the second loop is only accessible with ARRAY of rank
1, so it can continue using a single variable. A later change will extend
inlining to the double loop cases.
There is some bounds checking code that was previously handled by the
library, and that needed some changes in the scalarizer to avoid regressing.
The bounds check code generation was already by the scalarizer, but it was
only applying to array reference sections, checking both individual array
bounds and shape conformability between all the array involved. For MINLOC
or MAXLOC, enable the conformability check between all the scalarized
arrays, and disable the check that the array reference is within its bounds.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the MINLOC/MAXLOC
result upper bound using the ARRAY argument rank. Ajdust the error
message for intrinsic result arrays. Only check array bounds for
array references. Move bound check decision code...
(bounds_check_needed): ... here as a new predicate. Allow bound
check for MINLOC/MAXLOC intrinsic results.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Change the
result array upper bound to the rank of ARRAY. Update the NONEMPTY
variable to depend on the non-empty extent of every dimension. Use
one variable per dimension instead of a single variable for the
position and the offset. Update their declaration, initialization,
and update to affect the variable of each dimension. Use the first
variable only in areas only accessed with rank 1 ARRAY argument.
Set every element of the result using its corresponding variable.
(gfc_inline_intrinsic_function_p): Return true for integral ARRAY
and absent DIM and MASK.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_bounds_4.f90: Additionally accept the error
message emitted by the scalarizer.
Diff:
---
gcc/fortran/trans-array.cc| 70 +---
gcc/fortran/trans-intrinsic.cc| 148 +++---
gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 4 +-
3 files changed, 165 insertions(+), 57 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 99a603a3afb2..c9d63d13509d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4876,6 +4876,35 @@ add_check_section_in_array_bounds (stmtblock_t *inner,
gfc_ss_info *ss_info,
}
+/* Tells whether we need to generate bounds checking code for the array
+ associated with SS. */
+
+bool
+bounds_check_needed (gfc_ss *ss)
+{
+ /* Catch allocatable lhs in f2003. */
+ if (flag_realloc_lhs && ss->no_bounds_check)
+return false;
+
+ gfc_ss_info *ss_info = ss->info;
+ if (ss_info->type == GFC_SS_SECTION)
+return true;
+
+ if (!(ss_info->type == GFC_SS_INTRINSIC
+ && ss_info->expr
+ && ss_info->expr->expr_type == EXPR_FUNCTION))
+return false;
+
+ gfc_intrinsic_sym *isym = ss_info->expr->value.function.isym;
+ if (!(isym
+ && (isym->id == GFC_ISYM_MAXLOC
+ || isym->id == GFC_ISYM_MINLOC)))
+return false;
+
+ return gfc_inline_intrinsic_function_p (ss_info->expr);
+}
+
+
/* Calculates the range start and stride for a SS chain. Also gets the
descriptor and data pointer. The range of vector subscripts is the size
of the vector. Array bounds are also checked. */
@@ -4977,10 +5006,19 @@ done:
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, _loop->pre);
- info->offset = gfc_index_zero_node;
+ gfc_expr *array = expr->value.function.actual->expr;
+ tree rank = build_int_cst (gfc_array_index_type, array->rank);
+
+ tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Outline array bound check generation code
https://gcc.gnu.org/g:0090c54560c24fead1245245626fe7afe6339373
commit 0090c54560c24fead1245245626fe7afe6339373
Author: Mikael Morin
Date: Wed Apr 10 21:18:03 2024 +0200
fortran: Outline array bound check generation code
The next patch will need reindenting of the array bound check generation
code. This outlines it to its own function beforehand, reducing the churn
in the next patch.
-- >8 --
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Move array bound check
generation code...
(add_check_section_in_array_bounds): ... here as a new function.
Diff:
---
gcc/fortran/trans-array.cc | 297 ++---
1 file changed, 143 insertions(+), 154 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0c78e1fecd8f..99a603a3afb2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4736,6 +4736,146 @@ gfc_conv_section_startstride (stmtblock_t * block,
gfc_ss * ss, int dim)
}
+/* Generate in INNER the bounds checking code along the dimension DIM for
+ the array associated with SS_INFO. */
+
+static void
+add_check_section_in_array_bounds (stmtblock_t *inner, gfc_ss_info *ss_info,
+ int dim)
+{
+ gfc_expr *expr = ss_info->expr;
+ locus *expr_loc = >where;
+ const char *expr_name = expr->symtree->name;
+
+ gfc_array_info *info = _info->data.array;
+
+ bool check_upper;
+ if (dim == info->ref->u.ar.dimen - 1
+ && info->ref->u.ar.as->type == AS_ASSUMED_SIZE)
+check_upper = false;
+ else
+check_upper = true;
+
+ /* Zero stride is not allowed. */
+ tree tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+ info->stride[dim], gfc_index_zero_node);
+ char * msg = xasprintf ("Zero stride is not allowed, for dimension %d "
+ "of array '%s'", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg);
+ free (msg);
+
+ tree desc = info->descriptor;
+
+ /* This is the run-time equivalent of resolve.cc's
+ check_dimension. The logical is more readable there
+ than it is here, with all the trees. */
+ tree lbound = gfc_conv_array_lbound (desc, dim);
+ tree end = info->end[dim];
+ tree ubound = check_upper ? gfc_conv_array_ubound (desc, dim) : NULL_TREE;
+
+ /* non_zerosized is true when the selected range is not
+ empty. */
+ tree stride_pos = fold_build2_loc (input_location, GT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_pos = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_pos, tmp);
+
+ tree stride_neg = fold_build2_loc (input_location, LT_EXPR,
logical_type_node,
+info->stride[dim], gfc_index_zero_node);
+ tmp = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+info->start[dim], end);
+ stride_neg = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+ logical_type_node, stride_neg, tmp);
+ tree non_zerosized = fold_build2_loc (input_location, TRUTH_OR_EXPR,
+ logical_type_node, stride_pos,
+ stride_neg);
+
+ /* Check the start of the range against the lower and upper
+ bounds of the array, if the range is not empty.
+ If upper bound is present, include both bounds in the
+ error message. */
+ if (check_upper)
+{
+ tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+info->start[dim], lbound);
+ tmp = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
+non_zerosized, tmp);
+ tree tmp2 = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
+ info->start[dim], ubound);
+ tmp2 = fold_build2_loc (input_location, TRUTH_AND_EXPR,
logical_type_node,
+ non_zerosized, tmp2);
+ msg = xasprintf ("Index '%%ld' of dimension %d of array '%s' outside of "
+ "expected range (%%ld:%%ld)", dim + 1, expr_name);
+ gfc_trans_runtime_check (true, false, tmp, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+ fold_convert (long_integer_type_node, ubound));
+ gfc_trans_runtime_check (true, false, tmp2, inner, expr_loc, msg,
+ fold_convert (long_integer_type_node, info->start[dim]),
+ fold_convert (long_integer_type_node, lbound),
+ fold_convert (long_integer_type_node, ubound));
+ free (msg);
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
https://gcc.gnu.org/g:243591a6c8b99b1a337fd79643a27a9b287a2fed
commit 243591a6c8b99b1a337fd79643a27a9b287a2fed
Author: Mikael Morin
Date: Tue Jul 9 21:05:40 2024 +0200
fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
Enable inline code generation for the MINLOC and MAXLOC intrinsic, if the
DIM argument is not present and ARRAY has rank 1. This case is similar to
the case where the result is scalar (DIM present and rank 1 ARRAY), which
already supports inline expansion of the intrinsic. Both cases return
the same value, with the difference that the result is an array of size 1 if
DIM is absent, whereas it's a scalar if DIM is present. So all there is
to do for this case to work is hook the inline expansion with the
scalarizer.
PR fortran/90608
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_conv_ss_startstride): Set the scalarization
rank based on the MINLOC/MAXLOC rank if needed. Call the inline
code generation and setup the scalarizer array descriptor info
in the MINLOC and MAXLOC cases.
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Return the
result array element if the scalarizer is setup and we are inside
the loop. Restrict library function call dispatch to the case
where inline expansion is not supported. Declare an array result
if the expression isn't scalar. Initialize the array result single
element and return the result variable if the expression isn't
scalar.
(walk_inline_intrinsic_minmaxloc): New function.
(walk_inline_intrinsic_function): Add MINLOC and MAXLOC cases,
dispatching to walk_inline_intrinsic_minmaxloc.
(gfc_add_intrinsic_ss_code): Add MINLOC and MAXLOC cases.
(gfc_inline_intrinsic_function_p): Return true if ARRAY has rank 1,
regardless of DIM.
Diff:
---
gcc/fortran/trans-array.cc | 25 ++
gcc/fortran/trans-intrinsic.cc | 196 +++--
2 files changed, 155 insertions(+), 66 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c93a5f1e7543..0c78e1fecd8f 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4771,6 +4771,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
case GFC_ISYM_UBOUND:
case GFC_ISYM_LCOBOUND:
case GFC_ISYM_UCOBOUND:
+ case GFC_ISYM_MAXLOC:
+ case GFC_ISYM_MINLOC:
case GFC_ISYM_SHAPE:
case GFC_ISYM_THIS_IMAGE:
loop->dimen = ss->dimen;
@@ -4820,6 +4822,29 @@ done:
case GFC_SS_INTRINSIC:
switch (expr->value.function.isym->id)
{
+ case GFC_ISYM_MINLOC:
+ case GFC_ISYM_MAXLOC:
+ {
+ gfc_se se;
+ gfc_init_se (, nullptr);
+ se.loop = loop;
+ se.ss = ss;
+ gfc_conv_intrinsic_function (, expr);
+ gfc_add_block_to_block (_loop->pre, );
+ gfc_add_block_to_block (_loop->post, );
+
+ info->descriptor = se.expr;
+
+ info->data = gfc_conv_array_data (info->descriptor);
+ info->data = gfc_evaluate_now (info->data, _loop->pre);
+
+ info->offset = gfc_index_zero_node;
+ info->start[0] = gfc_index_zero_node;
+ info->end[0] = gfc_index_zero_node;
+ info->stride[0] = gfc_index_one_node;
+ continue;
+ }
+
/* Fall through to supply start and stride. */
case GFC_ISYM_LBOUND:
case GFC_ISYM_UBOUND:
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cc0d00f4e399..7b7d0102b86a 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5273,66 +5273,69 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
we need to handle. For performance reasons we sometimes create two
loops instead of one, where the second one is much simpler.
Examples for minloc intrinsic:
- 1) Result is an array, a call is generated
- 2) Array mask is used and NaNs need to be supported:
- limit = Infinity;
- pos = 0;
- S = from;
- while (S <= to) {
- if (mask[S]) {
- if (pos == 0) pos = S + (1 - from);
- if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
- }
- S++;
- }
- goto lab2;
- lab1:;
- while (S <= to) {
- if (mask[S]) if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
- S++;
- }
- lab2:;
- 3) NaNs need to be supported, but it is known at compile time or cheaply
- at runtime whether array is nonempty or not:
- limit = Infinity;
- pos = 0;
- S = from;
- while (S <= to) {
-
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
https://gcc.gnu.org/g:0c6f911ae6433ab0c3cc668083bd45aee52723bf
commit 0c6f911ae6433ab0c3cc668083bd45aee52723bf
Author: Mikael Morin
Date: Wed Nov 15 10:23:32 2023 +0100
fortran: Disable frontend passes for MINLOC/MAXLOC if it's inlined
Disable rewriting of MINLOC/MAXLOC expressions for which inline code
generation is supported. Update the gfc_inline_intrinsic_function_p
predicate (already existing) for that, with the current state of
MINLOC/MAXLOC inlining support, that is only the cases of a scalar
result and non-CHARACTER argument for now.
This change has no effect currently, as the MINLOC/MAXLOC front-end passes
only change expressions of rank 1, but the inlining control predicate
gfc_inline_intrinsic_function_p returns false for those. However, later
changes will extend MINLOC/MAXLOC inline expansion support to array
expressions and update the inlining control predicate, and this will become
effective.
gcc/fortran/ChangeLog:
* frontend-passes.cc (optimize_minmaxloc): Skip if we can generate
inline code for the unmodified expression.
* trans-intrinsic.cc (gfc_inline_intrinsic_function_p): Add
MINLOC and MAXLOC cases.
Diff:
---
gcc/fortran/frontend-passes.cc | 3 ++-
gcc/fortran/trans-intrinsic.cc | 23 +++
2 files changed, 25 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 3c06018fdbbf..8e4c6310ba8d 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -2277,7 +2277,8 @@ optimize_minmaxloc (gfc_expr **e)
|| fn->value.function.actual == NULL
|| fn->value.function.actual->expr == NULL
|| fn->value.function.actual->expr->ts.type == BT_CHARACTER
- || fn->value.function.actual->expr->rank != 1)
+ || fn->value.function.actual->expr->rank != 1
+ || gfc_inline_intrinsic_function_p (fn))
return;
*e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, >where);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9f3c3ce47bc5..cc0d00f4e399 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11650,6 +11650,29 @@ gfc_inline_intrinsic_function_p (gfc_expr *expr)
case GFC_ISYM_TRANSPOSE:
return true;
+case GFC_ISYM_MINLOC:
+case GFC_ISYM_MAXLOC:
+ {
+ /* Disable inline expansion if code size matters. */
+ if (optimize_size)
+ return false;
+
+ gfc_actual_arglist *array_arg = expr->value.function.actual;
+ gfc_actual_arglist *dim_arg = array_arg->next;
+
+ gfc_expr *array = array_arg->expr;
+ gfc_expr *dim = dim_arg->expr;
+
+ if (!(array->ts.type == BT_INTEGER
+ || array->ts.type == BT_REAL))
+ return false;
+
+ if (array->rank == 1 && dim != nullptr)
+ return true;
+
+ return false;
+ }
+
default:
return false;
}
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:826cbd802b72c2a5d450493f86e7ee0106432282
commit 826cbd802b72c2a5d450493f86e7ee0106432282
Author: Mikael Morin
Date: Mon Jul 22 13:27:24 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Hello,
this fixes a null pointer dereference with absent optional dummy passed
as BACK argument of MINLOC/MAXLOC.
Tested for regression on x86_64-linux.
OK for master?
-- >8 --
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 81 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 799 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..9f3c3ce47bc5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,27 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ gcc_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+
[gcc(refs/users/mikael/heads/inline_minmaxloc_without_dim_v06)] fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
https://gcc.gnu.org/g:c1eb87cb9470518cf499765fd72c8810f943c239
commit c1eb87cb9470518cf499765fd72c8810f943c239
Author: Mikael Morin
Date: Thu Jul 25 18:04:13 2024 +0200
fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
Add the tests covering the various cases for which we are about to implement
inline expansion of MINLOC and MAXLOC. Those are cases where the DIM
argument is not present.
PR fortran/90608
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_7.f90: New test.
* gfortran.dg/maxloc_with_mask_1.f90: New test.
* gfortran.dg/minloc_8.f90: New test.
* gfortran.dg/minloc_with_mask_1.f90: New test.
Diff:
---
gcc/testsuite/gfortran.dg/maxloc_7.f90 | 220 +
gcc/testsuite/gfortran.dg/maxloc_with_mask_1.f90 | 393 +++
gcc/testsuite/gfortran.dg/minloc_8.f90 | 220 +
gcc/testsuite/gfortran.dg/minloc_with_mask_1.f90 | 392 ++
4 files changed, 1225 insertions(+)
diff --git a/gcc/testsuite/gfortran.dg/maxloc_7.f90
b/gcc/testsuite/gfortran.dg/maxloc_7.f90
new file mode 100644
index ..a875083052a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_7.f90
@@ -0,0 +1,220 @@
+! { dg-do run }
+!
+! PR fortran/90608
+! Check the correct behaviour of the inline maxloc implementation,
+! when there is no optional argument.
+
+program p
+ implicit none
+ integer, parameter :: data5(*) = (/ 1, 7, 2, 7, 0 /)
+ integer, parameter :: data64(*) = (/ 2, 5, 4, 6, 0, 9, 3, 5, &
+ 4, 4, 1, 7, 3, 2, 1, 2, &
+ 5, 4, 6, 0, 9, 3, 5, 4, &
+ 4, 1, 7, 3, 2, 1, 2, 5, &
+ 4, 6, 0, 9, 3, 5, 4, 4, &
+ 1, 7, 3, 2, 1, 2, 5, 4, &
+ 6, 0, 9, 3, 5, 4, 4, 1, &
+ 7, 3, 2, 1, 2, 5, 4, 6 /)
+ call check_int_const_shape_rank_1
+ call check_int_const_shape_rank_3
+ call check_int_const_shape_empty_4
+ call check_int_alloc_rank_1
+ call check_int_alloc_rank_3
+ call check_int_alloc_empty_4
+ call check_real_const_shape_rank_1
+ call check_real_const_shape_rank_3
+ call check_real_const_shape_empty_4
+ call check_real_alloc_rank_1
+ call check_real_alloc_rank_3
+ call check_real_alloc_empty_4
+ call check_int_lower_bounds
+ call check_real_lower_bounds
+ call check_all_nans
+ call check_dependencies
+contains
+ subroutine check_int_const_shape_rank_1()
+integer :: a(5)
+integer, allocatable :: m(:)
+a = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 11
+if (any(m /= (/ 2 /))) stop 12
+ end subroutine
+ subroutine check_int_const_shape_rank_3()
+integer :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 21
+if (any(m /= (/ 2, 2, 1 /))) stop 22
+ end subroutine
+ subroutine check_int_const_shape_empty_4()
+integer :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 31
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 32
+ end subroutine
+ subroutine check_int_alloc_rank_1()
+integer, allocatable :: a(:)
+integer, allocatable :: m(:)
+allocate(a(5))
+a(:) = data5
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 41
+if (any(m /= (/ 2 /))) stop 42
+ end subroutine
+ subroutine check_int_alloc_rank_3()
+integer, allocatable :: a(:,:,:)
+integer, allocatable :: m(:)
+allocate(a(4,4,4))
+a(:,:,:) = reshape(data64, shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 51
+if (any(m /= (/ 2, 2, 1 /))) stop 52
+ end subroutine
+ subroutine check_int_alloc_empty_4()
+integer, allocatable :: a(:,:,:,:)
+integer, allocatable :: m(:)
+allocate(a(9,3,0,7))
+a(:,:,:,:) = reshape((/ integer:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 61
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 62
+ end subroutine
+ subroutine check_real_const_shape_rank_1()
+real :: a(5)
+integer, allocatable :: m(:)
+a = (/ real:: data5 /)
+m = maxloc(a)
+if (size(m, dim=1) /= 1) stop 71
+if (any(m /= (/ 2 /))) stop 72
+ end subroutine
+ subroutine check_real_const_shape_rank_3()
+real :: a(4,4,4)
+integer, allocatable :: m(:)
+a = reshape((/ real:: data64 /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 81
+if (any(m /= (/ 2, 2, 1 /))) stop 82
+ end subroutine
+ subroutine check_real_const_shape_empty_4()
+real :: a(9,3,0,7)
+integer, allocatable :: m(:)
+a = reshape((/ real:: /), shape(a))
+m = maxloc(a)
+if (size(m, dim=1) /= 4) stop 91
+if (any(m /= (/ 0, 0, 0, 0 /))) stop 92
+ end
[gcc] Created branch 'mikael/heads/inline_minmaxloc_without_dim_v06' in namespace 'refs/users'
The branch 'mikael/heads/inline_minmaxloc_without_dim_v06' was created in namespace 'refs/users' pointing to: b2a5e99f9fb7... fortran: Continue MINLOC/MAXLOC second loop where the first
[gcc] Deleted branch 'mikael/heads/factor_back_minmaxloc_v01' in namespace 'refs/users'
The branch 'mikael/heads/factor_back_minmaxloc_v01' in namespace 'refs/users' was deleted. It previously pointed to: a04c0d344553... Sauvegarde tests Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- a04c0d3... Sauvegarde tests
[gcc] Deleted branch 'mikael/heads/backport14_PR99798_v01' in namespace 'refs/users'
The branch 'mikael/heads/backport14_PR99798_v01' in namespace 'refs/users' was deleted. It previously pointed to: c80a74602390... fortran: Assume there is no cyclic reference with submodule
[gcc] Deleted branch 'mikael/heads/add_scalar_mask_code_v01' in namespace 'refs/users'
The branch 'mikael/heads/add_scalar_mask_code_v01' in namespace 'refs/users' was deleted. It previously pointed to: cee2ecb8a526... fortran: Correctly evaluate the MASK argument of MINLOC/MAX Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- cee2ecb... fortran: Correctly evaluate the MASK argument of MINLOC/MAX
[gcc] Deleted branch 'mikael/heads/add_scalar_mask_code_gcc14_v01' in namespace 'refs/users'
The branch 'mikael/heads/add_scalar_mask_code_gcc14_v01' in namespace 'refs/users' was deleted. It previously pointed to: 4032ccc4713a... fortran: Correctly evaluate scalar MASK arguments of MINLOC Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 4032ccc... fortran: Correctly evaluate scalar MASK arguments of MINLOC
[gcc] Deleted branch 'mikael/heads/add_code_scalar_mask_minmaxloc_v02' in namespace 'refs/users'
The branch 'mikael/heads/add_code_scalar_mask_minmaxloc_v02' in namespace 'refs/users' was deleted. It previously pointed to: 08267b90e326... fortran: Correctly evaluate scalar MASK arguments of MINLOC Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 08267b9... fortran: Correctly evaluate scalar MASK arguments of MINLOC
[gcc(refs/users/mikael/heads/dummy_back_minmaxloc_v01)] fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
https://gcc.gnu.org/g:baba12c6c972b5f59e6db2bc6b4f3ceb3005f392
commit baba12c6c972b5f59e6db2bc6b4f3ceb3005f392
Author: Mikael Morin
Date: Mon Jul 22 13:27:24 2024 +0200
fortran: Support optional dummy as BACK argument of MINLOC/MAXLOC.
Protect the evaluation of BACK with a check that the reference is non-null
in case the expression is an optional dummy, in the inline code generated
for MINLOC and MAXLOC.
This change contains a revert of the non-testsuite part of commit
r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3, which factored the
evaluation of BACK out of the loop using the scalarizer. It was a bad idea,
because delegating the argument evaluation to the scalarizer makes it
cumbersome to add a null pointer check next to the evaluation.
Instead, evaluate BACK at the beginning, before scalarization, add a check
that the argument is present if necessary, and evaluate the resulting
expression to a variable, before using the variable in the inline code.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (maybe_absent_optional_variable): New function.
(gfc_conv_intrinsic_minmaxloc): Remove BACK from scalarization and
evaluate it before. Add a check that BACK is not null if the
expression is an optional dummy. Save the resulting expression to a
variable. Use the variable in the generated inline code.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_6.f90: New test.
* gfortran.dg/minloc_7.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 81 ++--
gcc/testsuite/gfortran.dg/maxloc_6.f90 | 366 +
gcc/testsuite/gfortran.dg/minloc_7.f90 | 366 +
3 files changed, 799 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 180d0d7a88c6..9f3c3ce47bc5 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5209,6 +5209,50 @@ gfc_conv_intrinsic_dot_product (gfc_se * se, gfc_expr *
expr)
}
+/* Tells whether the expression E is a reference to an optional variable whose
+ presence is not known at compile time. Those are variable references
without
+ subreference; if there is a subreference, we can assume the variable is
+ present. We have to special case full arrays, which we represent with a
fake
+ "full" reference, and class descriptors for which a reference to data is not
+ really a subreference. */
+
+bool
+maybe_absent_optional_variable (gfc_expr *e)
+{
+ if (!(e && e->expr_type == EXPR_VARIABLE))
+return false;
+
+ gfc_symbol *sym = e->symtree->n.sym;
+ if (!sym->attr.optional)
+return false;
+
+ gfc_ref *ref = e->ref;
+ if (ref == nullptr)
+return true;
+
+ if (ref->type == REF_ARRAY
+ && ref->u.ar.type == AR_FULL
+ && ref->next == nullptr)
+return true;
+
+ if (!(sym->ts.type == BT_CLASS
+ && ref->type == REF_COMPONENT
+ && ref->u.c.component == CLASS_DATA (sym)))
+return false;
+
+ gfc_ref *next_ref = ref->next;
+ if (next_ref == nullptr)
+return true;
+
+ if (next_ref->type == REF_ARRAY
+ && next_ref->u.ar.type == AR_FULL
+ && next_ref->next == nullptr)
+return true;
+
+ return false;
+}
+
+
/* Remove unneeded kind= argument from actual argument list when the
result conversion is dealt with in a different place. */
@@ -5321,11 +5365,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
tree nonempty;
tree lab1, lab2;
tree b_if, b_else;
+ tree back;
gfc_loopinfo loop;
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
- gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5391,10 +5435,27 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
- if (backexpr)
-backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+
+ gfc_init_se (, NULL);
+ if (backexpr == nullptr)
+back = logical_false_node;
+ else if (maybe_absent_optional_variable (backexpr))
+{
+ gcc_assert (backexpr->expr_type == EXPR_VARIABLE);
+
+ gfc_conv_expr (, backexpr);
+ tree present = gfc_conv_expr_present (backexpr->symtree->n.sym, false);
+ back = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+ logical_type_node, present, backse.expr);
+}
else
-backss = nullptr;
+{
+ gfc_conv_expr (, backexpr);
+ back = backse.expr;
+}
+ gfc_add_block_to_block (>pre, );
+ back = gfc_evaluate_now_loc (input_location, back, >pre);
+ gfc_add_block_to_block (>pre, );
nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
@@ -5455,9 +5516,6 @@
[gcc] Created branch 'mikael/heads/dummy_back_minmaxloc_v01' in namespace 'refs/users'
The branch 'mikael/heads/dummy_back_minmaxloc_v01' was created in namespace 'refs/users' pointing to: baba12c6c972... fortran: Support optional dummy as BACK argument of MINLOC/
[gcc r14-10420] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]
https://gcc.gnu.org/g:c80a7460239037d8cf8426dbb7d03c6ddac09bab
commit r14-10420-gc80a7460239037d8cf8426dbb7d03c6ddac09bab
Author: Mikael Morin
Date: Sun May 12 15:16:23 2024 +0200
fortran: Assume there is no cyclic reference with submodule symbols
[PR99798]
This prevents a premature release of memory with procedure symbols from
submodules, causing random compiler crashes.
The problem is a fragile detection of cyclic references, which can match
with procedures host-associated from a module in submodules, in cases where
it
shouldn't. The formal namespace is released, and with it the dummy
arguments
symbols of the procedure. But there is no cyclic reference, so the
procedure
symbol itself is not released and remains, with pointers to its dummy
arguments
now dangling.
The fix adds a condition to avoid the case, and refactors to a new predicate
by the way. Part of the original condition is also removed, for lack of a
reason to keep it.
PR fortran/99798
gcc/fortran/ChangeLog:
* symbol.cc (gfc_release_symbol): Move the condition guarding
the handling cyclic references...
(cyclic_reference_break_needed): ... here as a new predicate.
Remove superfluous parts. Add a condition preventing any premature
release with submodule symbols.
gcc/testsuite/ChangeLog:
* gfortran.dg/submodule_33.f08: New test.
(cherry picked from commit 38d1761c0c94b77a081ccc180d6e039f7a670468)
Diff:
---
gcc/fortran/symbol.cc | 54 --
gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 +++
2 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1ee..0a1646def678 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
}
+/* Returns true if the symbol SYM has, through its FORMAL_NS field, a reference
+ to itself which should be eliminated for the symbol memory to be released
+ via normal reference counting.
+
+ The implementation is crucial as it controls the proper release of symbols,
+ especially (contained) procedure symbols, which can represent a lot of
memory
+ through the namespace of their body.
+
+ We try to avoid freeing too much memory (causing dangling pointers), to not
+ leak too much (wasting memory), and to avoid expensive walks of the symbol
+ tree (which would be the correct way to check for a cycle). */
+
+bool
+cyclic_reference_break_needed (gfc_symbol *sym)
+{
+ /* Normal symbols don't reference themselves. */
+ if (sym->formal_ns == nullptr)
+return false;
+
+ /* Procedures at the root of the file do have a self reference, but they
don't
+ have a reference in a parent namespace preventing the release of the
+ procedure namespace, so they can use the normal reference counting. */
+ if (sym->formal_ns == sym->ns)
+return false;
+
+ /* If sym->refs == 1, we can use normal reference counting. If sym->refs >
2,
+ the symbol won't be freed anyway, with or without cyclic reference. */
+ if (sym->refs != 2)
+return false;
+
+ /* Procedure symbols host-associated from a module in submodules are special,
+ because the namespace of the procedure block in the submodule is different
+ from the FORMAL_NS namespace generated by host-association. So there are
+ two different namespaces representing the same procedure namespace. As
+ FORMAL_NS comes from host-association, which only imports symbols visible
+ from the outside (dummy arguments basically), we can assume there is no
+ self reference through FORMAL_NS in that case. */
+ if (sym->attr.host_assoc && sym->attr.used_in_submodule)
+return false;
+
+ /* We can assume that contained procedures have cyclic references, because
+ the symbol of the procedure itself is accessible in the procedure body
+ namespace. So we assume that symbols with a formal namespace different
+ from the declaration namespace and two references, one of which is about
+ to be removed, are procedures with just the self reference left. At this
+ point, the symbol SYM matches that pattern, so we return true here to
+ permit the release of SYM. */
+ return true;
+}
+
+
/* Decrease the reference counter and free memory when we reach zero.
Returns true if the symbol has been freed, false otherwise. */
@@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
if (sym == NULL)
return false;
- if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
- && (!sym->attr.entry || !sym->module))
+ if (cyclic_reference_break_needed (sym))
{
/* As formal_ns contains a reference to sym, delete formal_ns just
before the deletion of sym. */
diff --git
[gcc(refs/users/mikael/heads/backport14_PR99798_v01)] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]
https://gcc.gnu.org/g:c80a7460239037d8cf8426dbb7d03c6ddac09bab
commit c80a7460239037d8cf8426dbb7d03c6ddac09bab
Author: Mikael Morin
Date: Sun May 12 15:16:23 2024 +0200
fortran: Assume there is no cyclic reference with submodule symbols
[PR99798]
This prevents a premature release of memory with procedure symbols from
submodules, causing random compiler crashes.
The problem is a fragile detection of cyclic references, which can match
with procedures host-associated from a module in submodules, in cases where
it
shouldn't. The formal namespace is released, and with it the dummy
arguments
symbols of the procedure. But there is no cyclic reference, so the
procedure
symbol itself is not released and remains, with pointers to its dummy
arguments
now dangling.
The fix adds a condition to avoid the case, and refactors to a new predicate
by the way. Part of the original condition is also removed, for lack of a
reason to keep it.
PR fortran/99798
gcc/fortran/ChangeLog:
* symbol.cc (gfc_release_symbol): Move the condition guarding
the handling cyclic references...
(cyclic_reference_break_needed): ... here as a new predicate.
Remove superfluous parts. Add a condition preventing any premature
release with submodule symbols.
gcc/testsuite/ChangeLog:
* gfortran.dg/submodule_33.f08: New test.
(cherry picked from commit 38d1761c0c94b77a081ccc180d6e039f7a670468)
Diff:
---
gcc/fortran/symbol.cc | 54 --
gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 +++
2 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1ee..0a1646def678 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
}
+/* Returns true if the symbol SYM has, through its FORMAL_NS field, a reference
+ to itself which should be eliminated for the symbol memory to be released
+ via normal reference counting.
+
+ The implementation is crucial as it controls the proper release of symbols,
+ especially (contained) procedure symbols, which can represent a lot of
memory
+ through the namespace of their body.
+
+ We try to avoid freeing too much memory (causing dangling pointers), to not
+ leak too much (wasting memory), and to avoid expensive walks of the symbol
+ tree (which would be the correct way to check for a cycle). */
+
+bool
+cyclic_reference_break_needed (gfc_symbol *sym)
+{
+ /* Normal symbols don't reference themselves. */
+ if (sym->formal_ns == nullptr)
+return false;
+
+ /* Procedures at the root of the file do have a self reference, but they
don't
+ have a reference in a parent namespace preventing the release of the
+ procedure namespace, so they can use the normal reference counting. */
+ if (sym->formal_ns == sym->ns)
+return false;
+
+ /* If sym->refs == 1, we can use normal reference counting. If sym->refs >
2,
+ the symbol won't be freed anyway, with or without cyclic reference. */
+ if (sym->refs != 2)
+return false;
+
+ /* Procedure symbols host-associated from a module in submodules are special,
+ because the namespace of the procedure block in the submodule is different
+ from the FORMAL_NS namespace generated by host-association. So there are
+ two different namespaces representing the same procedure namespace. As
+ FORMAL_NS comes from host-association, which only imports symbols visible
+ from the outside (dummy arguments basically), we can assume there is no
+ self reference through FORMAL_NS in that case. */
+ if (sym->attr.host_assoc && sym->attr.used_in_submodule)
+return false;
+
+ /* We can assume that contained procedures have cyclic references, because
+ the symbol of the procedure itself is accessible in the procedure body
+ namespace. So we assume that symbols with a formal namespace different
+ from the declaration namespace and two references, one of which is about
+ to be removed, are procedures with just the self reference left. At this
+ point, the symbol SYM matches that pattern, so we return true here to
+ permit the release of SYM. */
+ return true;
+}
+
+
/* Decrease the reference counter and free memory when we reach zero.
Returns true if the symbol has been freed, false otherwise. */
@@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
if (sym == NULL)
return false;
- if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
- && (!sym->attr.entry || !sym->module))
+ if (cyclic_reference_break_needed (sym))
{
/* As formal_ns contains a reference to sym, delete formal_ns just
before the deletion of sym. */
diff --git
[gcc] Created branch 'mikael/heads/backport14_PR99798_v01' in namespace 'refs/users'
The branch 'mikael/heads/backport14_PR99798_v01' was created in namespace 'refs/users' pointing to: c80a74602390... fortran: Assume there is no cyclic reference with submodule
[gcc r14-10419] fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
https://gcc.gnu.org/g:55988c48ead9adb6a11b0dffa60ce49bb542074e
commit r14-10419-g55988c48ead9adb6a11b0dffa60ce49bb542074e
Author: Mikael Morin
Date: Sat Jul 13 20:21:20 2024 +0200
fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.
The generated code was only keeping the generated expression but not the
preliminary code, which was sufficient for simple cases such as data
references or simple (scalar) function calls, but was bogus with more
complicated ones.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_17.f90: New test.
(cherry picked from commit d211100903d4d532d989451243ea00d7fa2e9d5e)
Diff:
---
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/minmaxloc_17.f90 | 33 ++
2 files changed, 34 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9ad372113b0c..5ef4f230472a 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5738,6 +5738,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_init_se (, NULL);
gfc_conv_expr_val (, maskexpr);
+ gfc_add_block_to_block (>pre, );
gfc_init_block ();
gfc_add_block_to_block (, );
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644
index ..7e6e586ab03f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ type bool_wrapper
+logical :: l
+ end type
+ call check_minloc
+ call check_maxloc
+contains
+ subroutine check_minloc
+integer :: a(10)
+integer :: r
+a = data10
+r = minloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 4) stop 11
+ end subroutine
+ subroutine check_maxloc
+integer :: a(10)
+integer :: r
+a = data10
+r = maxloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 5) stop 18
+ end subroutine
+end program
[gcc(refs/users/mikael/heads/add_code_scalar_mask_minmaxloc_v02)] fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
https://gcc.gnu.org/g:08267b90e3267faa744170c32a19a50435a622d4
commit 08267b90e3267faa744170c32a19a50435a622d4
Author: Mikael Morin
Date: Sat Jul 13 20:21:20 2024 +0200
fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.
The generated code was only keeping the generated expression but not the
preliminary code, which was sufficient for simple cases such as data
references or simple (scalar) function calls, but was bogus with more
complicated ones.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_17.f90: New test.
(cherry picked from commit d211100903d4d532d989451243ea00d7fa2e9d5e)
Diff:
---
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/minmaxloc_17.f90 | 33 ++
2 files changed, 34 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9ad372113b0c..5ef4f230472a 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5738,6 +5738,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_init_se (, NULL);
gfc_conv_expr_val (, maskexpr);
+ gfc_add_block_to_block (>pre, );
gfc_init_block ();
gfc_add_block_to_block (, );
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644
index ..7e6e586ab03f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ type bool_wrapper
+logical :: l
+ end type
+ call check_minloc
+ call check_maxloc
+contains
+ subroutine check_minloc
+integer :: a(10)
+integer :: r
+a = data10
+r = minloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 4) stop 11
+ end subroutine
+ subroutine check_maxloc
+integer :: a(10)
+integer :: r
+a = data10
+r = maxloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 5) stop 18
+ end subroutine
+end program
[gcc] Created branch 'mikael/heads/add_code_scalar_mask_minmaxloc_v02' in namespace 'refs/users'
The branch 'mikael/heads/add_code_scalar_mask_minmaxloc_v02' was created in namespace 'refs/users' pointing to: 08267b90e326... fortran: Correctly evaluate scalar MASK arguments of MINLOC
[gcc(refs/users/mikael/heads/add_scalar_mask_code_gcc14_v01)] fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
https://gcc.gnu.org/g:4032ccc4713a5d75c02d00432d4cf1dee88dcd12
commit 4032ccc4713a5d75c02d00432d4cf1dee88dcd12
Author: Mikael Morin
Date: Sat Jul 13 20:21:20 2024 +0200
fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.
The generated code was only keeping the generated expression but not the
preliminary code, which was sufficient for simple cases such as data
references or simple (scalar) function calls, but was bogus with more
complicated ones.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_17.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/minmaxloc_17.f90 | 33 ++
2 files changed, 34 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 9ad372113b0c..5ef4f230472a 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5738,6 +5738,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_init_se (, NULL);
gfc_conv_expr_val (, maskexpr);
+ gfc_add_block_to_block (>pre, );
gfc_init_block ();
gfc_add_block_to_block (, );
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644
index ..7e6e586ab03f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ type bool_wrapper
+logical :: l
+ end type
+ call check_minloc
+ call check_maxloc
+contains
+ subroutine check_minloc
+integer :: a(10)
+integer :: r
+a = data10
+r = minloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 4) stop 11
+ end subroutine
+ subroutine check_maxloc
+integer :: a(10)
+integer :: r
+a = data10
+r = maxloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 5) stop 18
+ end subroutine
+end program
[gcc] Created branch 'mikael/heads/add_scalar_mask_code_gcc14_v01' in namespace 'refs/users'
The branch 'mikael/heads/add_scalar_mask_code_gcc14_v01' was created in namespace 'refs/users' pointing to: 4032ccc4713a... fortran: Correctly evaluate scalar MASK arguments of MINLOC
[gcc r15-2017] fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
https://gcc.gnu.org/g:d211100903d4d532d989451243ea00d7fa2e9d5e
commit r15-2017-gd211100903d4d532d989451243ea00d7fa2e9d5e
Author: Mikael Morin
Date: Sat Jul 13 20:21:20 2024 +0200
fortran: Correctly evaluate scalar MASK arguments of MINLOC/MAXLOC
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.
The generated code was only keeping the generated expression but not the
preliminary code, which was sufficient for simple cases such as data
references or simple (scalar) function calls, but was bogus with more
complicated ones.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_17.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/minmaxloc_17.f90 | 33 ++
2 files changed, 34 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cadbd1774520..180d0d7a88c6 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5749,6 +5749,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_init_se (, NULL);
gfc_conv_expr_val (, maskexpr);
+ gfc_add_block_to_block (>pre, );
gfc_init_block ();
gfc_add_block_to_block (, );
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644
index ..7e6e586ab03f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ type bool_wrapper
+logical :: l
+ end type
+ call check_minloc
+ call check_maxloc
+contains
+ subroutine check_minloc
+integer :: a(10)
+integer :: r
+a = data10
+r = minloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 4) stop 11
+ end subroutine
+ subroutine check_maxloc
+integer :: a(10)
+integer :: r
+a = data10
+r = maxloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 5) stop 18
+ end subroutine
+end program
[gcc(refs/users/mikael/heads/add_scalar_mask_code_v01)] fortran: Correctly evaluate the MASK argument of MINLOC/MAXLOC
https://gcc.gnu.org/g:cee2ecb8a526e96ea0420b4c8c05dd55a091ccc2
commit cee2ecb8a526e96ea0420b4c8c05dd55a091ccc2
Author: Mikael Morin
Date: Fri Jul 12 20:53:52 2024 +0200
fortran: Correctly evaluate the MASK argument of MINLOC/MAXLOC
Add the preliminary code that the generated expression for MASK may depend
on when generating the inline code to evaluate MINLOC or MAXLOC with a
scalar MASK.
The generated code was only keeping the generated expression, which was
sufficient for simple cases such as data references or simple (scalar)
function calls, but was failing with more complicated ones.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Add the
preliminary code generated for MASK to the preliminary code of
MINLOC/MAXLOC.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_17.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 1 +
gcc/testsuite/gfortran.dg/minmaxloc_17.f90 | 33 ++
2 files changed, 34 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index cadbd1774520..180d0d7a88c6 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5749,6 +5749,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_init_se (, NULL);
gfc_conv_expr_val (, maskexpr);
+ gfc_add_block_to_block (>pre, );
gfc_init_block ();
gfc_add_block_to_block (, );
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
new file mode 100644
index ..7e6e586ab03f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/minmaxloc_17.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! Check that the code necessary to evaluate MINLOC's or MAXLOC's MASK
+! argument is correctly generated.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 2, 5, 2, 0, 6, 5, 3, 6, 0, 1 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ type bool_wrapper
+logical :: l
+ end type
+ call check_minloc
+ call check_maxloc
+contains
+ subroutine check_minloc
+integer :: a(10)
+integer :: r
+a = data10
+r = minloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 4) stop 11
+ end subroutine
+ subroutine check_maxloc
+integer :: a(10)
+integer :: r
+a = data10
+r = maxloc(a, dim = 1, mask = sum(a) > 0)
+if (r /= 5) stop 18
+ end subroutine
+end program
[gcc] Created branch 'mikael/heads/add_scalar_mask_code_v01' in namespace 'refs/users'
The branch 'mikael/heads/add_scalar_mask_code_v01' was created in namespace 'refs/users' pointing to: cee2ecb8a526... fortran: Correctly evaluate the MASK argument of MINLOC/MAX
[gcc r15-1994] fortran: Factor the evaluation of MINLOC/MAXLOC's BACK argument
https://gcc.gnu.org/g:a55d24b3cf7f4d07492bb8e6fcee557175b47ea3
commit r15-1994-ga55d24b3cf7f4d07492bb8e6fcee557175b47ea3
Author: Mikael Morin
Date: Thu Jul 11 21:55:58 2024 +0200
fortran: Factor the evaluation of MINLOC/MAXLOC's BACK argument
Move the evaluation of the BACK argument out of the loop in the inline code
generated for MINLOC or MAXLOC. For that, add a new (scalar) element
associated with BACK to the scalarization loop chain, evaluate the argument
with the context of that element, and let the scalarizer do its job.
The problem was not only a missed optimisation, but also a wrong code
one in the cases where the expression associated with BACK is not free of
side-effects, making multiple evaluations observable.
The new tests check the evaluation count of the BACK argument, and try to
cover all the variations (integral or floating-point type, constant or
unknown shape, absent or scalar or array MASK) supported by the inline
implementation of the functions. Care has been taken to not check the case
of a constant .FALSE. MASK, for which the evaluation of BACK can be elided.
gcc/fortran/ChangeLog:
* trans-intrinsic.cc (gfc_conv_intrinsic_minmaxloc): Create a new
scalar scalarization chain element if BACK is present. Add it to
the loop. Set the scalarization chain before evaluating the
argument.
gcc/testsuite/ChangeLog:
* gfortran.dg/maxloc_5.f90: New test.
* gfortran.dg/minloc_5.f90: New test.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 10 ++
gcc/testsuite/gfortran.dg/maxloc_5.f90 | 257 +
gcc/testsuite/gfortran.dg/minloc_5.f90 | 257 +
3 files changed, 524 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 5ea10e840609..cadbd1774520 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5325,6 +5325,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
+ gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5390,6 +5391,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
+ if (backexpr)
+backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+ else
+backss = nullptr;
+
nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
{
@@ -5449,6 +5455,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
if (maskss)
gfc_add_ss_to_loop (, maskss);
+ if (backss)
+gfc_add_ss_to_loop (, backss);
+
gfc_add_ss_to_loop (, arrayss);
/* Initialize the loop. */
@@ -5535,6 +5544,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_add_block_to_block (, );
gfc_init_se (, NULL);
+ backse.ss = backss;
gfc_conv_expr_val (, backexpr);
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/maxloc_5.f90
b/gcc/testsuite/gfortran.dg/maxloc_5.f90
new file mode 100644
index ..5d722450c8fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_5.f90
@@ -0,0 +1,257 @@
+! { dg-do run }
+!
+! Check that the evaluation of MAXLOC's BACK argument is made only once
+! before the scalarisation loops.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 7, 4, 7, 6, 6, 4, 6, 3, 9, 8 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ integer :: calls_count = 0
+ call check_int_const_shape
+ call check_int_const_shape_scalar_mask
+ call check_int_const_shape_array_mask
+ call check_int_const_shape_optional_mask_present
+ call check_int_const_shape_optional_mask_absent
+ call check_int_const_shape_empty
+ call check_int_alloc
+ call check_int_alloc_scalar_mask
+ call check_int_alloc_array_mask
+ call check_int_alloc_empty
+ call check_real_const_shape
+ call check_real_const_shape_scalar_mask
+ call check_real_const_shape_array_mask
+ call check_real_const_shape_optional_mask_present
+ call check_real_const_shape_optional_mask_absent
+ call check_real_const_shape_empty
+ call check_real_alloc
+ call check_real_alloc_scalar_mask
+ call check_real_alloc_array_mask
+ call check_real_alloc_empty
+contains
+ function get_scalar_false()
+logical :: get_scalar_false
+calls_count = calls_count + 1
+get_scalar_false = .false.
+ end function
+ subroutine check_int_const_shape()
+integer :: a(10)
+logical :: m(10)
+
[gcc] Created branch 'mikael/heads/factor_back_minmaxloc_v01' in namespace 'refs/users'
The branch 'mikael/heads/factor_back_minmaxloc_v01' was created in namespace 'refs/users' pointing to: a04c0d344553... Sauvegarde tests
[gcc(refs/users/mikael/heads/factor_back_minmaxloc_v01)] Sauvegarde tests
https://gcc.gnu.org/g:a04c0d344553cc0b405977b3b9eac4ca504a299d
commit a04c0d344553cc0b405977b3b9eac4ca504a299d
Author: Mikael Morin
Date: Mon Jul 8 22:19:43 2024 +0200
Sauvegarde tests
Correction 11 18
Correction tests masque scalaire .false.
Diff:
---
gcc/fortran/trans-intrinsic.cc | 10 ++
gcc/testsuite/gfortran.dg/maxloc_5.f90 | 257 +
gcc/testsuite/gfortran.dg/minloc_5.f90 | 257 +
3 files changed, 524 insertions(+)
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 5ea10e840609..cadbd1774520 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5325,6 +5325,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_actual_arglist *actual;
gfc_ss *arrayss;
gfc_ss *maskss;
+ gfc_ss *backss;
gfc_se arrayse;
gfc_se maskse;
gfc_expr *arrayexpr;
@@ -5390,6 +5391,11 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
&& maskexpr->symtree->n.sym->attr.dummy
&& maskexpr->symtree->n.sym->attr.optional;
backexpr = actual->next->next->expr;
+ if (backexpr)
+backss = gfc_get_scalar_ss (gfc_ss_terminator, backexpr);
+ else
+backss = nullptr;
+
nonempty = NULL;
if (maskexpr && maskexpr->rank != 0)
{
@@ -5449,6 +5455,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
if (maskss)
gfc_add_ss_to_loop (, maskss);
+ if (backss)
+gfc_add_ss_to_loop (, backss);
+
gfc_add_ss_to_loop (, arrayss);
/* Initialize the loop. */
@@ -5535,6 +5544,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_add_block_to_block (, );
gfc_init_se (, NULL);
+ backse.ss = backss;
gfc_conv_expr_val (, backexpr);
gfc_add_block_to_block (, );
diff --git a/gcc/testsuite/gfortran.dg/maxloc_5.f90
b/gcc/testsuite/gfortran.dg/maxloc_5.f90
new file mode 100644
index ..5d722450c8fb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/maxloc_5.f90
@@ -0,0 +1,257 @@
+! { dg-do run }
+!
+! Check that the evaluation of MAXLOC's BACK argument is made only once
+! before the scalarisation loops.
+
+program p
+ implicit none
+ integer, parameter :: data10(*) = (/ 7, 4, 7, 6, 6, 4, 6, 3, 9, 8 /)
+ logical, parameter :: mask10(*) = (/ .false., .true., .false., &
+ .false., .true., .true., &
+ .true. , .true., .false., &
+ .false. /)
+ integer :: calls_count = 0
+ call check_int_const_shape
+ call check_int_const_shape_scalar_mask
+ call check_int_const_shape_array_mask
+ call check_int_const_shape_optional_mask_present
+ call check_int_const_shape_optional_mask_absent
+ call check_int_const_shape_empty
+ call check_int_alloc
+ call check_int_alloc_scalar_mask
+ call check_int_alloc_array_mask
+ call check_int_alloc_empty
+ call check_real_const_shape
+ call check_real_const_shape_scalar_mask
+ call check_real_const_shape_array_mask
+ call check_real_const_shape_optional_mask_present
+ call check_real_const_shape_optional_mask_absent
+ call check_real_const_shape_empty
+ call check_real_alloc
+ call check_real_alloc_scalar_mask
+ call check_real_alloc_array_mask
+ call check_real_alloc_empty
+contains
+ function get_scalar_false()
+logical :: get_scalar_false
+calls_count = calls_count + 1
+get_scalar_false = .false.
+ end function
+ subroutine check_int_const_shape()
+integer :: a(10)
+logical :: m(10)
+integer :: r
+a = data10
+calls_count = 0
+r = maxloc(a, dim = 1, back = get_scalar_false())
+if (calls_count /= 1) stop 11
+ end subroutine
+ subroutine check_int_const_shape_scalar_mask()
+integer :: a(10)
+integer :: r
+a = data10
+calls_count = 0
+! We only check the case of a .true. mask.
+! If the mask is .false., the back argument is not necessary to deduce
+! the value returned by maxloc, so the compiler is free to elide it,
+! and the value of calls_count is undefined in that case.
+r = maxloc(a, dim = 1, mask = .true., back = get_scalar_false())
+if (calls_count /= 1) stop 18
+ end subroutine
+ subroutine check_int_const_shape_array_mask()
+integer :: a(10)
+logical :: m(10)
+integer :: r
+a = data10
+m = mask10
+calls_count = 0
+r = maxloc(a, dim = 1, mask = m, back = get_scalar_false())
+if (calls_count /= 1) stop 32
+ end subroutine
+ subroutine call_maxloc_int(r, a, m, b)
+integer :: a(:)
+logical, optional :: m(:)
+logical, optional :: b
+integer :: r
+r = maxloc(a, dim = 1, mask = m, back = b)
+ end subroutine
+ subroutine check_int_const_shape_optional_mask_present()
+integer :: a(10)
+logical :: m(10)
+integer :: r
+a = data10
+m = mask10
+calls_count = 0
+
[gcc] Deleted branch 'mikael/heads/cleanup_trans_preloop_setup_v01' in namespace 'refs/users'
The branch 'mikael/heads/cleanup_trans_preloop_setup_v01' in namespace 'refs/users' was deleted. It previously pointed to: cfcb4489798c... fortran: Move definition of variable closer to its usages Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- cfcb448... fortran: Move definition of variable closer to its usages
[gcc r15-1893] fortran: Move definition of variable closer to its uses
https://gcc.gnu.org/g:7183a8ca18d5889a1f66ec1edbda00200d700c6c
commit r15-1893-g7183a8ca18d5889a1f66ec1edbda00200d700c6c
Author: Mikael Morin
Date: Mon Jul 8 09:38:42 2024 +0200
fortran: Move definition of variable closer to its uses
No change of behaviour, this makes a variable easier to track.
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_trans_preloop_setup): Use a separate variable
for iteration. Use directly the value of variable I if it is known.
Move the definition of the variable to the branch where the
remaining uses are.
Diff:
---
gcc/fortran/trans-array.cc | 33 +++--
1 file changed, 19 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 510f429ef8ed..c7d244689393 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4294,7 +4294,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
gfc_ss *ss, *pss;
gfc_loopinfo *ploop;
gfc_array_ref *ar;
- int i;
/* This code will be executed before entering the scalarization loop
for this dimension. */
@@ -4340,19 +4339,12 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
pss = ss;
}
- if (dim == loop->dimen - 1)
- i = 0;
- else
- i = dim + 1;
-
- /* For the time being, there is no loop reordering. */
- gcc_assert (i == ploop->order[i]);
- i = ploop->order[i];
-
if (dim == loop->dimen - 1 && loop->parent == NULL)
{
+ gcc_assert (0 == ploop->order[0]);
+
stride = gfc_conv_array_stride (info->descriptor,
- innermost_ss (ss)->dim[i]);
+ innermost_ss (ss)->dim[0]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
@@ -4364,7 +4356,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
base offset of the array. */
if (info->ref)
{
- for (i = 0; i < ar->dimen; i++)
+ for (int i = 0; i < ar->dimen; i++)
{
if (ar->dimen_type[i] != DIMEN_ELEMENT)
continue;
@@ -4374,8 +4366,21 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
}
}
else
- /* Add the offset for the previous loop dimension. */
- add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
+ {
+ int i;
+
+ if (dim == loop->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
+
+ /* For the time being, there is no loop reordering. */
+ gcc_assert (i == ploop->order[i]);
+ i = ploop->order[i];
+
+ /* Add the offset for the previous loop dimension. */
+ add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
+ }
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1 && loop->parent == NULL)
[gcc(refs/users/mikael/heads/cleanup_trans_preloop_setup_v01)] fortran: Move definition of variable closer to its usages
https://gcc.gnu.org/g:cfcb4489798cfb9715e8cf92bb8eadcfe35dfd21
commit cfcb4489798cfb9715e8cf92bb8eadcfe35dfd21
Author: Mikael Morin
Date: Mon Nov 20 10:16:31 2023 +0100
fortran: Move definition of variable closer to its usages
No change of behaviour, this makes a variable easier to track.
gcc/fortran/ChangeLog:
* trans-array.cc (gfc_trans_preloop_setup): Use a separate variable
for iteration. Use directly the value of variable I if it is known.
Move the definition of the variable to the branch where the
remaining uses are.
Diff:
---
gcc/fortran/trans-array.cc | 31 +--
1 file changed, 17 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 510f429ef8e..c34c97257a9 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4294,7 +4294,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
gfc_ss *ss, *pss;
gfc_loopinfo *ploop;
gfc_array_ref *ar;
- int i;
/* This code will be executed before entering the scalarization loop
for this dimension. */
@@ -4340,19 +4339,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
pss = ss;
}
- if (dim == loop->dimen - 1)
- i = 0;
- else
- i = dim + 1;
-
- /* For the time being, there is no loop reordering. */
- gcc_assert (i == ploop->order[i]);
- i = ploop->order[i];
-
if (dim == loop->dimen - 1 && loop->parent == NULL)
{
stride = gfc_conv_array_stride (info->descriptor,
- innermost_ss (ss)->dim[i]);
+ innermost_ss (ss)->dim[0]);
/* Calculate the stride of the innermost loop. Hopefully this will
allow the backend optimizers to do their stuff more effectively.
@@ -4364,7 +4354,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
base offset of the array. */
if (info->ref)
{
- for (i = 0; i < ar->dimen; i++)
+ for (int i = 0; i < ar->dimen; i++)
{
if (ar->dimen_type[i] != DIMEN_ELEMENT)
continue;
@@ -4374,8 +4364,21 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim,
int flag,
}
}
else
- /* Add the offset for the previous loop dimension. */
- add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
+ {
+ int i;
+
+ if (dim == loop->dimen - 1)
+ i = 0;
+ else
+ i = dim + 1;
+
+ /* For the time being, there is no loop reordering. */
+ gcc_assert (i == ploop->order[i]);
+ i = ploop->order[i];
+
+ /* Add the offset for the previous loop dimension. */
+ add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i);
+ }
/* Remember this offset for the second loop. */
if (dim == loop->temp_dim - 1 && loop->parent == NULL)
[gcc] Created branch 'mikael/heads/cleanup_trans_preloop_setup_v01' in namespace 'refs/users'
The branch 'mikael/heads/cleanup_trans_preloop_setup_v01' was created in namespace 'refs/users' pointing to: cfcb4489798... fortran: Move definition of variable closer to its usages
[gcc(refs/users/mikael/heads/cleanup_advance_se_ss_chain_v01)] fortran: Remove useless nested end of scalarization chain handling
https://gcc.gnu.org/g:c633926356155181081154c094010d672e715a4e
commit c633926356155181081154c094010d672e715a4e
Author: Mikael Morin
Date: Mon Nov 20 16:15:45 2023 +0100
fortran: Remove useless nested end of scalarization chain handling
Remove the special handling of end of nested scalarization chains, which
advanced the chain to an element of a parent chain when the current one
was reaching its end.
That handling was superfluous as nested chains correspond to nested
scalarizations of subexpressions and the scalarizations don't extend beyond
their associated subexpression and don't use any scalarisation element from
the parent expression.
No change in behaviour, as the GFC_SE struct is supposed to be at its final
state anyway when the last element from the chain has been consumed.
gcc/fortran/ChangeLog:
* trans-expr.cc (gfc_advance_se_ss_chain): Don't use an element
from the parent scalarization chain when the current chain reaches
its end.
Diff:
---
gcc/fortran/trans-expr.cc | 11 +--
1 file changed, 1 insertion(+), 10 deletions(-)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 477c2720187..f0862db5f17 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2052,7 +2052,6 @@ void
gfc_advance_se_ss_chain (gfc_se * se)
{
gfc_se *p;
- gfc_ss *ss;
gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
@@ -2064,15 +2063,7 @@ gfc_advance_se_ss_chain (gfc_se * se)
gcc_assert (p->parent == NULL || p->parent->ss == p->ss
|| p->parent->ss->nested_ss == p->ss);
- /* If we were in a nested loop, the next scalarized expression can be
-on the parent ss' next pointer. Thus we should not take the next
-pointer blindly, but rather go up one nest level as long as next
-is the end of chain. */
- ss = p->ss;
- while (ss->next == gfc_ss_terminator && ss->parent != NULL)
- ss = ss->parent;
-
- p->ss = ss->next;
+ p->ss = p->ss->next;
p = p->parent;
}
[gcc] Created branch 'mikael/heads/cleanup_advance_se_ss_chain_v01' in namespace 'refs/users'
The branch 'mikael/heads/cleanup_advance_se_ss_chain_v01' was created in namespace 'refs/users' pointing to: c6339263561... fortran: Remove useless nested end of scalarization chain h
[gcc(refs/users/mikael/heads/non_lvalue_match.pd_v01)] match: Unwrap non-lvalue as unary or binary operand
https://gcc.gnu.org/g:b3cc0b4da1b94e3b3c2895011ab8d19d1268c34b
commit b3cc0b4da1b94e3b3c2895011ab8d19d1268c34b
Author: Mikael Morin
Date: Thu Jul 4 15:24:36 2024 +0200
match: Unwrap non-lvalue as unary or binary operand
gcc/ChangeLog:
* match.pd: Unwrap NON_LVALUE_EXPR trees when they are used as
operand of a unary or binary operator.
gcc/testsuite/ChangeLog:
* gfortran.dg/non_lvalue_2.f90: New test.
Diff:
---
gcc/match.pd | 12
gcc/testsuite/gfortran.dg/non_lvalue_2.f90 | 44 ++
2 files changed, 56 insertions(+)
diff --git a/gcc/match.pd b/gcc/match.pd
index d0859545ada..513df562fd7 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -280,6 +280,18 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
(outer_op @0 @2)
@3))
+/* Remove superfluous NON_LVALUE_EXPR in unary operators. */
+(for op (UNCOND_UNARY)
+ (simplify (op (non_lvalue @0))
+ (op @0)))
+
+/* Remove superfluous NON_LVALUE_EXPR in binary operators. */
+(for op (UNCOND_BINARY tcc_comparison)
+ (simplify (op (non_lvalue @0) @1)
+ (op @0 @1))
+ (simplify (op @0 (non_lvalue @1))
+ (op @0 @1)))
+
/* Simplify x - x.
This is unsafe for certain floats even in non-IEEE formats.
In IEEE, it is unsafe because it does wrong for NaNs.
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
new file mode 100644
index 000..8c3197eab1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_2.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the removal of NON_LVALUE_EXPR if they are used in a non-lvalue context
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a bigger
expression
+function f1 (f1_arg1, f1_arg2)
+ integer, value :: f1_arg1, f1_arg2
+ integer :: f1
+ f1 = (f1_arg1 + 0) + f1_arg2
+end function
+! { dg-final { scan-tree-dump "__result_f1 = f1_arg1 \\+ f1_arg2;" "original"
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a bigger
expression
+function f2 (f2_arg1, f2_arg2)
+ integer, value :: f2_arg1, f2_arg2
+ integer :: f2
+ f2 = f2_arg1 + (f2_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f2 = f2_arg1 \\+ f2_arg2;" "original"
} }
+
+! The NON_LVALUE_EXPR is dropped if it's part (left operand) of a binary
logical operator
+function f3 (f3_arg1)
+ integer, value :: f3_arg1
+ logical :: f3
+ f3 = (f3_arg1 + 0) > 0
+end function
+! { dg-final { scan-tree-dump "__result_f3 = f3_arg1 > 0;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part (right operand) of a binary
logical operator
+function f4 (f4_arg1, f4_arg2)
+ integer, value :: f4_arg1, f4_arg2
+ logical :: f4
+ f4 = f4_arg1 > (f4_arg2 + 0)
+end function
+! { dg-final { scan-tree-dump "__result_f4 = f4_arg1 > f4_arg2;" "original" } }
+
+! The NON_LVALUE_EXPR is dropped if it's part of a unary operator
+function f5 (f5_arg1)
+ integer, value :: f5_arg1
+ integer :: f5
+ f5 = -(not(not(f5_arg1)))
+end function
+! { dg-final { scan-tree-dump "__result_f5 = -f5_arg1;" "original" } }
[gcc(refs/users/mikael/heads/non_lvalue_match.pd_v01)] match: Simplify double not and double negate to a non_lvalue
https://gcc.gnu.org/g:540cb6b0dd2a9ece734e927d520a9ca15e8afff8
commit 540cb6b0dd2a9ece734e927d520a9ca15e8afff8
Author: Mikael Morin
Date: Thu Jul 4 12:59:34 2024 +0200
match: Simplify double not and double negate to a non_lvalue
gcc/ChangeLog:
* match.pd: Add a NON_LVALUE_EXPR wrapper around the simplification
of doubled unary operators NEGATE_EXPR and BIT_NOT_EXPR.
gcc/testsuite/ChangeLog:
* gfortran.dg/non_lvalue_1.f90: New test.
Diff:
---
gcc/match.pd | 4 ++--
gcc/testsuite/gfortran.dg/non_lvalue_1.f90 | 21 +
2 files changed, 23 insertions(+), 2 deletions(-)
diff --git a/gcc/match.pd b/gcc/match.pd
index 4edfa2ae2c9..d0859545ada 100644
--- a/gcc/match.pd
+++ b/gcc/match.pd
@@ -2294,7 +2294,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
/* ~~x -> x */
(simplify
(bit_not (bit_not @0))
- @0)
+ (non_lvalue @0))
/* zero_one_valued_p will match when a value is known to be either
0 or 1 including constants 0 or 1.
@@ -3674,7 +3674,7 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT)
(negate (nop_convert? (negate @1)))
(if (!TYPE_OVERFLOW_SANITIZED (type)
&& !TYPE_OVERFLOW_SANITIZED (TREE_TYPE (@1)))
- (view_convert @1)))
+ (non_lvalue (view_convert @1
/* We can't reassociate floating-point unless -fassociative-math
or fixed-point plus or minus because of saturation to +-Inf. */
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
new file mode 100644
index 000..ac52b272094
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the generation of NON_LVALUE_EXPR trees in cases where a unary
operator expression
+! simplifies to a data reference.
+
+! A NON_LVALUE_EXPR is generated for a double negation that simplifies to a
data reference. */
+function f1 (f1_arg1)
+ integer, value :: f1_arg1
+ integer :: f1
+ f1 = -(-f1_arg1)
+end function
+! { dg-final { scan-tree-dump "__result_f1 = NON_LVALUE_EXPR ;"
"original" } }
+
+! A NON_LVALUE_EXPR is generated for a double complement that simplifies to a
data reference. */
+function f2 (f2_arg1)
+ integer, value :: f2_arg1
+ integer :: f2
+ f2 = not(not(f2_arg1))
+end function
+! { dg-final { scan-tree-dump "__result_f2 = NON_LVALUE_EXPR ;"
"original" } }
[gcc] Created branch 'mikael/heads/non_lvalue_match.pd_v01' in namespace 'refs/users'
The branch 'mikael/heads/non_lvalue_match.pd_v01' was created in namespace 'refs/users' pointing to: b3cc0b4da1b... match: Unwrap non-lvalue as unary or binary operand
[gcc] Deleted branch 'mikael/heads/pr93635-v2_Harald' in namespace 'refs/users'
The branch 'mikael/heads/pr93635-v2_Harald' in namespace 'refs/users' was deleted. It previously pointed to: 1ea6d9d7f54... Fortran: improve attribute conflict checking [PR93635] Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- 1ea6d9d... Fortran: improve attribute conflict checking [PR93635]
[gcc(refs/users/mikael/heads/pr93635-v2_Harald)] Fortran: improve attribute conflict checking [PR93635]
https://gcc.gnu.org/g:1ea6d9d7f541844106e9dbec0b3962cdd8695696
commit 1ea6d9d7f541844106e9dbec0b3962cdd8695696
Author: Harald Anlauf
Date: Thu May 23 21:13:00 2024 +0200
Fortran: improve attribute conflict checking [PR93635]
gcc/fortran/ChangeLog:
PR fortran/93635
* symbol.cc (conflict_std): Helper function for reporting attribute
conflicts depending on the Fortran standard version.
(conf_std): Helper macro for checking standard-dependent conflicts.
(gfc_check_conflict): Use it.
gcc/testsuite/ChangeLog:
PR fortran/93635
* gfortran.dg/c-interop/c1255-2.f90: Adjust pattern.
* gfortran.dg/pr87907.f90: Likewise.
* gfortran.dg/pr93635.f90: New test.
Co-authored-by: Steven G. Kargl
Diff:
---
gcc/fortran/symbol.cc | 63 +++--
gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90 | 4 +-
gcc/testsuite/gfortran.dg/pr87907.f90 | 8 ++--
gcc/testsuite/gfortran.dg/pr93635.f90 | 19
4 files changed, 54 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 0a1646def67..5db3c887127 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -407,18 +407,36 @@ gfc_check_function_type (gfc_namespace *ns)
/ Symbol attribute stuff */
+/* Older standards produced conflicts for some attributes that are allowed
+ in newer standards. Check for the conflict and issue an error depending
+ on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute at %L", a1, a2,
+where);
+}
+ else
+{
+ return gfc_notify_std (standard, "%s attribute conflicts "
+"with %s attribute in %qs at %L",
+a1, a2, name, where);
+}
+}
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
-a1 = a;\
-a2 = b;\
-standard = std;\
-goto conflict_std;\
- }
+#define conf_std(a, b, std) if (attr->a && attr->b \
+ && !conflict_std (std, a, b, name, where)) \
+ return false;
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -451,7 +469,6 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
if (attr->artificial)
return true;
@@ -460,20 +477,10 @@ gfc_check_conflict (symbol_attribute *attr, const char
*name, locus *where)
where = _current_locus;
if (attr->pointer && attr->intent != INTENT_UNKNOWN)
-{
- a1 = pointer;
- a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+conf_std (pointer, intent, GFC_STD_F2003);
- if (attr->in_namelist && (attr->allocatable || attr->pointer))
-{
- a1 = in_namelist;
- a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
-}
+ conf_std (in_namelist, allocatable, GFC_STD_F2003);
+ conf_std (in_namelist, pointer, GFC_STD_F2003);
/* Check for attributes not allowed in a BLOCK DATA. */
if (gfc_current_state () == COMP_BLOCK_DATA)
@@ -922,20 +929,6 @@ conflict:
a1, a2, name, where);
return false;
-
-conflict_std:
- if (name == NULL)
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute at %L", a1, a2,
- where);
-}
- else
-{
- return gfc_notify_std (standard, "%s attribute conflicts "
-"with %s attribute in %qs at %L",
- a1, a2, name, where);
-}
}
#undef conf
diff --git a/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
b/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
index 0e5505a0183..feed2e7645f 100644
--- a/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
+++ b/gcc/testsuite/gfortran.dg/c-interop/c1255-2.f90
@@ -92,12 +92,12 @@ module m2
end function
! function result is a type that is not interoperable
-function g (x) bind (c) ! { dg-error "BIND\\(C\\)" }
[gcc] Created branch 'mikael/heads/pr93635-v2_Harald' in namespace 'refs/users'
The branch 'mikael/heads/pr93635-v2_Harald' was created in namespace 'refs/users' pointing to: 1ea6d9d7f54... Fortran: improve attribute conflict checking [PR93635]
[gcc] Deleted branch 'mikael/heads/pr99798_v32' in namespace 'refs/users'
The branch 'mikael/heads/pr99798_v32' in namespace 'refs/users' was deleted. It previously pointed to: e13178f7fbd... fortran: Assume there is no cyclic reference with submodule Diff: !!! WARNING: THE FOLLOWING COMMITS ARE NO LONGER ACCESSIBLE (LOST): --- e13178f... fortran: Assume there is no cyclic reference with submodule
[gcc r15-698] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]
https://gcc.gnu.org/g:38d1761c0c94b77a081ccc180d6e039f7a670468
commit r15-698-g38d1761c0c94b77a081ccc180d6e039f7a670468
Author: Mikael Morin
Date: Sun May 12 15:16:23 2024 +0200
fortran: Assume there is no cyclic reference with submodule symbols
[PR99798]
This prevents a premature release of memory with procedure symbols from
submodules, causing random compiler crashes.
The problem is a fragile detection of cyclic references, which can match
with procedures host-associated from a module in submodules, in cases where
it
shouldn't. The formal namespace is released, and with it the dummy
arguments
symbols of the procedure. But there is no cyclic reference, so the
procedure
symbol itself is not released and remains, with pointers to its dummy
arguments
now dangling.
The fix adds a condition to avoid the case, and refactors to a new predicate
by the way. Part of the original condition is also removed, for lack of a
reason to keep it.
PR fortran/99798
gcc/fortran/ChangeLog:
* symbol.cc (gfc_release_symbol): Move the condition guarding
the handling cyclic references...
(cyclic_reference_break_needed): ... here as a new predicate.
Remove superfluous parts. Add a condition preventing any premature
release with submodule symbols.
gcc/testsuite/ChangeLog:
* gfortran.dg/submodule_33.f08: New test.
Diff:
---
gcc/fortran/symbol.cc | 54 --
gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 +++
2 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1ee..0a1646def678 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
}
+/* Returns true if the symbol SYM has, through its FORMAL_NS field, a reference
+ to itself which should be eliminated for the symbol memory to be released
+ via normal reference counting.
+
+ The implementation is crucial as it controls the proper release of symbols,
+ especially (contained) procedure symbols, which can represent a lot of
memory
+ through the namespace of their body.
+
+ We try to avoid freeing too much memory (causing dangling pointers), to not
+ leak too much (wasting memory), and to avoid expensive walks of the symbol
+ tree (which would be the correct way to check for a cycle). */
+
+bool
+cyclic_reference_break_needed (gfc_symbol *sym)
+{
+ /* Normal symbols don't reference themselves. */
+ if (sym->formal_ns == nullptr)
+return false;
+
+ /* Procedures at the root of the file do have a self reference, but they
don't
+ have a reference in a parent namespace preventing the release of the
+ procedure namespace, so they can use the normal reference counting. */
+ if (sym->formal_ns == sym->ns)
+return false;
+
+ /* If sym->refs == 1, we can use normal reference counting. If sym->refs >
2,
+ the symbol won't be freed anyway, with or without cyclic reference. */
+ if (sym->refs != 2)
+return false;
+
+ /* Procedure symbols host-associated from a module in submodules are special,
+ because the namespace of the procedure block in the submodule is different
+ from the FORMAL_NS namespace generated by host-association. So there are
+ two different namespaces representing the same procedure namespace. As
+ FORMAL_NS comes from host-association, which only imports symbols visible
+ from the outside (dummy arguments basically), we can assume there is no
+ self reference through FORMAL_NS in that case. */
+ if (sym->attr.host_assoc && sym->attr.used_in_submodule)
+return false;
+
+ /* We can assume that contained procedures have cyclic references, because
+ the symbol of the procedure itself is accessible in the procedure body
+ namespace. So we assume that symbols with a formal namespace different
+ from the declaration namespace and two references, one of which is about
+ to be removed, are procedures with just the self reference left. At this
+ point, the symbol SYM matches that pattern, so we return true here to
+ permit the release of SYM. */
+ return true;
+}
+
+
/* Decrease the reference counter and free memory when we reach zero.
Returns true if the symbol has been freed, false otherwise. */
@@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
if (sym == NULL)
return false;
- if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
- && (!sym->attr.entry || !sym->module))
+ if (cyclic_reference_break_needed (sym))
{
/* As formal_ns contains a reference to sym, delete formal_ns just
before the deletion of sym. */
diff --git a/gcc/testsuite/gfortran.dg/submodule_33.f08
b/gcc/testsuite/gfortran.dg/submodule_33.f08
new file
[gcc(refs/users/mikael/heads/pr99798_v32)] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]
https://gcc.gnu.org/g:e13178f7fbd977b71602d39c401adc671fd30d16
commit e13178f7fbd977b71602d39c401adc671fd30d16
Author: Mikael Morin
Date: Fri May 10 11:14:48 2024 +0200
fortran: Assume there is no cyclic reference with submodule symbols
[PR99798]
This prevents a premature release of memory with procedure symbols from
submodules, causing random compiler crashes.
The problem is a fragile detection of cyclic references, which can match
with procedures host-associated from a module in submodules, in cases where
it
shouldn't. The formal namespace is released, and with it the dummy
arguments
symbols of the procedure. But there is no cyclic reference, so the
procedure
symbol itself is not released and remains, with pointers to its dummy
arguments
now dangling.
The fix adds a condition to avoid the case, and refactors to a new predicate
by the way. Part of the original condition is also removed, for lack of a
reason to keep it.
PR fortran/99798
gcc/fortran/ChangeLog:
* symbol.cc (gfc_release_symbol): Move the condition guarding
the cyclic references handling...
(cyclic_reference_break_needed): ... here as a new predicate. Add
a condition preventing any premature release with submodule symbols.
gcc/testsuite/ChangeLog:
* gfortran.dg/submodule_33.f08: New test.
Diff:
---
gcc/fortran/symbol.cc | 54 --
gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 +++
2 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1ee..0a1646def678 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
}
+/* Returns true if the symbol SYM has, through its FORMAL_NS field, a reference
+ to itself which should be eliminated for the symbol memory to be released
+ via normal reference counting.
+
+ The implementation is crucial as it controls the proper release of symbols,
+ especially (contained) procedure symbols, which can represent a lot of
memory
+ through the namespace of their body.
+
+ We try to avoid freeing too much memory (causing dangling pointers), to not
+ leak too much (wasting memory), and to avoid expensive walks of the symbol
+ tree (which would be the correct way to check for a cycle). */
+
+bool
+cyclic_reference_break_needed (gfc_symbol *sym)
+{
+ /* Normal symbols don't reference themselves. */
+ if (sym->formal_ns == nullptr)
+return false;
+
+ /* Procedures at the root of the file do have a self reference, but they
don't
+ have a reference in a parent namespace preventing the release of the
+ procedure namespace, so they can use the normal reference counting. */
+ if (sym->formal_ns == sym->ns)
+return false;
+
+ /* If sym->refs == 1, we can use normal reference counting. If sym->refs >
2,
+ the symbol won't be freed anyway, with or without cyclic reference. */
+ if (sym->refs != 2)
+return false;
+
+ /* Procedure symbols host-associated from a module in submodules are special,
+ because the namespace of the procedure block in the submodule is different
+ from the FORMAL_NS namespace generated by host-association. So there are
+ two different namespaces representing the same procedure namespace. As
+ FORMAL_NS comes from host-association, which only imports symbols visible
+ from the outside (dummy arguments basically), we can assume there is no
+ self reference through FORMAL_NS in that case. */
+ if (sym->attr.host_assoc && sym->attr.used_in_submodule)
+return false;
+
+ /* We can assume that contained procedures have cyclic references, because
+ the symbol of the procedure itself is accessible in the procedure body
+ namespace. So we assume that symbols with a formal namespace different
+ from the declaration namespace and two references, one of which is about
+ to be removed, are procedures with just the self reference left. At this
+ point, the symbol SYM matches that pattern, so we return true here to
+ permit the release of SYM. */
+ return true;
+}
+
+
/* Decrease the reference counter and free memory when we reach zero.
Returns true if the symbol has been freed, false otherwise. */
@@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
if (sym == NULL)
return false;
- if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
- && (!sym->attr.entry || !sym->module))
+ if (cyclic_reference_break_needed (sym))
{
/* As formal_ns contains a reference to sym, delete formal_ns just
before the deletion of sym. */
diff --git a/gcc/testsuite/gfortran.dg/submodule_33.f08
b/gcc/testsuite/gfortran.dg/submodule_33.f08
new file mode 100644
index ..b61d750def16
---
[gcc] Created branch 'mikael/heads/pr99798_v32' in namespace 'refs/users'
The branch 'mikael/heads/pr99798_v32' was created in namespace 'refs/users' pointing to: e13178f7fbd9... fortran: Assume there is no cyclic reference with submodule
[gcc(refs/users/mikael/heads/pr99798_v66)] fortran: Fix leaked symbol
https://gcc.gnu.org/g:4b2e3dff5615a16532f42459fc5d0400c6d61f05 commit 4b2e3dff5615a16532f42459fc5d0400c6d61f05 Author: Mikael Morin Date: Fri May 10 11:17:41 2024 +0200 fortran: Fix leaked symbol For a symbol we create, this adds a reference to a it in a namespace, so that its memory is not leaked. A hidden name is used to avoid polluting the namespace. gcc/fortran/ChangeLog: * decl.cc (get_proc_name): Reference the interface symbol in the namespace under a hidden name. Diff: --- gcc/fortran/decl.cc | 4 1 file changed, 4 insertions(+) diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index b8308aeee550..ce0fb6bae594 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1335,6 +1335,10 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) /* Create a partially populated interface symbol to carry the characteristics of the procedure and the result. */ sym->tlink = gfc_new_symbol (name, sym->ns); + gfc_symtree *s = gfc_get_unique_symtree (sym->ns); + s->n.sym = sym->tlink; + s->n.sym->refs++; + gfc_add_type (sym->tlink, &(sym->ts), _current_locus); gfc_copy_attr (>tlink->attr, >attr, NULL); if (sym->attr.dimension)
[gcc(refs/users/mikael/heads/pr99798_v66)] fortran: Assume there is no cyclic reference with submodule symbols [PR99798]
https://gcc.gnu.org/g:934742d5d2706d3dc3df1dad7cd7ad1cfd6d6370
commit 934742d5d2706d3dc3df1dad7cd7ad1cfd6d6370
Author: Mikael Morin
Date: Fri May 10 11:14:48 2024 +0200
fortran: Assume there is no cyclic reference with submodule symbols
[PR99798]
This prevents a premature release of memory with procedure symbols from
submodules, causing random compiler crashes.
The problem is a fragile detection of cyclic references, which can match
with procedures host-associated from a module in submodules, in cases where
it
shouldn't. The formal namespace is released, and with it the dummy
arguments
symbols of the procedure. But there is no cyclic reference, so the
procedure
symbol itself is not released and remains, with pointers to its dummy
arguments
now dangling.
The fix adds a condition to avoid the case, and refactors to a new
predicate by
the way.
PR fortran/99798
gcc/fortran/ChangeLog:
* symbol.cc (gfc_release_symbol): Move the condition guarding
the cyclic references handling...
(cyclic_reference_break_needed): ... here as a new predicate. Add
a condition preventing any premature release with submodule symbols.
gcc/testsuite/ChangeLog:
* gfortran.dg/submodule_33.f08: New test.
Diff:
---
gcc/fortran/symbol.cc | 54 --
gcc/testsuite/gfortran.dg/submodule_33.f08 | 20 +++
2 files changed, 72 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 8f7deac1d1ee..0a1646def678 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,57 @@ gfc_free_symbol (gfc_symbol *)
}
+/* Returns true if the symbol SYM has, through its FORMAL_NS field, a reference
+ to itself which should be eliminated for the symbol memory to be released
+ via normal reference counting.
+
+ The implementation is crucial as it controls the proper release of symbols,
+ especially (contained) procedure symbols, which can represent a lot of
memory
+ through the namespace of their body.
+
+ We try to avoid freeing too much memory (causing dangling pointers), to not
+ leak too much (wasting memory), and to avoid expensive walks of the symbol
+ tree (which would be the correct way to check for a cycle). */
+
+bool
+cyclic_reference_break_needed (gfc_symbol *sym)
+{
+ /* Normal symbols don't reference themselves. */
+ if (sym->formal_ns == nullptr)
+return false;
+
+ /* Procedures at the root of the file do have a self reference, but they
don't
+ have a reference in a parent namespace preventing the release of the
+ procedure namespace, so they can use the normal reference counting. */
+ if (sym->formal_ns == sym->ns)
+return false;
+
+ /* If sym->refs == 1, we can use normal reference counting. If sym->refs >
2,
+ the symbol won't be freed anyway, with or without cyclic reference. */
+ if (sym->refs != 2)
+return false;
+
+ /* Procedure symbols host-associated from a module in submodules are special,
+ because the namespace of the procedure block in the submodule is different
+ from the FORMAL_NS namespace generated by host-association. So there are
+ two different namespaces representing the same procedure namespace. As
+ FORMAL_NS comes from host-association, which only imports symbols visible
+ from the outside (dummy arguments basically), we can assume there is no
+ self reference through FORMAL_NS in that case. */
+ if (sym->attr.host_assoc && sym->attr.used_in_submodule)
+return false;
+
+ /* We can assume that contained procedures have cyclic references, because
+ the symbol of the procedure itself is accessible in the procedure body
+ namespace. So we assume that symbols with a formal namespace different
+ from the declaration namespace and two references, one of which is about
+ to be removed, are procedures with just the self reference left. At this
+ point, the symbol SYM matches that pattern, so we return true here to
+ permit the release of SYM. */
+ return true;
+}
+
+
/* Decrease the reference counter and free memory when we reach zero.
Returns true if the symbol has been freed, false otherwise. */
@@ -3188,8 +3239,7 @@ gfc_release_symbol (gfc_symbol *)
if (sym == NULL)
return false;
- if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
- && (!sym->attr.entry || !sym->module))
+ if (cyclic_reference_break_needed (sym))
{
/* As formal_ns contains a reference to sym, delete formal_ns just
before the deletion of sym. */
diff --git a/gcc/testsuite/gfortran.dg/submodule_33.f08
b/gcc/testsuite/gfortran.dg/submodule_33.f08
new file mode 100644
index ..b61d750def16
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_33.f08
@@ -0,0 +1,20 @@
+! {
[gcc] Created branch 'mikael/heads/pr99798_v66' in namespace 'refs/users'
The branch 'mikael/heads/pr99798_v66' was created in namespace 'refs/users' pointing to: 4b2e3dff5615... fortran: Fix leaked symbol
[gcc r11-11305] fortran: Ignore use statements on error [PR107426]
https://gcc.gnu.org/g:3d05b9ac1c6ad950339f9487702c3165c189fe9e
commit r11-11305-g3d05b9ac1c6ad950339f9487702c3165c189fe9e
Author: Mikael Morin
Date: Thu Mar 21 17:27:54 2024 +0100
fortran: Ignore use statements on error [PR107426]
This fixes an access to freed memory on the testcase from the PR.
The problem comes from an invalid subroutine statement in an interface,
which is ignored and causes the following statements forming the procedure
body to be rejected. One of them use-associates the intrinsic ISO_C_BINDING
module, which imports new symbols in a namespace that is freed at the time
the statement is rejected. However, this creates dangling pointers as
ISO_C_BINDING is special and its import creates a reference to the imported
C_PTR symbol in the return type of the global intrinsic symbol for C_LOC
(see the function create_intrinsic_function).
This change saves and restores the list of use statements, so that rejected
use statements are removed before they have a chance to be applied to the
current namespace and create dangling pointers.
PR fortran/107426
gcc/fortran/ChangeLog:
* gfortran.h (gfc_save_module_list, gfc_restore_old_module_list):
New declarations.
* module.c (old_module_list_tail): New global variable.
(gfc_save_module_list, gfc_restore_old_module_list): New functions.
(gfc_use_modules): Set module_list and old_module_list_tail.
* parse.c (next_statement): Save module_list before doing any work.
(reject_statement): Restore module_list to its saved value.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr89943_3.f90: Update error pattern.
* gfortran.dg/pr89943_4.f90: Likewise.
* gfortran.dg/use_31.f90: New test.
(cherry picked from commit a44d7e8a52007c2d45217709ca02947c6600de87)
Diff:
---
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.c| 31 +++
gcc/fortran/parse.c | 4
gcc/testsuite/gfortran.dg/pr89943_3.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr89943_4.f90 | 2 +-
gcc/testsuite/gfortran.dg/use_31.f90| 26 ++
6 files changed, 65 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0436c4f308f..e5a0bc2be60 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3578,6 +3578,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+void gfc_save_module_list ();
+void gfc_restore_old_module_list ();
const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 089453caa03..42bd585434f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -195,7 +195,12 @@ static const char *module_name;
/* The name of the .smod file that the submodule will write to. */
static const char *submodule_name;
+/* The list of use statements to apply to the current namespace
+ before parsing the non-use statements. */
static gfc_use_list *module_list;
+/* The end of the MODULE_LIST list above at the time the recognition
+ of the current statement started. */
+static gfc_use_list **old_module_list_tail;
/* If we're reading an intrinsic module, this is its ID. */
static intmod_id current_intmod;
@@ -7476,6 +7481,8 @@ gfc_use_modules (void)
gfc_use_module (module_list);
free (module_list);
}
+ module_list = NULL;
+ old_module_list_tail = _list;
gfc_rename_list = NULL;
}
@@ -7499,6 +7506,30 @@ gfc_free_use_stmts (gfc_use_list *use_stmts)
}
+/* Remember the end of the MODULE_LIST list, so that the list can be restored
+ to its previous state if the current statement is erroneous. */
+
+void
+gfc_save_module_list ()
+{
+ gfc_use_list **tail = _list;
+ while (*tail != NULL)
+tail = &(*tail)->next;
+ old_module_list_tail = tail;
+}
+
+
+/* Restore the MODULE_LIST list to its previous value and free the use
+ statements that are no longer part of the list. */
+
+void
+gfc_restore_old_module_list ()
+{
+ gfc_free_use_stmts (*old_module_list_tail);
+ *old_module_list_tail = NULL;
+}
+
+
void
gfc_module_init_2 (void)
{
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6893557733b..65fd0827c01 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1519,6 +1519,7 @@ next_statement (void)
locus old_locus;
gfc_enforce_clean_symbol_state ();
+ gfc_save_module_list ();
gfc_new_block = NULL;
@@ -2674,6 +2675,9 @@ reject_statement (void)
gfc_reject_data (gfc_current_ns);
+ /* Don't queue use-association of a module if we reject the use statement.
*/
+ gfc_restore_old_module_list ();
+
[gcc r12-10305] fortran: Ignore use statements on error [PR107426]
https://gcc.gnu.org/g:38dd703d368c9e60159e6f19cfc8303ad639b557
commit r12-10305-g38dd703d368c9e60159e6f19cfc8303ad639b557
Author: Mikael Morin
Date: Thu Mar 21 17:27:54 2024 +0100
fortran: Ignore use statements on error [PR107426]
This fixes an access to freed memory on the testcase from the PR.
The problem comes from an invalid subroutine statement in an interface,
which is ignored and causes the following statements forming the procedure
body to be rejected. One of them use-associates the intrinsic ISO_C_BINDING
module, which imports new symbols in a namespace that is freed at the time
the statement is rejected. However, this creates dangling pointers as
ISO_C_BINDING is special and its import creates a reference to the imported
C_PTR symbol in the return type of the global intrinsic symbol for C_LOC
(see the function create_intrinsic_function).
This change saves and restores the list of use statements, so that rejected
use statements are removed before they have a chance to be applied to the
current namespace and create dangling pointers.
PR fortran/107426
gcc/fortran/ChangeLog:
* gfortran.h (gfc_save_module_list, gfc_restore_old_module_list):
New declarations.
* module.cc (old_module_list_tail): New global variable.
(gfc_save_module_list, gfc_restore_old_module_list): New functions.
(gfc_use_modules): Set module_list and old_module_list_tail.
* parse.cc (next_statement): Save module_list before doing any work.
(reject_statement): Restore module_list to its saved value.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr89943_3.f90: Update error pattern.
* gfortran.dg/pr89943_4.f90: Likewise.
* gfortran.dg/use_31.f90: New test.
(cherry picked from commit a44d7e8a52007c2d45217709ca02947c6600de87)
Diff:
---
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.cc | 31 +++
gcc/fortran/parse.cc| 4
gcc/testsuite/gfortran.dg/pr89943_3.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr89943_4.f90 | 2 +-
gcc/testsuite/gfortran.dg/use_31.f90| 26 ++
6 files changed, 65 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7bf1d5a0452..98c0cd39503 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3800,6 +3800,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+void gfc_save_module_list ();
+void gfc_restore_old_module_list ();
const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 85aa153bd77..7b06acb3133 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -195,7 +195,12 @@ static const char *module_name;
/* The name of the .smod file that the submodule will write to. */
static const char *submodule_name;
+/* The list of use statements to apply to the current namespace
+ before parsing the non-use statements. */
static gfc_use_list *module_list;
+/* The end of the MODULE_LIST list above at the time the recognition
+ of the current statement started. */
+static gfc_use_list **old_module_list_tail;
/* If we're reading an intrinsic module, this is its ID. */
static intmod_id current_intmod;
@@ -7542,6 +7547,8 @@ gfc_use_modules (void)
gfc_use_module (module_list);
free (module_list);
}
+ module_list = NULL;
+ old_module_list_tail = _list;
gfc_rename_list = NULL;
}
@@ -7565,6 +7572,30 @@ gfc_free_use_stmts (gfc_use_list *use_stmts)
}
+/* Remember the end of the MODULE_LIST list, so that the list can be restored
+ to its previous state if the current statement is erroneous. */
+
+void
+gfc_save_module_list ()
+{
+ gfc_use_list **tail = _list;
+ while (*tail != NULL)
+tail = &(*tail)->next;
+ old_module_list_tail = tail;
+}
+
+
+/* Restore the MODULE_LIST list to its previous value and free the use
+ statements that are no longer part of the list. */
+
+void
+gfc_restore_old_module_list ()
+{
+ gfc_free_use_stmts (*old_module_list_tail);
+ *old_module_list_tail = NULL;
+}
+
+
void
gfc_module_init_2 (void)
{
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 3e9c6514c80..2b3a1a91fd9 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1600,6 +1600,7 @@ next_statement (void)
locus old_locus;
gfc_enforce_clean_symbol_state ();
+ gfc_save_module_list ();
gfc_new_block = NULL;
@@ -2875,6 +2876,9 @@ reject_statement (void)
gfc_reject_data (gfc_current_ns);
+ /* Don't queue use-association of a module if we reject the use statement.
*/
+ gfc_restore_old_module_list ();
+
[gcc r13-8543] fortran: Ignore use statements on error [PR107426]
https://gcc.gnu.org/g:fc5c603da3c9b186308fb3afef7bcf3f3bf695e8
commit r13-8543-gfc5c603da3c9b186308fb3afef7bcf3f3bf695e8
Author: Mikael Morin
Date: Thu Mar 21 17:27:54 2024 +0100
fortran: Ignore use statements on error [PR107426]
This fixes an access to freed memory on the testcase from the PR.
The problem comes from an invalid subroutine statement in an interface,
which is ignored and causes the following statements forming the procedure
body to be rejected. One of them use-associates the intrinsic ISO_C_BINDING
module, which imports new symbols in a namespace that is freed at the time
the statement is rejected. However, this creates dangling pointers as
ISO_C_BINDING is special and its import creates a reference to the imported
C_PTR symbol in the return type of the global intrinsic symbol for C_LOC
(see the function create_intrinsic_function).
This change saves and restores the list of use statements, so that rejected
use statements are removed before they have a chance to be applied to the
current namespace and create dangling pointers.
PR fortran/107426
gcc/fortran/ChangeLog:
* gfortran.h (gfc_save_module_list, gfc_restore_old_module_list):
New declarations.
* module.cc (old_module_list_tail): New global variable.
(gfc_save_module_list, gfc_restore_old_module_list): New functions.
(gfc_use_modules): Set module_list and old_module_list_tail.
* parse.cc (next_statement): Save module_list before doing any work.
(reject_statement): Restore module_list to its saved value.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr89943_3.f90: Update error pattern.
* gfortran.dg/pr89943_4.f90: Likewise.
* gfortran.dg/use_31.f90: New test.
(cherry picked from commit a44d7e8a52007c2d45217709ca02947c6600de87)
Diff:
---
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.cc | 31 +++
gcc/fortran/parse.cc| 4
gcc/testsuite/gfortran.dg/pr89943_3.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr89943_4.f90 | 2 +-
gcc/testsuite/gfortran.dg/use_31.f90| 26 ++
6 files changed, 65 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e6939056a7c..47414f73254 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3850,6 +3850,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+void gfc_save_module_list ();
+void gfc_restore_old_module_list ();
const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 601497e0998..21141e9422d 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -195,7 +195,12 @@ static const char *module_name;
/* The name of the .smod file that the submodule will write to. */
static const char *submodule_name;
+/* The list of use statements to apply to the current namespace
+ before parsing the non-use statements. */
static gfc_use_list *module_list;
+/* The end of the MODULE_LIST list above at the time the recognition
+ of the current statement started. */
+static gfc_use_list **old_module_list_tail;
/* If we're reading an intrinsic module, this is its ID. */
static intmod_id current_intmod;
@@ -7542,6 +7547,8 @@ gfc_use_modules (void)
gfc_use_module (module_list);
free (module_list);
}
+ module_list = NULL;
+ old_module_list_tail = _list;
gfc_rename_list = NULL;
}
@@ -7565,6 +7572,30 @@ gfc_free_use_stmts (gfc_use_list *use_stmts)
}
+/* Remember the end of the MODULE_LIST list, so that the list can be restored
+ to its previous state if the current statement is erroneous. */
+
+void
+gfc_save_module_list ()
+{
+ gfc_use_list **tail = _list;
+ while (*tail != NULL)
+tail = &(*tail)->next;
+ old_module_list_tail = tail;
+}
+
+
+/* Restore the MODULE_LIST list to its previous value and free the use
+ statements that are no longer part of the list. */
+
+void
+gfc_restore_old_module_list ()
+{
+ gfc_free_use_stmts (*old_module_list_tail);
+ *old_module_list_tail = NULL;
+}
+
+
void
gfc_module_init_2 (void)
{
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 83bb8a6f58b..0d366894643 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1609,6 +1609,7 @@ next_statement (void)
locus old_locus;
gfc_enforce_clean_symbol_state ();
+ gfc_save_module_list ();
gfc_new_block = NULL;
@@ -2901,6 +2902,9 @@ reject_statement (void)
gfc_reject_data (gfc_current_ns);
+ /* Don't queue use-association of a module if we reject the use statement.
*/
+ gfc_restore_old_module_list ();
+
[gcc r14-9703] fortran: Fix specification expression check in submodules [PR114475]
https://gcc.gnu.org/g:7f233feafd657250340be3b3500d2697948ae3ed
commit r14-9703-g7f233feafd657250340be3b3500d2697948ae3ed
Author: Mikael Morin
Date: Wed Mar 27 16:30:42 2024 +0100
fortran: Fix specification expression check in submodules [PR114475]
The patch fixing PR111781 made the check of specification expressions more
restrictive, disallowing local variables in specification expressions of
dummy arguments. PR114475 showed an example where that change regressed,
disallowing in submodules expressions that had been allowed in the parent
module. In submodules indeed, the hierarchy of namespaces inherited from
the parent module is not reproduced so the host-association of symbols
can't be recognized by checking the nesting of namespaces.
This change fixes the problem by allowing in specification expressions
all the symbols in a submodule that are inherited from the parent module.
PR fortran/111781
PR fortran/114475
gcc/fortran/ChangeLog:
* expr.cc (check_restricted): In submodules, allow variables host-
associated from the parent module.
gcc/testsuite/ChangeLog:
* gfortran.dg/spec_expr_10.f90: New test.
Co-authored-by: Harald Anlauf
Diff:
---
gcc/fortran/expr.cc| 1 +
gcc/testsuite/gfortran.dg/spec_expr_10.f90 | 46 ++
2 files changed, 47 insertions(+)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9a042cd7040..09d1ebd95d2 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3517,6 +3517,7 @@ check_restricted (gfc_expr *e)
if (e->error
|| sym->attr.in_common
|| sym->attr.use_assoc
+ || sym->attr.used_in_submodule
|| sym->attr.dummy
|| sym->attr.implied_index
|| sym->attr.flavor == FL_PARAMETER
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_10.f90
b/gcc/testsuite/gfortran.dg/spec_expr_10.f90
new file mode 100644
index 000..287b5a8d6cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_10.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+!
+! PR fortran/114475
+! The array specification of PP in OL_EVAL used to be rejected in the submodule
+! because the compiler was not able to see the host-association of N_EXTERNAL
+! there.
+!
+! Contributed by Jürgen Reuter .
+
+module t1
+ use, intrinsic :: iso_c_binding
+ implicit none
+ private
+ public :: t1_t
+ integer :: N_EXTERNAL = 0
+
+ type :: t1_t
+ contains
+procedure :: set_n_external => t1_set_n_external
+ end type t1_t
+
+ abstract interface
+ subroutine ol_eval (id, pp, emitter) bind(C)
+ import
+ real(kind = c_double), intent(in) :: pp(5 * N_EXTERNAL)
+ end subroutine ol_eval
+ end interface
+ interface
+module subroutine t1_set_n_external (object, n)
+ class(t1_t), intent(inout) :: object
+ integer, intent(in) :: n
+end subroutine t1_set_n_external
+ end interface
+
+end module t1
+
+submodule (t1) t1_s
+ implicit none
+contains
+ module subroutine t1_set_n_external (object, n)
+class(t1_t), intent(inout) :: object
+integer, intent(in) :: n
+N_EXTERNAL = n
+ end subroutine t1_set_n_external
+
+end submodule t1_s
[gcc r14-9619] fortran: Ignore use statements on error [PR107426]
https://gcc.gnu.org/g:a44d7e8a52007c2d45217709ca02947c6600de87
commit r14-9619-ga44d7e8a52007c2d45217709ca02947c6600de87
Author: Mikael Morin
Date: Thu Mar 21 17:27:54 2024 +0100
fortran: Ignore use statements on error [PR107426]
This fixes an access to freed memory on the testcase from the PR.
The problem comes from an invalid subroutine statement in an interface,
which is ignored and causes the following statements forming the procedure
body to be rejected. One of them use-associates the intrinsic ISO_C_BINDING
module, which imports new symbols in a namespace that is freed at the time
the statement is rejected. However, this creates dangling pointers as
ISO_C_BINDING is special and its import creates a reference to the imported
C_PTR symbol in the return type of the global intrinsic symbol for C_LOC
(see the function create_intrinsic_function).
This change saves and restores the list of use statements, so that rejected
use statements are removed before they have a chance to be applied to the
current namespace and create dangling pointers.
PR fortran/107426
gcc/fortran/ChangeLog:
* gfortran.h (gfc_save_module_list, gfc_restore_old_module_list):
New declarations.
* module.cc (old_module_list_tail): New global variable.
(gfc_save_module_list, gfc_restore_old_module_list): New functions.
(gfc_use_modules): Set module_list and old_module_list_tail.
* parse.cc (next_statement): Save module_list before doing any work.
(reject_statement): Restore module_list to its saved value.
gcc/testsuite/ChangeLog:
* gfortran.dg/pr89943_3.f90: Update error pattern.
* gfortran.dg/pr89943_4.f90: Likewise.
* gfortran.dg/use_31.f90: New test.
Diff:
---
gcc/fortran/gfortran.h | 2 ++
gcc/fortran/module.cc | 31 +++
gcc/fortran/parse.cc| 4
gcc/testsuite/gfortran.dg/pr89943_3.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr89943_4.f90 | 2 +-
gcc/testsuite/gfortran.dg/use_31.f90| 26 ++
6 files changed, 65 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 26aa56b3358..58505446bac 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3928,6 +3928,8 @@ void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_symbol_access (gfc_symbol *);
void gfc_free_use_stmts (gfc_use_list *);
+void gfc_save_module_list ();
+void gfc_restore_old_module_list ();
const char *gfc_dt_lower_string (const char *);
const char *gfc_dt_upper_string (const char *);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index d1de53cbdb4..c565b84d61b 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -195,7 +195,12 @@ static const char *module_name;
/* The name of the .smod file that the submodule will write to. */
static const char *submodule_name;
+/* The list of use statements to apply to the current namespace
+ before parsing the non-use statements. */
static gfc_use_list *module_list;
+/* The end of the MODULE_LIST list above at the time the recognition
+ of the current statement started. */
+static gfc_use_list **old_module_list_tail;
/* If we're reading an intrinsic module, this is its ID. */
static intmod_id current_intmod;
@@ -7561,6 +7566,8 @@ gfc_use_modules (void)
gfc_use_module (module_list);
free (module_list);
}
+ module_list = NULL;
+ old_module_list_tail = _list;
gfc_rename_list = NULL;
}
@@ -7584,6 +7591,30 @@ gfc_free_use_stmts (gfc_use_list *use_stmts)
}
+/* Remember the end of the MODULE_LIST list, so that the list can be restored
+ to its previous state if the current statement is erroneous. */
+
+void
+gfc_save_module_list ()
+{
+ gfc_use_list **tail = _list;
+ while (*tail != NULL)
+tail = &(*tail)->next;
+ old_module_list_tail = tail;
+}
+
+
+/* Restore the MODULE_LIST list to its previous value and free the use
+ statements that are no longer part of the list. */
+
+void
+gfc_restore_old_module_list ()
+{
+ gfc_free_use_stmts (*old_module_list_tail);
+ *old_module_list_tail = NULL;
+}
+
+
void
gfc_module_init_2 (void)
{
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index a2bf328f681..79c810c86ba 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1800,6 +1800,7 @@ next_statement (void)
locus old_locus;
gfc_enforce_clean_symbol_state ();
+ gfc_save_module_list ();
gfc_new_block = NULL;
@@ -3104,6 +3105,9 @@ reject_statement (void)
gfc_reject_data (gfc_current_ns);
+ /* Don't queue use-association of a module if we reject the use statement.
*/
+ gfc_restore_old_module_list ();
+
gfc_new_block = NULL;
gfc_undo_symbols ();
gfc_clear_warning ();
diff
[gcc r14-9618] fortran: Fix specification expression error with dummy procedures [PR111781]
https://gcc.gnu.org/g:44c0398e65347def316700911a51ca8b4ec0a411
commit r14-9618-g44c0398e65347def316700911a51ca8b4ec0a411
Author: Mikael Morin
Date: Fri Mar 22 12:32:34 2024 +0100
fortran: Fix specification expression error with dummy procedures [PR111781]
This fixes a spurious invalid variable in specification expression error.
The error was caused on the testcase from the PR by two different bugs.
First, the call to is_parent_of_current_ns was unable to recognize
correct host association and returned false. Second, an ad-hoc
condition coming next was using a global variable previously improperly
restored to false (instead of restoring it to its initial value). The
latter happened on the testcase because one dummy argument was a procedure,
and checking that argument what causing a check of all its arguments with
the (improper) reset of the flag at the end, and that preceded the check of
the next argument.
For the first bug, the wrong result of is_parent_of_current_ns is fixed by
correcting the namespaces that function deals with, both the one passed
as argument and the current one tracked in the gfc_current_ns global. Two
new functions are introduced to select the right namespace.
Regarding the second bug, the problematic condition is removed, together
with the formal_arg_flag associated with it. Indeed, that condition was
(wrongly) allowing local variables to be used in array bounds of dummy
arguments.
PR fortran/111781
gcc/fortran/ChangeLog:
* symbol.cc (gfc_get_procedure_ns, gfc_get_spec_ns): New functions.
* gfortran.h (gfc_get_procedure_ns, gfc_get_spec ns): Declare them.
(gfc_is_formal_arg): Remove.
* expr.cc (check_restricted): Remove special case allowing local
variable in dummy argument bound expressions. Use gfc_get_spec_ns
to get the right namespace.
* resolve.cc (gfc_is_formal_arg, formal_arg_flag): Remove.
(gfc_resolve_formal_arglist): Set gfc_current_ns. Quit loop and
restore gfc_current_ns instead of early returning.
(resolve_symbol): Factor common array spec resolution code to...
(resolve_symbol_array_spec): ... this new function. Additionnally
set and restore gfc_current_ns.
gcc/testsuite/ChangeLog:
* gfortran.dg/spec_expr_8.f90: New test.
* gfortran.dg/spec_expr_9.f90: New test.
Diff:
---
gcc/fortran/expr.cc | 8 +---
gcc/fortran/gfortran.h| 4 +-
gcc/fortran/resolve.cc| 77 ++-
gcc/fortran/symbol.cc | 58 +++
gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 ++
gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19
6 files changed, 140 insertions(+), 50 deletions(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e4b1e8307e3..9a042cd7040 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3514,19 +3514,13 @@ check_restricted (gfc_expr *e)
if (!check_references (e->ref, _restricted))
break;
- /* gfc_is_formal_arg broadcasts that a formal argument list is being
-processed in resolve.cc(resolve_formal_arglist). This is done so
-that host associated dummy array indices are accepted (PR23446).
-This mechanism also does the same for the specification expressions
-of array-valued functions. */
if (e->error
|| sym->attr.in_common
|| sym->attr.use_assoc
|| sym->attr.dummy
|| sym->attr.implied_index
|| sym->attr.flavor == FL_PARAMETER
- || is_parent_of_current_ns (sym->ns)
- || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
+ || is_parent_of_current_ns (gfc_get_spec_ns (sym)))
{
t = true;
break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c7039730fad..26aa56b3358 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3612,6 +3612,9 @@ bool gfc_is_associate_pointer (gfc_symbol*);
gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
+gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
+gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
+
/* intrinsic.cc -- true if working in an init-expr, false otherwise. */
extern bool gfc_init_expr_flag;
@@ -3821,7 +3824,6 @@ bool gfc_resolve_iterator (gfc_iterator *, bool, bool);
bool find_forall_index (gfc_expr *, gfc_symbol *, int);
bool gfc_resolve_index (gfc_expr *, int);
bool gfc_resolve_dim_arg (gfc_expr *);
-bool gfc_is_formal_arg (void);
bool gfc_resolve_substring (gfc_ref *, bool *);
void gfc_resolve_substring_charlen (gfc_expr *);
gfc_expr *gfc_expr_to_initialize (gfc_expr *);
diff --git
[gcc r14-9617] testsuite: Declare fortran array bound variables
https://gcc.gnu.org/g:ebace32a26424884789ccf585a24ac6a5703a323
commit r14-9617-gebace32a26424884789ccf585a24ac6a5703a323
Author: Mikael Morin
Date: Fri Mar 22 12:32:17 2024 +0100
testsuite: Declare fortran array bound variables
This fixes invalid undeclared fortran array bound variables
in the testsuite.
gcc/testsuite/ChangeLog:
* gfortran.dg/graphite/pr107865.f90: Declare array bound variable(s)
as dummy argument(s).
* gfortran.dg/pr101267.f90: Likewise.
* gfortran.dg/pr112404.f90: Likewise.
* gfortran.dg/pr78061.f: Likewise.
* gfortran.dg/pr79315.f90: Likewise.
* gfortran.dg/vect/pr90681.f: Likewise.
* gfortran.dg/vect/pr97761.f90: Likewise.
* gfortran.dg/vect/pr99746.f90: Likewise.
Diff:
---
gcc/testsuite/gfortran.dg/graphite/pr107865.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr101267.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr112404.f90 | 2 +-
gcc/testsuite/gfortran.dg/pr78061.f | 2 +-
gcc/testsuite/gfortran.dg/pr79315.f90 | 6 +-
gcc/testsuite/gfortran.dg/vect/pr90681.f| 2 +-
gcc/testsuite/gfortran.dg/vect/pr97761.f90 | 2 +-
gcc/testsuite/gfortran.dg/vect/pr99746.f90 | 2 +-
8 files changed, 12 insertions(+), 8 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
index 6bddb17a1be..323d8092ad2 100644
--- a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
+++ b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
@@ -1,7 +1,7 @@
! { dg-do compile }
! { dg-options "-O1 -floop-parallelize-all -ftree-parallelize-loops=2" }
- SUBROUTINE FNC (F)
+ SUBROUTINE FNC (F,N)
IMPLICIT REAL (A-H)
DIMENSION F(N)
diff --git a/gcc/testsuite/gfortran.dg/pr101267.f90
b/gcc/testsuite/gfortran.dg/pr101267.f90
index 12723cf9c22..99a6dcfa342 100644
--- a/gcc/testsuite/gfortran.dg/pr101267.f90
+++ b/gcc/testsuite/gfortran.dg/pr101267.f90
@@ -1,7 +1,7 @@
! { dg-do compile }
! { dg-options "-Ofast" }
! { dg-additional-options "-march=znver2" { target x86_64-*-* i?86-*-* } }
- SUBROUTINE sfddagd( regime, znt,ite ,jte )
+ SUBROUTINE sfddagd( regime, znt,ite ,jte, ime, IN )
REAL, DIMENSION( ime, IN) :: regime, znt
REAL, DIMENSION( ite, jte) :: wndcor_u
LOGICAL wrf_dm_on_monitor
diff --git a/gcc/testsuite/gfortran.dg/pr112404.f90
b/gcc/testsuite/gfortran.dg/pr112404.f90
index 573fa28164a..4508bbc8738 100644
--- a/gcc/testsuite/gfortran.dg/pr112404.f90
+++ b/gcc/testsuite/gfortran.dg/pr112404.f90
@@ -1,7 +1,7 @@
! { dg-do compile }
! { dg-options "-Ofast" }
! { dg-additional-options "-mavx2" { target avx2 } }
- SUBROUTINE sfddagd( regime, znt, ite, jte )
+ SUBROUTINE sfddagd( regime, znt, ite, jte, ime, IN )
REAL, DIMENSION( ime, IN) :: regime, znt
REAL, DIMENSION( ite, jte) :: wndcor_u
LOGICAL wrf_dm_on_monitor
diff --git a/gcc/testsuite/gfortran.dg/pr78061.f
b/gcc/testsuite/gfortran.dg/pr78061.f
index 7e4dd3de8b5..9061dea74da 100644
--- a/gcc/testsuite/gfortran.dg/pr78061.f
+++ b/gcc/testsuite/gfortran.dg/pr78061.f
@@ -1,6 +1,6 @@
! { dg-do compile }
! { dg-options "-O3 -fsplit-loops" }
- SUBROUTINE SSYMM(C)
+ SUBROUTINE SSYMM(C,LDC)
REAL C(LDC,*)
LOGICAL LSAME
LOGICAL UPPER
diff --git a/gcc/testsuite/gfortran.dg/pr79315.f90
b/gcc/testsuite/gfortran.dg/pr79315.f90
index 8cd89691ce9..b754a2b3274 100644
--- a/gcc/testsuite/gfortran.dg/pr79315.f90
+++ b/gcc/testsuite/gfortran.dg/pr79315.f90
@@ -10,7 +10,11 @@ SUBROUTINE wsm32D(t, &
its,&
ite, &
kts, &
- kte &
+ kte, &
+ ims, &
+ ime, &
+ kms, &
+ kme &
)
REAL, DIMENSION( its:ite , kts:kte ), &
INTENT(INOUT) :: &
diff --git a/gcc/testsuite/gfortran.dg/vect/pr90681.f
b/gcc/testsuite/gfortran.dg/vect/pr90681.f
index 03d3987b146..49f1d50ab8f 100644
--- a/gcc/testsuite/gfortran.dg/vect/pr90681.f
+++ b/gcc/testsuite/gfortran.dg/vect/pr90681.f
@@ -1,6 +1,6 @@
C { dg-do compile }
C { dg-additional-options "-march=armv8.2-a+sve" { target { aarch64*-*-* } } }
- SUBROUTINE HMU (H1)
+ SUBROUTINE HMU (H1,NORBS)
COMMON DD(107)
DIMENSION H1(NORBS,*)
DO 70 J1 = IA,I1
diff --git a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
index 250e2bf016e..401ef06e422 100644
--- a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
+++ b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
@@ -1,7 +1,7 @@
! { dg-do compile }
! { dg-additional-options "-O1" }
-subroutine ni (ps)
+subroutine ni (ps, inout)
type vector
real x, y
end type
diff --git a/gcc/testsuite/gfortran.dg/vect/pr99746.f90
b/gcc/testsuite/gfortran.dg/vect/pr99746.f90
index fe947ae7ccf..121d67d564d 100644
---
