Re: [Ping x 3, Patch, Fortran, PR84244, v3] Fix ICE in recompute_tree_invariant_for_addr_expr, at tree.c:4535
Hi all,
any one for a review? This patch is over a month old and starts to rot.
Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
- Andre
On Fri, 9 Aug 2024 16:27:42 +0200
Andre Vehreschild wrote:
> Ping!
>
> On Wed, 17 Jul 2024 15:11:33 +0200
> Andre Vehreschild wrote:
>
> > Hi all,
> >
> > and the last ping.
> >
> > Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
> >
> > Regards,
> > Andre
> >
> > On Thu, 11 Jul 2024 16:05:09 +0200
> > Andre Vehreschild wrote:
> >
> > > Hi all,
> > >
> > > the attached patch fixes a segfault in the compiler, where for pointer
> > > components of a derived type the caf_token in the component was not
> > > set, when the derived was previously used outside of a coarray.
> > >
> > > Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline?
> > >
> > > Regards,
> > > Andre
> >
> >
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 6cb0fc042ec3121b58c1e04b86c9a5c24ca581b1 Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Thu, 11 Jul 2024 15:44:56 +0200
Subject: [PATCH] [Fortran] Fix ICE in recompute_tree_invariant_for_addr_expr,
at tree.c:4535 [PR84244]
Declaring an unused function with a derived type having a pointer
component and using that derived type as a coarray, lead the compiler to
ICE because the caf_token for the pointer was not linked into the
component correctly.
PR fortran/84244
gcc/fortran/ChangeLog:
* trans-types.cc (gfc_get_derived_type): When a caf_sub_token is
generated for a component, link it to the component it is
generated for (the previous one).
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/ptr_comp_5.f08: New test.
---
gcc/fortran/trans-types.cc| 6 +-
.../gfortran.dg/coarray/ptr_comp_5.f08| 19 +++
2 files changed, 24 insertions(+), 1 deletion(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index e6da8e1a58b..bc582085f57 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2661,7 +2661,7 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
tree *chain = NULL;
bool got_canonical = false;
bool unlimited_entity = false;
- gfc_component *c;
+ gfc_component *c, *last_c = nullptr;
gfc_namespace *ns;
tree tmp;
bool coarray_flag, class_coarray_flag;
@@ -2961,10 +2961,14 @@ gfc_get_derived_type (gfc_symbol * derived, int codimen)
types. */
if (class_coarray_flag || !c->backend_decl)
c->backend_decl = field;
+ if (c->attr.caf_token && last_c)
+ last_c->caf_token = field;
if (c->attr.pointer && (c->attr.dimension || c->attr.codimension)
&& !(c->ts.type == BT_DERIVED && strcmp (c->name, "_data") == 0))
GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1;
+
+ last_c = c;
}
/* Now lay out the derived type, including the fields. */
diff --git a/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08 b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08
new file mode 100644
index 000..ed3a8db13fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/ptr_comp_5.f08
@@ -0,0 +1,19 @@
+! { dg-do compile }
+
+! Check PR84244 does not ICE anymore.
+
+program ptr_comp_5
+ integer, target :: dest = 42
+ type t
+integer, pointer :: p
+ end type
+ type(t) :: o[*]
+
+ o%p => dest
+contains
+ ! This unused routine is crucial for the ICE.
+ function f(x)
+type(t), intent(in) ::x
+ end function
+end program
+
--
2.45.2
[PATCH v2 02/10] fortran: Disable frontend passes for inlinable MINLOC/MAXLOC [PR90608]
From: Mikael Morin
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.
PR fortran/90608
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.
---
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 3c06018fdbb..8e4c6310ba8 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, &fn->where);
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 84a378ef310..2c8512060cc 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -11652,6 +11652,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;
}
--
2.43.0
[PATCH v2 03/10] fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608]
From: Mikael Morin
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.
---
gcc/fortran/trans-array.cc | 25
gcc/fortran/trans-intrinsic.cc | 224 +++--
2 files changed, 181 insertions(+), 68 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9fb0b2b398d..46e2152d0f0 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4851,6 +4851,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;
@@ -4900,6 +4902,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 (&se, nullptr);
+ se.loop = loop;
+ se.ss = ss;
+ gfc_conv_intrinsic_function (&se, expr);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
+
+ info->descriptor = se.expr;
+
+ info->data = gfc_conv_array_data (info->descriptor);
+ info->data = gfc_evaluate_now (info->data, &outer_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 2c8512060cc..9fcb57a9cc4 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5273,66 +5273,95 @@ 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) {
- if (a[S] <= limit) { limit = a[S]; pos = S + (1 - from); goto lab1; }
- S++;
- }
- if (from <= to) pos = 1;
- goto lab2;
- lab1:;
- while (S <= to) {
- if (a[S] < limit) { limit = a[S]; pos = S + (1 - from); }
- S++
[PATCH v2 04/10] fortran: Remove MINLOC/MAXLOC frontend optimization
From: Mikael Morin
This patch is new in the V2 series.
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Remove the frontend pass rewriting calls of MINLOC/MAXLOC without DIM to
calls with one-valued DIM enclosed in an array constructor. This
transformation was circumventing the limitation of inline MINLOC/MAXLOC code
generation to scalar cases only, allowing inline code to be generated if
ARRAY had rank 1 and DIM was absent. As MINLOC/MAXLOC has gained support of
inline code generation in that case, the limitation is no longer effective,
and the transformation no longer necessary.
gcc/fortran/ChangeLog:
* frontend-passes.cc (optimize_minmaxloc): Remove.
(optimize_expr): Remove dispatch to optimize_minmaxloc.
---
gcc/fortran/frontend-passes.cc | 57 --
1 file changed, 57 deletions(-)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 8e4c6310ba8..31d553e9844 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -36,7 +36,6 @@ static bool optimize_op (gfc_expr *);
static bool optimize_comparison (gfc_expr *, gfc_intrinsic_op);
static bool optimize_trim (gfc_expr *);
static bool optimize_lexical_comparison (gfc_expr *);
-static void optimize_minmaxloc (gfc_expr **);
static bool is_empty_string (gfc_expr *e);
static void doloop_warn (gfc_namespace *);
static int do_intent (gfc_expr **);
@@ -356,17 +355,6 @@ optimize_expr (gfc_expr **e, int *walk_subtrees
ATTRIBUTE_UNUSED,
if ((*e)->expr_type == EXPR_OP && optimize_op (*e))
gfc_simplify_expr (*e, 0);
- if ((*e)->expr_type == EXPR_FUNCTION && (*e)->value.function.isym)
-switch ((*e)->value.function.isym->id)
- {
- case GFC_ISYM_MINLOC:
- case GFC_ISYM_MAXLOC:
- optimize_minmaxloc (e);
- break;
- default:
- break;
- }
-
if (function_expr)
count_arglist --;
@@ -2262,51 +2250,6 @@ optimize_trim (gfc_expr *e)
return true;
}
-/* Optimize minloc(b), where b is rank 1 array, into
- (/ minloc(b, dim=1) /), and similarly for maxloc,
- as the latter forms are expanded inline. */
-
-static void
-optimize_minmaxloc (gfc_expr **e)
-{
- gfc_expr *fn = *e;
- gfc_actual_arglist *a;
- char *name, *p;
-
- if (fn->rank != 1
- || 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
- || gfc_inline_intrinsic_function_p (fn))
-return;
-
- *e = gfc_get_array_expr (fn->ts.type, fn->ts.kind, &fn->where);
- (*e)->shape = fn->shape;
- fn->rank = 0;
- fn->shape = NULL;
- gfc_constructor_append_expr (&(*e)->value.constructor, fn, &fn->where);
-
- name = XALLOCAVEC (char, strlen (fn->value.function.name) + 1);
- strcpy (name, fn->value.function.name);
- p = strstr (name, "loc0");
- p[3] = '1';
- fn->value.function.name = gfc_get_string ("%s", name);
- if (fn->value.function.actual->next)
-{
- a = fn->value.function.actual->next;
- gcc_assert (a->expr == NULL);
-}
- else
-{
- a = gfc_get_actual_arglist ();
- fn->value.function.actual->next = a;
-}
- a->expr = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
- &fn->where);
- mpz_set_ui (a->expr->value.integer, 1);
-}
-
/* Data package to hand down for DO loop checks in a contained
procedure. */
typedef struct contained_info
--
2.43.0
[PATCH v2 00/10] fortran: Inline MINLOC/MAXLOC without DIM argument [PR90608]
From: Mikael Morin Hello, this is the second version of the inline MINLOC/MAXLOC without DIM patchset whose first version was posted before at: https://gcc.gnu.org/pipermail/gcc-patches/2024-July/658909.html Appart from the NAN skipping conditional likeliness which is left unchanged, it takes into account the review comments I got so far, including the still controversial -finline-intrinsics flag. Regarding the conditional likeliness, I looked at its effect on the generated assembly for minmaxloc_18, and I really can't tell which is better just from the look of it. I prefer to not touch that part. Patches 4 (minmaxloc frontend pass removal) and 10 (-finline-intrinsics flag) are new, and patch 1 (tests) has been modified to move the NAN tests to a separate file and use the ieee_arithmetic intrinsic module. The rest of the patches are rebased versions of the previously posted patches. Details below and in the patches themselves. This series of patches enable the generation of inline code for the MINLOC and MAXLOC intrinsics, when the DIM argument is not present. The generated code is based on the inline implementation already generated in the scalar case, that is when ARRAY has rank 1 and DIM is present. The code is extended by using several variables (one for each dimension) where the scalar code used just one, and collecting the variables to an array before returning. The patches are split in a way that allows inlining in more and more cases as controlled by the gfc_inline_intrinsic_p predicate which evolves with the patches. Changes from V1: - In patch 1/10, use intrinsic ieee_arithmetic module to get NAN values in tests. This required to split the tests using ieee_arithmetic to a separate file in the ieee/ subdirectory. - Add patch 4/10 removing the frontend minmaxloc pass. - Add patch 10/10 adding -finline-intrinsics flag to control MINLOC/MAXLOC inlining from the command line. Mikael Morin (10): fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608] fortran: Disable frontend passes for inlinable MINLOC/MAXLOC [PR90608] fortran: Inline MINLOC/MAXLOC with no DIM and ARRAY of rank 1 [PR90608] fortran: Remove MINLOC/MAXLOC frontend optimization fortran: Outline array bound check generation code fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608] fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608] fortran: Inline non-character MINLOC/MAXLOC with no DIM [PR90608] fortran: Continue MINLOC/MAXLOC second loop where the first stopped [PR90608] fortran: Add -finline-intrinsics flag for MINLOC/MAXLOC [PR90608] gcc/flag-types.h | 30 + gcc/fortran/frontend-passes.cc| 56 -- gcc/fortran/invoke.texi | 24 + gcc/fortran/lang.opt | 27 + gcc/fortran/options.cc| 21 +- gcc/fortran/trans-array.cc| 382 + gcc/fortran/trans-intrinsic.cc| 489 --- .../gfortran.dg/ieee/maxloc_nan_1.f90 | 44 + .../gfortran.dg/ieee/minloc_nan_1.f90 | 44 + gcc/testsuite/gfortran.dg/maxloc_7.f90| 208 + gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 4 +- gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 | 4 +- gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 | 4 +- gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 4 +- .../gfortran.dg/maxloc_with_mask_1.f90| 373 + gcc/testsuite/gfortran.dg/minloc_8.f90| 208 + .../gfortran.dg/minloc_with_mask_1.f90| 372 + gcc/testsuite/gfortran.dg/minmaxloc_18.f90| 772 ++ gcc/testsuite/gfortran.dg/minmaxloc_18a.f90 | 10 + gcc/testsuite/gfortran.dg/minmaxloc_18b.f90 | 10 + gcc/testsuite/gfortran.dg/minmaxloc_18c.f90 | 10 + gcc/testsuite/gfortran.dg/minmaxloc_18d.f90 | 10 + 22 files changed, 2760 insertions(+), 346 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/ieee/maxloc_nan_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/ieee/minloc_nan_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_with_mask_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/minloc_8.f90 create mode 100644 gcc/testsuite/gfortran.dg/minloc_with_mask_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18a.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18b.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18c.f90 create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18d.f90 -- 2.43.0
[PATCH v2 08/10] fortran: Inline non-character MINLOC/MAXLOC with no DIM [PR90608]
From: Mikael Morin
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.
---
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 cd7a43f58fb..a92b733cf2f 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5358,12 +5358,55 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
}
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) {
+ S0 = from0;
+ while (S0 <= to0) {
+if (mask[S1][S0])
+ if (a[S1][S0] < limit) {
+limit = a[S1][S0];
+pos0 = S + (1 - from0);
+pos1 = S + (1 - from1);
+ }
+S0++;
+ }
+ S1++;
+}
+lab2:;
+result = { pos0, pos1 };
+ ...
+ 4) NANs aren't supported, no array mask.
limit = infinities_supported ? Infinity : huge (limit);
pos0 = (from0 <= to0 && from1 <= to1) ? 1 : 0;
pos1 = (fr
[PATCH v2 09/10] fortran: Continue MINLOC/MAXLOC second loop where the first stopped [PR90608]
From: Mikael Morin
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.
---
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 a92b733cf2f..b03f7b1653e 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5368,6 +5368,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 {
@@ -5380,6 +5381,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;
}
}
@@ -5389,9 +5391,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) {
@@ -5399,6 +5401,7 @@ strip_kind_from_actual (gfc_actual_arglist * actual)
pos0 = S + (1 - from0);
pos1 = S + (1 - from1);
}
+second_loop_entry = false;
S0++;
}
S1++;
@@ -5470,6 +5473,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_expr *backexpr;
gfc_se backse;
tree pos[GFC_MAX_DIMENSIONS];
+ tree idx[GFC_MAX_DIMENSIONS];
tree result_var = NULL_TREE;
int n;
bool optional_mask;
@@ -5551,6 +,8 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr *
expr, enum tree_code op)
gfc_get_string ("pos%d", i));
offset[i] = gfc_creat
[PATCH v2 06/10] fortran: Inline integral MINLOC/MAXLOC with no DIM and no MASK [PR90608]
From: Mikael Morin
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.
---
gcc/fortran/trans-array.cc| 70 ++--
gcc/fortran/trans-intrinsic.cc| 150 +-
gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 4 +-
3 files changed, 166 insertions(+), 58 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e578b676fcc..1190bfa6c02 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4956,6 +4956,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. */
@@ -5057,10 +5086,17 @@ done:
info->data = gfc_conv_array_data (info->descriptor);
info->data = gfc_evaluate_now (info->data, &outer_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,
+ gfc_array_index_type, rank,
+ gfc_index_one_node);
+
+ info->end[0] = gfc_evaluate_now (tmp, &outer_loop->pre);
info->start[0] = gfc_index_zero_node;
- info->end[0] = gfc_index_zero_node;
info->stride[0] = gfc_index_one_node;
+ info->offse
[PATCH v2 05/10] fortran: Outline array bound check generation code
From: Mikael Morin
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.
---
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 46e2152d0f0..e578b676fcc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -4816,6 +4816,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 = &expr->where;
+ const char *expr_name = expr->symtree->name;
+
+ gfc_array_info *info = &ss_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);
+}
+ else
+{
+ tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+info->start[dim], lbound);
+ tmp = fold_build2_loc (input_location, TRUTH_AND_EX
[PATCH v2 07/10] fortran: Inline integral MINLOC/MAXLOC with no DIM and scalar MASK [PR90608]
From: Mikael Morin
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.
---
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 b8a7faf5459..cd7a43f58fb 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5914,7 +5914,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 (&maskse, NULL);
@@ -5929,7 +5928,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 (&elseblock);
- gfc_add_modify (&elseblock, pos[0], gfc_index_zero_node);
+ for (int i = 0; i < loop.dimen; i++)
+ gfc_add_modify (&elseblock, pos[i], gfc_index_zero_node);
elsetmp = gfc_finish_block (&elseblock);
ifmask = conv_mask_condition (&maskse, maskexpr, optional_mask);
tmp = build3_v (COND_EXPR, ifmask, tmp, elsetmp);
@@ -11823,9 +11823,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 206a29b149d..3aa9d3dcebe 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." }
--
2.43.0
[PATCH v2 01/10] fortran: Add tests covering inline MINLOC/MAXLOC without DIM [PR90608]
From: Mikael Morin
Compared to the previous version of the patch at
https://gcc.gnu.org/pipermail/gcc-patches/2024-July/658916.html
this uses the IEEE_ARITHMETIC module to generate NAN values in the
tests. This change required to move the affected tests to a separate file
in the ieee/ subdirectory, so that the compiler when run has the intrinsic
module path correctly provided and can load the intrinsic module.
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/ieee/maxloc_nan_1.f90: New test.
* gfortran.dg/ieee/minloc_nan_1.f90: New test.
* 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.
---
.../gfortran.dg/ieee/maxloc_nan_1.f90 | 44 +++
.../gfortran.dg/ieee/minloc_nan_1.f90 | 44 +++
gcc/testsuite/gfortran.dg/maxloc_7.f90| 208 ++
.../gfortran.dg/maxloc_with_mask_1.f90| 373 ++
gcc/testsuite/gfortran.dg/minloc_8.f90| 208 ++
.../gfortran.dg/minloc_with_mask_1.f90| 372 +
6 files changed, 1249 insertions(+)
create mode 100644 gcc/testsuite/gfortran.dg/ieee/maxloc_nan_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/ieee/minloc_nan_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/maxloc_7.f90
create mode 100644 gcc/testsuite/gfortran.dg/maxloc_with_mask_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/minloc_8.f90
create mode 100644 gcc/testsuite/gfortran.dg/minloc_with_mask_1.f90
diff --git a/gcc/testsuite/gfortran.dg/ieee/maxloc_nan_1.f90
b/gcc/testsuite/gfortran.dg/ieee/maxloc_nan_1.f90
new file mode 100644
index 000..329b54e8e1f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/maxloc_nan_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! PR fortran/90608
+! Check the correct behaviour of the inline MAXLOC implementation,
+! when ARRAY is filled with NANs.
+
+program p
+ implicit none
+ call check_without_mask
+ call check_with_mask
+contains
+ subroutine check_without_mask()
+use, intrinsic :: ieee_arithmetic
+real, allocatable :: a(:,:,:)
+real :: nan
+integer, allocatable :: m(:)
+if (.not. ieee_support_nan(nan)) return
+nan = ieee_value(nan, ieee_quiet_nan)
+allocate(a(3,3,3), source = nan)
+m = maxloc(a)
+if (size(m, dim=1) /= 3) stop 32
+if (any(m /= (/ 1, 1, 1 /))) stop 35
+ end subroutine
+ subroutine check_with_mask()
+use, intrinsic :: ieee_arithmetic
+real, allocatable :: a(:,:,:)
+logical, allocatable :: m(:,:,:)
+real :: nan
+integer, allocatable :: r(:)
+if (.not. ieee_support_nan(nan)) return
+nan = ieee_value(nan, ieee_quiet_nan)
+allocate(a(3,3,3), source = nan)
+allocate(m(3,3,3))
+m(:,:,:) = reshape((/ .false., .false., .true. , .true. , .false., &
+ .true. , .false., .false., .false., .true. , &
+ .true. , .false., .true. , .true. , .true. , &
+ .false., .false., .true. , .true. , .false., &
+ .false., .true. , .false., .false., .true. , &
+ .true. , .true. /), shape(m))
+r = maxloc(a, mask = m)
+if (size(r, dim = 1) /= 3) stop 62
+if (any(r /= (/ 3, 1, 1 /))) stop 65
+ end subroutine
+end program p
diff --git a/gcc/testsuite/gfortran.dg/ieee/minloc_nan_1.f90
b/gcc/testsuite/gfortran.dg/ieee/minloc_nan_1.f90
new file mode 100644
index 000..8f71b4c4398
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/minloc_nan_1.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! PR fortran/90608
+! Check the correct behaviour of the inline MINLOC implementation,
+! when ARRAY is filled with NANs.
+
+program p
+ implicit none
+ call check_without_mask
+ call check_with_mask
+contains
+ subroutine check_without_mask()
+use, intrinsic :: ieee_arithmetic
+real, allocatable :: a(:,:,:)
+real :: nan
+integer, allocatable :: m(:)
+if (.not. ieee_support_nan(nan)) return
+nan = ieee_value(nan, ieee_quiet_nan)
+allocate(a(3,3,3), source = nan)
+m = minloc(a)
+if (size(m, dim=1) /= 3) stop 32
+if (any(m /= (/ 1, 1, 1 /))) stop 35
+ end subroutine
+ subroutine check_with_mask()
+use, intrinsic :: ieee_arithmetic
+real, allocatable :: a(:,:,:)
+logical, allocatable :: m(:,:,:)
+real :: nan
+integer, allocatable :: r(:)
+if (.not. ieee_support_nan(nan)) return
+nan = ieee_value(nan, ieee_quiet_nan)
+allocate(a(3,3,3), source = nan)
+allocate(m(3,3,3))
+m(:,:,:) = reshape((/ .false., .false., .true. , .true. , .false., &
+ .true. , .false., .false., .fals
[PATCH v2 10/10] fortran: Add -finline-intrinsics flag for MINLOC/MAXLOC [PR90608]
From: Mikael Morin
This patch is new in the V2 series.
Regression-tested on x86_64-pc-linux-gnu.
OK for master?
-- >8 --
Introduce the -finline-intrinsics flag to control from the command line
whether to generate either inline code or calls to the functions from the
library, for the MINLOC and MAXLOC intrinsics.
The flag allows to specify inlining either independently for each intrinsic
(either MINLOC or MAXLOC), or all together. For each intrinsic, a default
value is set if none was set. The default value depends on the optimization
setting: inlining is avoided if not optimizing or if optimizing for size;
otherwise inlining is preferred.
There is no direct support for this behaviour provided by the .opt options
framework. It is obtained by defining three different variants of the flag
(finline-intrinsics, fno-inline-intrinsics, finline-intrinsics=) all using
the same underlying option variable. Each enum value (corresponding to an
intrinsic function) uses two identical bits, and the variable is initialized
with alternated bits, so that we can tell whether the value was left
initialized by checking whether the two bits have different values.
PR fortran/90608
gcc/ChangeLog:
* flag-types.h (enum gfc_inlineable_intrinsics): New type.
gcc/fortran/ChangeLog:
* invoke.texi(finline-intrinsics): Document new flag.
* lang.opt (finline-intrinsics, finline-intrinsics=,
fno-inline-intrinsics): New flags.
* options.cc (gfc_post_options): If the option variable controling
the inlining of MAXLOC (respectively MINLOC) has not been set, set
it or clear it depending on the optimization option variables.
* trans-intrinsic.cc (gfc_inline_intrinsic_function_p): Return false
if inlining for the intrinsic is disabled according to the option
variable.
gcc/testsuite/ChangeLog:
* gfortran.dg/minmaxloc_18.f90: New test.
* gfortran.dg/minmaxloc_18a.f90: New test.
* gfortran.dg/minmaxloc_18b.f90: New test.
* gfortran.dg/minmaxloc_18c.f90: New test.
* gfortran.dg/minmaxloc_18d.f90: New test.
---
gcc/flag-types.h| 30 +
gcc/fortran/invoke.texi | 24 +
gcc/fortran/lang.opt| 27 +
gcc/fortran/options.cc | 21 +-
gcc/fortran/trans-intrinsic.cc | 13 +-
gcc/testsuite/gfortran.dg/minmaxloc_18.f90 | 772
gcc/testsuite/gfortran.dg/minmaxloc_18a.f90 | 10 +
gcc/testsuite/gfortran.dg/minmaxloc_18b.f90 | 10 +
gcc/testsuite/gfortran.dg/minmaxloc_18c.f90 | 10 +
gcc/testsuite/gfortran.dg/minmaxloc_18d.f90 | 10 +
10 files changed, 922 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18.f90
create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18a.f90
create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18b.f90
create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18c.f90
create mode 100644 gcc/testsuite/gfortran.dg/minmaxloc_18d.f90
diff --git a/gcc/flag-types.h b/gcc/flag-types.h
index 1e497f0bb91..df56337f7e8 100644
--- a/gcc/flag-types.h
+++ b/gcc/flag-types.h
@@ -451,6 +451,36 @@ enum gfc_convert
};
+/* gfortran -finline-intrinsics= values;
+ We use two identical bits for each value, and initialize with alternated
+ bits, so that we can check whether a value has been set by checking whether
+ the two bits have identical value. */
+
+#define GFC_INL_INTR_VAL(idx) (3 << (2 * idx))
+#define GFC_INL_INTR_UNSET_VAL(val) (0x & (val))
+
+enum gfc_inlineable_intrinsics
+{
+ GFC_FLAG_INLINE_INTRINSIC_NONE = 0,
+ GFC_FLAG_INLINE_INTRINSIC_MAXLOC = GFC_INL_INTR_VAL (0),
+ GFC_FLAG_INLINE_INTRINSIC_MINLOC = GFC_INL_INTR_VAL (1),
+ GFC_FLAG_INLINE_INTRINSIC_ALL = GFC_FLAG_INLINE_INTRINSIC_MAXLOC
+ | GFC_FLAG_INLINE_INTRINSIC_MINLOC,
+
+ GFC_FLAG_INLINE_INTRINSIC_NONE_UNSET
+ = GFC_INL_INTR_UNSET_VAL (GFC_FLAG_INLINE_INTRINSIC_NONE),
+ GFC_FLAG_INLINE_INTRINSIC_MAXLOC_UNSET
+ = GFC_INL_INTR_UNSET_VAL (GFC_FLAG_INLINE_INTRINSIC_MAXLOC),
+ GFC_FLAG_INLINE_INTRINSIC_MINLOC_UNSET
+ = GFC_INL_INTR_UNSET_VAL (GFC_FLAG_INLINE_INTRINSIC_MINLOC),
+ GFC_FLAG_INLINE_INTRINSIC_ALL_UNSET
+ = GFC_INL_INTR_UNSET_VAL (GFC_FLAG_INLINE_INTRINSIC_ALL)
+};
+
+#undef GFC_INL_INTR_UNSET_VAL
+#undef GFC_INL_INTR_VAL
+
+
/* Inline String Operations functions. */
enum ilsop_fn
{
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 6bc42afe2c4..53b6de1c92b 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -194,6 +194,7 @@ and warnings}.
-finit-character=@var{n} -finit-integer=@var{n} -finit-local-zero
-finit-derived -finit-logical=@var{}
-finit-real=@var{}
+-finline-intrinsics[=<@var{minloc},@var{maxloc}>]
-finline-matmul-limit=@var{n}
-finline-arg-packing -fmax-array-constructor=@var{n}
-fma
[Fortran, Patch, PR46371, v1] Fix coarrays use in select type
Hi all,
attached patch is a follow up on the pr110033 patch and fixes two ICEs
reported in pr46371. With the patch also pr56496 is fixed, although that could
have been fixed by pr110033 already. I just added the testcase from pr56496 here
as coarray/select_type_3.f90 (I like it when the name of the test gives a rough
idea on what is tested instead of having just the pr#) to have it covered.
Bootstraps and regtests ok on x86_64-pc-linux-gnu. Ok for mainline?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
From 205e001e9df7d7b84667a16deee776d2cc8129ca Mon Sep 17 00:00:00 2001
From: Andre Vehreschild
Date: Thu, 15 Aug 2024 20:23:23 +0200
Subject: [PATCH] [Fortran] Allow coarrays in select type. [PR46371, PR56496]
Fix ICE when scalar coarrays are used in a select type. Prevent
coindexing in associate/select type/select rank selector expression.
gcc/fortran/ChangeLog:
PR fortran/46371
PR fortran/56496
* expr.cc (gfc_is_coindexed): Detect is coindexed also when
rewritten to caf_get.
* trans-stmt.cc (trans_associate_var): Always accept a
descriptor for coarrays.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/select_type_1.f90: New test.
* gfortran.dg/coarray/select_type_2.f90: New test.
* gfortran.dg/coarray/select_type_3.f90: New test.
---
gcc/fortran/expr.cc | 4 +++
gcc/fortran/trans-stmt.cc | 10 ++
.../gfortran.dg/coarray/select_type_1.f90 | 34 +++
.../gfortran.dg/coarray/select_type_2.f90 | 19 +++
.../gfortran.dg/coarray/select_type_3.f90 | 23 +
5 files changed, 83 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/select_type_3.f90
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index d3a1f8c0ba1..4f2d80c04f8 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5803,6 +5803,10 @@ gfc_is_coindexed (gfc_expr *e)
{
gfc_ref *ref;
+ if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+ && e->value.function.isym->id == GFC_ISYM_CAF_GET)
+e = e->value.function.actual->expr;
+
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
return !gfc_ref_this_image (ref);
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 3b09a139dc0..023b1739b85 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -2200,16 +2200,12 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
else
stmp = gfc_class_data_get (ctmp);
- /* Coarray scalar component expressions can emerge from
- the front end as array elements of the _data field. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp)))
- stmp = gfc_conv_descriptor_data_get (stmp);
-
- if (!POINTER_TYPE_P (TREE_TYPE (stmp)))
+ if (!CLASS_DATA (sym)->attr.codimension
+ && !POINTER_TYPE_P (TREE_TYPE (stmp)))
stmp = gfc_build_addr_expr (NULL, stmp);
dtmp = gfc_class_data_get (ctree);
- stmp = fold_convert (TREE_TYPE (dtmp), stmp);
+ stmp = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dtmp), stmp);
gfc_add_modify (&se.pre, dtmp, stmp);
stmp = gfc_class_vptr_get (ctmp);
dtmp = gfc_class_vptr_get (ctree);
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
new file mode 100644
index 000..7f12fb9aec7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/select_type_1.f90
@@ -0,0 +1,34 @@
+!{ dg-do run }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus
+
+program pr46371
+ type :: foo
+integer :: i = 0
+ end type
+
+ class(foo), allocatable :: o_foo[:]
+ integer :: j
+
+ allocate(foo :: o_foo[*])
+ if (this_image() == 1) then
+
+select type(a => o_foo)
+ type is(foo)
+ j = a[1]%i
+ a[1]%i = 3
+end select
+
+if (j /= 0) stop 1
+
+select type(o_foo)
+ type is(foo)
+ j = o_foo[1]%i
+end select
+
+if (o_foo[1]%i /= 3) stop 2
+if (j /= 3) stop 3
+ end if
+end program pr46371
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
new file mode 100644
index 000..1694d095708
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/select_type_2.f90
@@ -0,0 +1,19 @@
+!{ dg-do compile }
+
+! Check PR46371 is fixed.
+! Contributed by Tobias Burnus
+
+program pr46371
+ type :: foo
+integer :: i = 0
+ end type
+
+ class(foo), allocatable :: o_foo[:]
+ integer :: j
+
+ select type(a => o_foo[2]) !{ dg-error "must not be coindexed" }
+type is(foo)
+j = a%i
+ end select
+end program pr46371
+
diff --git a/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90 b/gcc/testsuite/gfortran.dg/coarray/select_type_3.f90
new file mode 100644
index 000
Re: [PATCH] Fortran: fix doumentation of intrinsic RANDOM_INIT [PR114146]
Hi Andre, Am 16.08.24 um 07:46 schrieb Andre Vehreschild: Hi Harald, s/doumentation/documentation/ in the commit's title. oops! Thanks for pointing this out. Fixed and pushed as r15-2955-g07ece73d4712c6 . Harald Thanks for the patch, ok to commit. - Andre On Thu, 15 Aug 2024 22:37:53 +0200 Harald Anlauf wrote: Dear all, here's a documentation bugfix. The previous wording was in conflict with the standard, while the runtime behavior is apparently fine. Checked with make dvi pdf . OK for mainline? Thanks, Harald -- Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Fortran, Patch, PR46371, v1] Fix coarrays use in select type
Hi Andre, Am 16.08.24 um 14:10 schrieb Andre Vehreschild: Hi all, attached patch is a follow up on the pr110033 patch and fixes two ICEs reported in pr46371. With the patch also pr56496 is fixed, although that could have been fixed by pr110033 already. I just added the testcase from pr56496 here as coarray/select_type_3.f90 (I like it when the name of the test gives a rough idea on what is tested instead of having just the pr#) to have it covered. Bootstraps and regtests ok on x86_64-pc-linux-gnu. Ok for mainline? this looks good to me. I think with this patch also pr99837 is resolved. Can you have a look, and if so, close it? Thanks for the patch! Harald Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
Re: [Ping x 3, Patch, Fortran, PR84244, v3] Fix ICE in recompute_tree_invariant_for_addr_expr, at tree.c:4535
Hi Andre, Am 16.08.24 um 12:05 schrieb Andre Vehreschild: Hi all, any one for a review? This patch is over a month old and starts to rot. Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? this is good to go. Thanks for the patch! Harald - Andre On Fri, 9 Aug 2024 16:27:42 +0200 Andre Vehreschild wrote: Ping! On Wed, 17 Jul 2024 15:11:33 +0200 Andre Vehreschild wrote: Hi all, and the last ping. Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? Regards, Andre On Thu, 11 Jul 2024 16:05:09 +0200 Andre Vehreschild wrote: Hi all, the attached patch fixes a segfault in the compiler, where for pointer components of a derived type the caf_token in the component was not set, when the derived was previously used outside of a coarray. Regtests ok on x86_64-pc-linux-gnu / Fedora 39. Ok for mainline? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de -- Andre Vehreschild * Email: vehre ad gmx dot de -- Andre Vehreschild * Email: vehre ad gmx dot de
