| Message ID | 20151120200947.GA61350@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
Hi Steve, Just a couple of small typos: "Unexpected expr_type cause an ICE" ; causes? "! An array of derived types workd too." ; works? Apart from that it's OK for trunk. Thanks for the patch Cheers Paul On 20 November 2015 at 21:09, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > On Thu, Nov 19, 2015 at 04:58:36PM -0800, Steve Kargl wrote: >> >> 2015-11-19 Steven G. Kargl <kargl@gcc.gnu.org> >> >> * intrinsic.h: Prototype for gfc_simplify_cshift >> * intrinsic.c (add_functions): Use gfc_simplify_cshift. >> * simplify.c (gfc_simplify_cshift): Implement simplification of CSHIFT. >> (gfc_simplify_spread): Remove a FIXME and add error condition. >> >> 2015-11-19 Steven G. Kargl <kargl@gcc.gnu.org> >> >> * gfortran.dg/simplify_cshift_1.f90: New test. >> > > I've attached an updated patch. The changes consists of > 1) better/more comments > 2) re-organize code to reduce copying of the array. > 3) add optimization for a left/right shift that > returns the original array. > 4) Don't leak memory. > > -- > Steve
On Sat, Nov 21, 2015 at 11:41:51AM +0100, Paul Richard Thomas wrote: > > Just a couple of small typos: > "Unexpected expr_type cause an ICE" ; causes? > "! An array of derived types workd too." ; works? > > Apart from that it's OK for trunk. > > Thanks for the patch > Thanks for the the review. I don't have a clue as to how to do simplification for rank > 2. :(
On Sat, Nov 21, 2015 at 8:26 AM, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > On Sat, Nov 21, 2015 at 11:41:51AM +0100, Paul Richard Thomas wrote: >> >> Just a couple of small typos: >> "Unexpected expr_type cause an ICE" ; causes? >> "! An array of derived types workd too." ; works? >> >> Apart from that it's OK for trunk. >> >> Thanks for the patch >> > > Thanks for the the review. I don't have a clue as > to how to do simplification for rank > 2. :( > It breaks bootstrap: int dm; /* DIM is only useful for rank > 1, but deal with it here as one can set DIM = 1 for rank = 1. */ if (dim) { if (!gfc_is_constant_expr (dim)) return NULL; dm = mpz_get_si (dim->value.integer); } else dm = 1; dm is set, but never used. H.J.
On Sat, Nov 21, 2015 at 10:07:35AM -0800, H.J. Lu wrote: > On Sat, Nov 21, 2015 at 8:26 AM, Steve Kargl > <sgk@troutmask.apl.washington.edu> wrote: > > On Sat, Nov 21, 2015 at 11:41:51AM +0100, Paul Richard Thomas wrote: > >> > >> Just a couple of small typos: > >> "Unexpected expr_type cause an ICE" ; causes? > >> "! An array of derived types workd too." ; works? > >> > >> Apart from that it's OK for trunk. > >> > >> Thanks for the patch > >> > > > > Thanks for the the review. I don't have a clue as > > to how to do simplification for rank > 2. :( > > > > It breaks bootstrap: > > int dm; > > /* DIM is only useful for rank > 1, but deal with it here as one can > set DIM = 1 for rank = 1. */ > if (dim) > { > if (!gfc_is_constant_expr (dim)) > return NULL; > dm = mpz_get_si (dim->value.integer); > } > else > dm = 1; > > dm is set, but never used. > Perhaps, bootstrap needs to set appropriate warning levels.
On Sat, Nov 21, 2015 at 10:20 AM, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > On Sat, Nov 21, 2015 at 10:07:35AM -0800, H.J. Lu wrote: >> On Sat, Nov 21, 2015 at 8:26 AM, Steve Kargl >> <sgk@troutmask.apl.washington.edu> wrote: >> > On Sat, Nov 21, 2015 at 11:41:51AM +0100, Paul Richard Thomas wrote: >> >> >> >> Just a couple of small typos: >> >> "Unexpected expr_type cause an ICE" ; causes? >> >> "! An array of derived types workd too." ; works? >> >> >> >> Apart from that it's OK for trunk. >> >> >> >> Thanks for the patch >> >> >> > >> > Thanks for the the review. I don't have a clue as >> > to how to do simplification for rank > 2. :( >> > >> >> It breaks bootstrap: >> >> int dm; >> >> /* DIM is only useful for rank > 1, but deal with it here as one can >> set DIM = 1 for rank = 1. */ >> if (dim) >> { >> if (!gfc_is_constant_expr (dim)) >> return NULL; >> dm = mpz_get_si (dim->value.integer); >> } >> else >> dm = 1; >> >> dm is set, but never used. >> > > Perhaps, bootstrap needs to set appropriate warning levels. https://gcc.gnu.org/ml/gcc-regression/2015-11/msg00648.html
On Sat, Nov 21, 2015 at 11:19:22AM -0800, H.J. Lu wrote: > On Sat, Nov 21, 2015 at 10:20 AM, Steve Kargl > <sgk@troutmask.apl.washington.edu> wrote: > > On Sat, Nov 21, 2015 at 10:07:35AM -0800, H.J. Lu wrote: > >> On Sat, Nov 21, 2015 at 8:26 AM, Steve Kargl > >> <sgk@troutmask.apl.washington.edu> wrote: > >> > On Sat, Nov 21, 2015 at 11:41:51AM +0100, Paul Richard Thomas wrote: > >> >> > >> >> Just a couple of small typos: > >> >> "Unexpected expr_type cause an ICE" ; causes? > >> >> "! An array of derived types workd too." ; works? > >> >> > >> >> Apart from that it's OK for trunk. > >> >> > >> >> Thanks for the patch > >> >> > >> > > >> > Thanks for the the review. I don't have a clue as > >> > to how to do simplification for rank > 2. :( > >> > > >> > >> It breaks bootstrap: > >> > >> int dm; > >> > >> /* DIM is only useful for rank > 1, but deal with it here as one can > >> set DIM = 1 for rank = 1. */ > >> if (dim) > >> { > >> if (!gfc_is_constant_expr (dim)) > >> return NULL; > >> dm = mpz_get_si (dim->value.integer); > >> } > >> else > >> dm = 1; > >> > >> dm is set, but never used. > >> > > > > Perhaps, bootstrap needs to set appropriate warning levels. > > https://gcc.gnu.org/ml/gcc-regression/2015-11/msg00648.html > See 5 lines up.
Index: gcc/fortran/intrinsic.c =================================================================== --- gcc/fortran/intrinsic.c (revision 230585) +++ gcc/fortran/intrinsic.c (working copy) @@ -1659,9 +1659,11 @@ add_functions (void) make_generic ("count", GFC_ISYM_COUNT, GFC_STD_F95); - add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95, - gfc_check_cshift, NULL, gfc_resolve_cshift, - ar, BT_REAL, dr, REQUIRED, sh, BT_INTEGER, di, REQUIRED, + add_sym_3 ("cshift", GFC_ISYM_CSHIFT, CLASS_TRANSFORMATIONAL, ACTUAL_NO, + BT_REAL, dr, GFC_STD_F95, + gfc_check_cshift, gfc_simplify_cshift, gfc_resolve_cshift, + ar, BT_REAL, dr, REQUIRED, + sh, BT_INTEGER, di, REQUIRED, dm, BT_INTEGER, ii, OPTIONAL); make_generic ("cshift", GFC_ISYM_CSHIFT, GFC_STD_F95); Index: gcc/fortran/intrinsic.h =================================================================== --- gcc/fortran/intrinsic.h (revision 230585) +++ gcc/fortran/intrinsic.h (working copy) @@ -271,6 +271,7 @@ gfc_expr *gfc_simplify_conjg (gfc_expr * gfc_expr *gfc_simplify_cos (gfc_expr *); gfc_expr *gfc_simplify_cosh (gfc_expr *); gfc_expr *gfc_simplify_count (gfc_expr *, gfc_expr *, gfc_expr *); +gfc_expr *gfc_simplify_cshift (gfc_expr *, gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *); gfc_expr *gfc_simplify_dble (gfc_expr *); gfc_expr *gfc_simplify_digits (gfc_expr *); Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 230585) +++ gcc/fortran/simplify.c (working copy) @@ -1789,6 +1789,99 @@ gfc_simplify_count (gfc_expr *mask, gfc_ gfc_expr * +gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) +{ + int dm; + gfc_expr *a; + + /* DIM is only useful for rank > 1, but deal with it here as one can + set DIM = 1 for rank = 1. */ + if (dim) + { + if (!gfc_is_constant_expr (dim)) + return NULL; + dm = mpz_get_si (dim->value.integer); + } + else + dm = 1; + + /* Copy array into 'a', simplify it, and then test for a constant array. + Unexpected expr_type cause an ICE. */ + switch (array->expr_type) + { + case EXPR_VARIABLE: + case EXPR_ARRAY: + a = gfc_copy_expr (array); + gfc_simplify_expr (a, 0); + if (!is_constant_array_expr (a)) + { + gfc_free_expr (a); + return NULL; + } + break; + default: + gcc_unreachable (); + } + + if (a->rank == 1) + { + gfc_constructor *ca, *cr; + gfc_expr *result; + mpz_t size; + int i, j, shft, sz; + + if (!gfc_is_constant_expr (shift)) + { + gfc_free_expr (a); + return NULL; + } + + shft = mpz_get_si (shift->value.integer); + + /* Case (i): If ARRAY has rank one, element i of the result is + ARRAY (1 + MODULO (i + SHIFT 1, SIZE (ARRAY))). */ + + mpz_init (size); + gfc_array_size (a, &size); + sz = mpz_get_si (size); + mpz_clear (size); + + /* Special case: rank 1 array with no shift or a complete shift to + the original order! */ + if (shft == 0 || shft == sz || shft == 1 - sz) + return a; + + /* Adjust shft to deal with right or left shifts. */ + shft = shft < 0 ? 1 - shft : shft; + + result = gfc_copy_expr (a); + cr = gfc_constructor_first (result->value.constructor); + for (i = 0; i < sz; i++, cr = gfc_constructor_next (cr)) + { + j = (i + shft) % sz; + ca = gfc_constructor_first (a->value.constructor); + while (j-- > 0) + ca = gfc_constructor_next (ca); + cr->expr = gfc_copy_expr (ca->expr); + } + + gfc_free_expr (a); + return result; + } + else + { + /* FIXME: Deal with rank > 1 arrays. For now, don't leak memory + and exit with an error message. */ + gfc_free_expr (a); + gfc_error ("Simplification of CSHIFT with an array with rank > 1 " + "no yet support"); + } + + return NULL; +} + + +gfc_expr * gfc_simplify_dcmplx (gfc_expr *x, gfc_expr *y) { return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind); @@ -6089,10 +6182,11 @@ gfc_simplify_spread (gfc_expr *source, g } } else - /* FIXME: Returning here avoids a regression in array_simplify_1.f90. - Replace NULL with gcc_unreachable() after implementing - gfc_simplify_cshift(). */ - return NULL; + { + gfc_error ("Simplification of SPREAD at %L not yet implemented", + &source->where); + return &gfc_bad_expr; + } if (source->ts.type == BT_CHARACTER) result->ts.u.cl = source->ts.u.cl; Index: gcc/testsuite/gfortran.dg/simplify_cshift_1.f90 =================================================================== --- gcc/testsuite/gfortran.dg/simplify_cshift_1.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/simplify_cshift_1.f90 (working copy) @@ -0,0 +1,46 @@ +! { dg-do run } +program foo + + implicit none + + type t + integer i + end type t + + type(t), parameter :: d(5) = [t(1), t(2), t(3), t(4), t(5)] + type(t) e(5), q(5) + + integer, parameter :: a(5) = [1, 2, 3, 4, 5] + integer i, b(5), c(5), v(5) + + c = [1, 2, 3, 4, 5] + + b = cshift(a, -2) + v = cshift(c, -2) + if (any(b /= v)) call abort + + b = cshift(a, 2) + v = cshift(c, 2) + if (any(b /= v)) call abort + + ! Special cases shift = 0, size(a), 1-size(a) + b = cshift([1, 2, 3, 4, 5], 0) + if (any(b /= a)) call abort + b = cshift([1, 2, 3, 4, 5], size(a)) + if (any(b /= a)) call abort + b = cshift([1, 2, 3, 4, 5], 1-size(a)) + if (any(b /= a)) call abort + + ! simplification of array arg. + b = cshift(2 * a, 0) + if (any(b /= 2 * a)) call abort + + ! An array of derived types workd too. + e = [t(1), t(2), t(3), t(4), t(5)] + e = cshift(e, 3) + q = cshift(d, 3) + do i = 1, 5 + if (e(i)%i /= q(i)%i) call abort + end do + +end program foo