From 317fa0647833daa24c3b82333a75f64814cda8b5 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 11 Dec 2017 17:39:07 +0000 Subject: [PATCH] re PR fortran/45689 ([F03] Missing transformational intrinsic in the trans_func_f2003 list) 2017-12-11 Thomas Koenig 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-11 Thomas Koenig PR fortran/45689 * gfortran.dg/minval_parameter_1.f90: New test. * gfortran.dg/maxval_parameter_1.f90: New test. From-SVN: r255542 --- gcc/fortran/ChangeLog | 12 ++++ gcc/fortran/simplify.c | 72 ++++++++---------------- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/maxval_parameter_1.f90 | 51 +++++++++++++++++ gcc/testsuite/gfortran.dg/minval_parameter_1.f90 | 51 +++++++++++++++++ 5 files changed, 145 insertions(+), 47 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/maxval_parameter_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/minval_parameter_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a668e12..7817b1e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2017-12-11 Thomas Koenig + + 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 Dominique d'Humieres PR fortran/53478 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index f11ea42..7c3fefe 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -29,6 +29,9 @@ 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; @@ -436,7 +439,8 @@ typedef gfc_expr* (*transformational_op)(gfc_expr*, 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 *dim, gfc_expr *mask, 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); } - -/* This is a simplified version of simplify_min_max to provide - simplification of minval and maxval for a vector. */ +/* Helper function for gfc_simplify_minval. */ 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); +} + +/* Helper function for gfc_simplify_maxval. */ - return simplify_minval_maxval (array, -1); +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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4795a1d..c51c200 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-12-11 Thomas Koenig + + PR fortran/45689 + * gfortran.dg/minval_parameter_1.f90: New test. + * gfortran.dg/maxval_parameter_1.f90: New test. + 2017-12-10 Dominique d'Humieres PR fortran/53478 diff --git a/gcc/testsuite/gfortran.dg/maxval_parameter_1.f90 b/gcc/testsuite/gfortran.dg/maxval_parameter_1.f90 new file mode 100644 index 0000000..a8a1cb0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxval_parameter_1.f90 @@ -0,0 +1,51 @@ +! { 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 diff --git a/gcc/testsuite/gfortran.dg/minval_parameter_1.f90 b/gcc/testsuite/gfortran.dg/minval_parameter_1.f90 new file mode 100644 index 0000000..2d01935 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minval_parameter_1.f90 @@ -0,0 +1,51 @@ +! { 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 -- 2.7.4