While looking at the reported issue, it appeared that the Fortran frontend
mishandled the conversion of functions of the MIN/MAX variety to inline code.
At the same time, the simplification of expressions using a common and GNU
extension (but non-standard) could result in inconsistent results. The patch
below addresses that.
Regtested on x86_64-pc-linux-gnu.
OK for master?
Thanks,
Harald
PR fortran/96613 - Fix type/kind of temporaries evaluating MIN/MAX
When evaluating functions of the MIN/MAX variety inline, use a temporary
of appropriate type and kind, and convert to the result type at the end.
In the case of allowing for the GNU extensions to MIN/MAX, derive the
result kind consistently during simplificaton.
gcc/fortran/ChangeLog:
* simplify.c (min_max_choose): The simplification result shall
have the highest kind value of the arguments.
* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Choose type and
kind of intermediate by looking at all arguments, not the result.
gcc/testsuite/ChangeLog:
* gfortran.dg/min_max_kind.f90: New test.
* gfortran.dg/pr96613.f90: New test.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index eb8b2afeb29..074b50c2e68 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4924,6 +4924,8 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
switch (arg->ts.type)
{
case BT_INTEGER:
+ if (extremum->ts.kind < arg->ts.kind)
+ extremum->ts.kind = arg->ts.kind;
ret = mpz_cmp (arg->value.integer,
extremum->value.integer) * sign;
if (ret > 0)
@@ -4931,6 +4933,8 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val)
break;
case BT_REAL:
+ if (extremum->ts.kind < arg->ts.kind)
+ extremum->ts.kind = arg->ts.kind;
if (mpfr_nan_p (extremum->value.real))
{
ret = 1;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index fd8809902b7..2483f016d8e 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -4073,6 +4073,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
tree val;
tree *args;
tree type;
+ tree argtype;
gfc_actual_arglist *argexpr;
unsigned int i, nargs;
@@ -4082,16 +4083,24 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
gfc_conv_intrinsic_function_args (se, expr, args, nargs);
type = gfc_typenode_for_spec (&expr->ts);
- argexpr = expr->value.function.actual;
- if (TREE_TYPE (args[0]) != type)
- args[0] = convert (type, args[0]);
/* Only evaluate the argument once. */
if (!VAR_P (args[0]) && !TREE_CONSTANT (args[0]))
args[0] = gfc_evaluate_now (args[0], &se->pre);
- mvar = gfc_create_var (type, "M");
- gfc_add_modify (&se->pre, mvar, args[0]);
+ /* Determine suitable type of temporary, as a GNU extension allows
+ different argument kinds. */
+ argtype = TREE_TYPE (args[0]);
+ argexpr = expr->value.function.actual;
+ for (i = 1, argexpr = argexpr->next; i < nargs; i++, argexpr = argexpr->next)
+ {
+ tree tmptype = TREE_TYPE (args[i]);
+ if (TYPE_PRECISION (tmptype) > TYPE_PRECISION (argtype))
+ argtype = tmptype;
+ }
+ mvar = gfc_create_var (argtype, "M");
+ gfc_add_modify (&se->pre, mvar, convert (argtype, args[0]));
+ argexpr = expr->value.function.actual;
for (i = 1, argexpr = argexpr->next; i < nargs; i++, argexpr = argexpr->next)
{
tree cond = NULL_TREE;
@@ -4119,8 +4128,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
Also, there is no consensus among other tested compilers. In
short, it's a mess. So lets just do whatever is fastest. */
tree_code code = op == GT_EXPR ? MAX_EXPR : MIN_EXPR;
- calc = fold_build2_loc (input_location, code, type,
- convert (type, val), mvar);
+ calc = fold_build2_loc (input_location, code, argtype,
+ convert (argtype, val), mvar);
tmp = build2_v (MODIFY_EXPR, mvar, calc);
if (cond != NULL_TREE)
@@ -4128,7 +4137,10 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
build_empty_stmt (input_location));
gfc_add_expr_to_block (&se->pre, tmp);
}
- se->expr = mvar;
+ if (TREE_CODE (type) == INTEGER_TYPE)
+ se->expr = fold_build1_loc (input_location, FIX_TRUNC_EXPR, type, mvar);
+ else
+ se->expr = convert (type, mvar);
}
diff --git a/gcc/testsuite/gfortran.dg/min_max_kind.f90 b/gcc/testsuite/gfortran.dg/min_max_kind.f90
new file mode 100644
index 00000000000..b22691e1ffe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/min_max_kind.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-O2 -std=gnu" }
+! Verify that the GNU extensions to MIN/MAX handle mixed kinds properly.
+
+program p
+ implicit none
+ integer(1), parameter :: i1 = 1
+ integer(2), parameter :: i2 = 2
+ real(4), parameter :: r4 = 4
+ real(8), parameter :: r8 = 8
+ if (kind (min (i1, i2)) /= kind (i2)) stop 1
+ if (kind (min (i2, i1)) /= kind (i2)) stop 2
+ if (kind (min (r4, r8)) /= kind (r8)) stop 3
+ if (kind (min (r8, r4)) /= kind (r8)) stop 4
+end program p
diff --git a/gcc/testsuite/gfortran.dg/pr96613.f90 b/gcc/testsuite/gfortran.dg/pr96613.f90
new file mode 100644
index 00000000000..2043c25fe1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr96613.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-O2 -std=gnu" }
+! PR fortran/96613 - Fix type/kind of temporaries evaluating MIN/MAX
+
+program test
+ implicit none
+ real :: x = 7.7643945e+09
+ real :: y = 6000.
+ integer :: ix
+
+ ix = min1 (5000.0, x)
+ if (ix /= 5000) stop 1
+ ix = min1 (y, x, 5555.d0)
+ if (ix /= 5555) stop 2
+end program
