diff mbox series

[committed] PR fortran/96613,96686 - Fix type/kind issues, temporaries evaluating MIN/MAX

Message ID trinity-25628229-8e5e-4493-bb99-dc8abe473f12-1597781224588@3c-app-gmx-bs20
State New
Headers show
Series [committed] PR fortran/96613,96686 - Fix type/kind issues, temporaries evaluating MIN/MAX | expand

Commit Message

Harald Anlauf Aug. 18, 2020, 8:07 p.m. UTC 
There was another issue (PR96686) with MIN/MAX for character arguments of
different kind.

Character arguments to MIN/MAX are a Fortran 2003 feature, so there is no
real reason to have a new GNU extension, and no related legacy code.
Instead of ICEing, we now unconditionally generate an error

This was confirmed in PR96686 by Steve, who also approved the patch for PR96613.
Both patches were combined, regtested on x86_64-pc-linux-gnu, and committed.

Thanks,
Harald

Full commit message:

PR fortran/96613,96686 - Fix type/kind issues, 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.

Furthermore, the Fortran standard requires type and kind of arguments to
the MIN/MAX intrinsics to all have the same type and kind.  While a GNU
extension accepts kind differences for integer and real arguments which
seems to have been used in legacy code, there is no reason to allow
different character kinds.  We now reject the latter unconditionally.

gcc/fortran/ChangeLog:

	* check.c (check_rest): Reject MIN/MAX character arguments of
	different kind.
	* 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/minmax_char_3.f90: New test.
	* gfortran.dg/min_max_kind.f90: New test.
	* gfortran.dg/pr96613.f90: New test.
diff mbox series

Patch

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 74e5e448760..65b46cd3f85 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 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/minmax_char_3.f90 b/gcc/testsuite/gfortran.dg/minmax_char_3.f90
new file mode 100644
index 00000000000..291ba1fd1e9
--- /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 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