tree val;
tree *args;
tree type;
+ tree argtype;
gfc_actual_arglist *argexpr;
unsigned int i, nargs;
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;
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)
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);
}
--- /dev/null
+! { 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