[patch, fortran] Implement Maxval in compile-time-constants

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

the attached patch allows for maxval in parameter statements
with DIM and MASK arguments.

It does so by removing a function which does only a partial
job and using the machinery which is already in use for the
other transformational intrinsics.

Regression-tested. OK for trunk?

Regards

	Thomas

2017-12-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45689
	* simplify.c (min_max_choose): Add prototype.
	(gfc_count): Format correctly.
	(simplify_transformation): Pass array argument to init_result_expr.
	(gfc_simplify_minval_maxval): Remove.
	(gfc_min): New function.
	(gfc_simplify_minval): Call simplify_transformation.
	(gfc_max): New function.
	(gfc_simplify_maxval): Call simplify_transformation.

2017-12-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/45689
	* gfortran.dg/minval_parameter_1.f90: New test.
	* gfortran.dg/maxval_parameter_1.f90: New test.

Index: simplify.c
===================================================================
--- simplify.c	(Revision 255522)
+++ simplify.c	(Arbeitskopie)
@@ -29,7 +29,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "constructor.h"
 #include "version.h"	/* For version_string.  */
 
+/* Prototypes.  */
 
+static void min_max_choose (gfc_expr *, gfc_expr *, int);
+
 gfc_expr gfc_bad_expr;
 
 static gfc_expr *simplify_size (gfc_expr *, gfc_expr *, int);
