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 <tkoe...@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 <tkoe...@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
