diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/check.c | 5 | ||||
| -rw-r--r-- | gcc/fortran/simplify.c | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/min_max_kind.f90 | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/minmax_char_3.f90 | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr96613.f90 | 15 |
6 files changed, 69 insertions, 8 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 74e5e44..65b46cd 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3693,6 +3693,11 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) { if (x->ts.type == type) { + if (x->ts.type == BT_CHARACTER) + { + gfc_error ("Different character kinds at %L", &x->where); + return false; + } if (!gfc_notify_std (GFC_STD_GNU, "Different type " "kinds at %L", &x->where)) return false; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index eb8b2af..074b50c 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 fd88099..2483f01 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 0000000..b22691e --- /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/minmax_char_3.f90 b/gcc/testsuite/gfortran.dg/minmax_char_3.f90 new file mode 100644 index 0000000..291ba1f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minmax_char_3.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! PR96686: MIN/MAX should reject character arguments of different kind + +program p + implicit none + character(kind=1) :: c1 = "1" + character(kind=4) :: c4 = 4_"4" + print *, min (c1, c4) ! { dg-error "Different character kinds" } + print *, min (c4, c1) ! { dg-error "Different character kinds" } +end program p diff --git a/gcc/testsuite/gfortran.dg/pr96613.f90 b/gcc/testsuite/gfortran.dg/pr96613.f90 new file mode 100644 index 0000000..2043c25 --- /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 |