@@ -436,7 +439,8 @@ typedef gfc_expr* (*transformational_op)(gfc_expr*
    Interface and implementation mimics arith functions as
    gfc_add, gfc_multiply, etc.  */
 
-static gfc_expr* gfc_count (gfc_expr *op1, gfc_expr *op2)
+static gfc_expr *
+gfc_count (gfc_expr *op1, gfc_expr *op2)
 {
   gfc_expr *result;
 
@@ -666,7 +670,7 @@ simplify_transformation (gfc_expr *array, gfc_expr
 
   result = transformational_result (array, dim, array->ts.type,
 				    array->ts.kind, &array->where);
-  init_result_expr (result, init_val, NULL);
+  init_result_expr (result, init_val, array);
 
   return !dim || array->rank == 1 ?
     simplify_transformation_to_scalar (result, array, mask, op) :
@@ -4539,67 +4543,41 @@ gfc_simplify_max (gfc_expr *e)
   return simplify_min_max (e, 1);
 }
 
+/* Helper function for gfc_simplify_minval.  */
 
-/* This is a simplified version of simplify_min_max to provide
-   simplification of minval and maxval for a vector.  */
-
 static gfc_expr *
-simplify_minval_maxval (gfc_expr *expr, int sign)
+gfc_min (gfc_expr *op1, gfc_expr *op2)
 {
-  gfc_constructor *c, *extremum;
-  gfc_intrinsic_sym * specific;
-
-  extremum = NULL;
-  specific = expr->value.function.isym;
-
-  for (c = gfc_constructor_first (expr->value.constructor);
-       c; c = gfc_constructor_next (c))
-    {
-      if (c->expr->expr_type != EXPR_CONSTANT)
-	return NULL;
-
-      if (extremum == NULL)
-	{
-	  extremum = c;
-	  continue;
-	}
-
-      min_max_choose (c->expr, extremum->expr, sign);
-     }
-
-  if (extremum == NULL)
-    return NULL;
-
-  /* Convert to the correct type and kind.  */
-  if (expr->ts.type != BT_UNKNOWN)
-    return gfc_convert_constant (extremum->expr,
-	expr->ts.type, expr->ts.kind);
-
-  if (specific->ts.type != BT_UNKNOWN)
-    return gfc_convert_constant (extremum->expr,
-	specific->ts.type, specific->ts.kind);
-
-  return gfc_copy_expr (extremum->expr);
+  min_max_choose (op1, op2, -1);
+  gfc_free_expr (op1);
+  return op2;
 }
 
+/* Simplify minval for constant arrays.  */
 
 gfc_expr *
 gfc_simplify_minval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
 {
-  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
-    return NULL;
+  return simplify_transformation (array, dim, mask, INT_MAX, gfc_min);
+}
 
-  return simplify_minval_maxval (array, -1);
+/* Helper function for gfc_simplify_maxval.  */
+
+static gfc_expr *
+gfc_max (gfc_expr *op1, gfc_expr *op2)
+{
+  min_max_choose (op1, op2, 1);
+  gfc_free_expr (op1);
+  return op2;
 }
 
 
+/* Simplify maxval for constant arrays.  */
+
 gfc_expr *
 gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask)
 {
-  if (array->expr_type != EXPR_ARRAY || array->rank != 1 || dim || mask)
-    return NULL;
-
-  return simplify_minval_maxval (array, 1);
+  return simplify_transformation (array, dim, mask, INT_MIN, gfc_max);
 }
 
 

! { dg-do  run }
! Test for run-time simplification of minval
program main
  implicit none
  integer, dimension(2,3), parameter :: i = &
       & reshape([-1,2,-3,5,-7,11], shape(i))
  integer, dimension(3), parameter :: im1 = minval(i,dim=1)
  integer, parameter :: im2 = minval(i,mask=i>4)
  integer, dimension(2), parameter :: im3 = minval(i,dim=2)
  integer, parameter :: im4 = minval(i, mask=i>-1)
  integer, dimension(3), parameter :: im5 = minval(i,dim=1,mask=i>4)
  integer, dimension(2), parameter :: im6 = minval(i,dim=2,mask=i>4)

  real, dimension(2,3), parameter :: r = &
       & reshape([-1.,2.,-3.,5.,-7.,11.], shape(r))
  real, dimension(3), parameter :: rm1 = minval(r,dim=1)
  real, parameter :: rm2 = minval(r,mask=r>4)
  real, dimension(2), parameter :: rm3 = minval(r,dim=2)
  real, parameter :: rm4 = minval(r, mask=r>-1)
  real, dimension(3), parameter :: rm5 = minval(r,dim=1,mask=r>4)
  real, dimension(2), parameter :: rm6 = minval(r,dim=2,mask=r>4)

  character(len=3), parameter :: maxv = achar(255) // achar(255) // achar(255)
  character(len=3), dimension(2,3), parameter :: c = &
       reshape(["asd", "fgh", "qwe", "jkl", "ert", "zui"], shape(c))
  character(len=3), parameter :: cm1 = minval(c)
  character(len=3), dimension(3), parameter :: cm2 = minval(c,dim=1)
  character(len=3), dimension(2), parameter :: cm3 = minval(c,dim=2)
  character(len=3), parameter :: cm4 = minval (c, c>"g")
  character(len=3), dimension(3), parameter :: cm5 = minval(c,dim=1,mask=c>"g")

  if (any (im1 /= [ -1, -3, -7])) call abort
  if (im2 /= 5) call abort
  if (any (im3 /= [ -7,2])) call abort
  if (im4 /= 2) call abort
  if (any (im5 /= [huge(im5), 5, 11])) call abort
  if (any (im6 /= [huge(im6), 5])) call abort

  if (any (rm1 /= [ -1., -3., -7.])) call abort
  if (rm2 /= 5) call abort
  if (any (rm3 /= [ -7.,2.])) call abort
  if (rm4 /= 2) call abort
  if (any (rm5 /= [huge(rm5), 5., 11.])) call abort
  if (any (rm6 /= [huge(rm6), 5.])) call abort

  if (cm1 /= "asd") call abort
  if (any (cm2 /= ["asd", "jkl", "ert" ])) call abort
  if (any (cm3 /= ["asd", "fgh" ])) call abort
  if (cm4 /= "jkl") call abort
  if (any(cm5 /= [ maxv, "jkl", "zui" ] )) call abort
end program main

! { dg-do  run }
! Test for run-time simplification of maxval
program main
  implicit none
  integer, dimension(2,3), parameter :: i = &
       & reshape([-1,2,-3,5,-7,11], shape(i))
  integer, dimension(3), parameter :: im1 = maxval(i,dim=1)
  integer, parameter :: im2 = maxval(i,mask=i<0)
  integer, dimension(2), parameter :: im3 = maxval(i,dim=2)
  integer, parameter :: im4 = maxval(i, mask=i<-1)
  integer, dimension(3), parameter :: im5 = maxval(i,dim=1,mask=i<-2)
  integer, dimension(2), parameter :: im6 = maxval(i,dim=2,mask=i<0)

  real, dimension(2,3), parameter :: r = &
       & reshape([-1.,2.,-3.,5.,-7.,11.], shape(r))
  real, dimension(3), parameter :: rm1 = maxval(r,dim=1)
  real, parameter :: rm2 = maxval(r,mask=r<0)
  real, dimension(2), parameter :: rm3 = maxval(r,dim=2)
  real, parameter :: rm4 = maxval(r, mask=r<-1)
  real, dimension(3), parameter :: rm5 = maxval(r,dim=1,mask=r<-2)
  real, dimension(2), parameter :: rm6 = maxval(r,dim=2,mask=r<0)

  character(len=3), parameter :: minv = achar(0) // achar(0) // achar(0)
  character(len=3), dimension(2,3), parameter :: c = &
       reshape(["asd", "fgh", "qwe", "jkl", "ert", "zui"], shape(c))
  character(len=3), parameter :: cm1 = maxval(c)
  character(len=3), dimension(3), parameter :: cm2 = maxval(c,dim=1)
  character(len=3), dimension(2), parameter :: cm3 = maxval(c,dim=2)
  character(len=3), parameter :: cm4 = maxval (c, c<"g")
  character(len=3), dimension(3), parameter :: cm5 = maxval(c,dim=1,mask=c<"p")

  if (any (im1 /= [ 2, 5, 11])) call abort
  if (im2 /= -1) call abort
  if (any (im3 /= [ -1,11])) call abort
  if (im4 /= -3) call abort
  if (any (im5 /= [-huge(im5)-1, -3, -7])) call abort ! { dg-warning "Integer outside symmetric range" }
  if (any (im6 /= [-1, -huge(im6)-1])) call abort ! { dg-warning "Integer outside symmetric range" }

  if (any (rm1 /= [ 2., 5., 11.])) call abort
  if (rm2 /= -1.) call abort
  if (any (rm3 /= [ -1.,11.])) call abort
  if (rm4 /= -3.) call abort
  if (any (rm5 /= [-huge(rm5), -3., -7.])) call abort
  if (any (rm6 /= [-1.,-huge(rm6)])) call abort

  if (cm1 /= "zui") call abort
  if (any (cm2 /= ["fgh", "qwe", "zui" ])) call abort
  if (any (cm3 /= ["qwe", "zui" ])) call abort
  if (cm4 /= "fgh") call abort
  if (any(cm5 /= [ "fgh", "jkl", "ert" ] )) call abort
end program main