From 22fa926f19ae0ebbeec9598592b0cecc9e3fcd87 Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Sun, 10 May 2015 13:56:47 +0000 Subject: [PATCH] bound simplification refactoring gcc/fortran/ * simplify.c (simplify_bound_dim): Don't check for emptyness in the case of cobound simplification. Factor lower/upper bound differenciation before the actual simplification. (simplify_bound): Remove assumed shape specific simplification. Don't give up early for the lbound of an assumed shape. gcc/testsuite/ * gfortran.dg/bound_simplification_5.f90: New. From-SVN: r222979 --- gcc/fortran/ChangeLog | 8 ++ gcc/fortran/simplify.c | 85 ++++++++----------- gcc/testsuite/ChangeLog | 4 + .../gfortran.dg/bound_simplification_5.f90 | 75 ++++++++++++++++ 4 files changed, 123 insertions(+), 49 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bound_simplification_5.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9c952a1012b..b91f503d20a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2015-05-10 Mikael Morin + + * simplify.c (simplify_bound_dim): Don't check for emptyness + in the case of cobound simplification. Factor lower/upper + bound differenciation before the actual simplification. + (simplify_bound): Remove assumed shape specific simplification. + Don't give up early for the lbound of an assumed shape. + 2015-05-09 Mikael Morin PR fortran/65894 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 4ef9025901a..f8d55fdcd06 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3340,29 +3340,43 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, /* Then, we need to know the extent of the given dimension. */ if (coarray || (ref->u.ar.type == AR_FULL && !ref->next)) { + gfc_expr *declared_bound; + int empty_bound; + bool constant_lbound, constant_ubound; + l = as->lower[d-1]; u = as->upper[d-1]; - if (l->expr_type != EXPR_CONSTANT || u == NULL - || u->expr_type != EXPR_CONSTANT) + gcc_assert (l != NULL); + + constant_lbound = l->expr_type == EXPR_CONSTANT; + constant_ubound = u && u->expr_type == EXPR_CONSTANT; + + empty_bound = upper ? 0 : 1; + declared_bound = upper ? u : l; + + if ((!upper && !constant_lbound) + || (upper && !constant_ubound)) goto returnNull; - if (mpz_cmp (l->value.integer, u->value.integer) > 0) + if (!coarray) { - /* Zero extent. */ - if (upper) - mpz_set_si (result->value.integer, 0); + /* For {L,U}BOUND, the value depends on whether the array + is empty. We can nevertheless simplify if the declared bound + has the same value as that of an empty array, in which case + the result isn't dependent on the array emptyness. */ + if (mpz_cmp_si (declared_bound->value.integer, empty_bound) == 0) + mpz_set_si (result->value.integer, empty_bound); + else if (!constant_lbound || !constant_ubound) + /* Array emptyness can't be determined, we can't simplify. */ + goto returnNull; + else if (mpz_cmp (l->value.integer, u->value.integer) > 0) + mpz_set_si (result->value.integer, empty_bound); else - mpz_set_si (result->value.integer, 1); + mpz_set (result->value.integer, declared_bound->value.integer); } else - { - /* Nonzero extent. */ - if (upper) - mpz_set (result->value.integer, u->value.integer); - else - mpz_set (result->value.integer, l->value.integer); - } + mpz_set (result->value.integer, declared_bound->value.integer); } else { @@ -3442,43 +3456,16 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) done: - /* If the array shape is assumed shape or explicit, we can simplify lbound - to 1 if the given lower bound is one because this matches what lbound - should return for an empty array. */ - - if (!upper && as && dim && dim->expr_type == EXPR_CONSTANT - && (as->type == AS_ASSUMED_SHAPE || as->type == AS_EXPLICIT) - && ref->u.ar.type != AR_SECTION) - { - /* Watch out for allocatable or pointer dummy arrays, they can have - lower bounds that are not equal to one. */ - if (!(array->symtree && array->symtree->n.sym - && (array->symtree->n.sym->attr.allocatable - || array->symtree->n.sym->attr.pointer))) - { - unsigned long int ndim; - gfc_expr *lower, *res; - - ndim = mpz_get_si (dim->value.integer) - 1; - lower = as->lower[ndim]; - if (lower->expr_type == EXPR_CONSTANT - && mpz_cmp_si (lower->value.integer, 1) == 0) - { - res = gfc_copy_expr (lower); - if (kind) - { - int nkind = mpz_get_si (kind->value.integer); - res->ts.kind = nkind; - } - return res; - } - } - } - - if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE - || as->type == AS_ASSUMED_RANK)) + if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_RANK + || (as->type == AS_ASSUMED_SHAPE && upper))) return NULL; + gcc_assert (!as + || (as->type != AS_DEFERRED + && array->expr_type == EXPR_VARIABLE + && !array->symtree->n.sym->attr.allocatable + && !array->symtree->n.sym->attr.pointer)); + if (dim == NULL) { /* Multi-dimensional bounds. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 49b758efbe7..63ee9cc27f0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2015-05-10 Mikael Morin + + * gfortran.dg/bound_simplification_5.f90: New. + 2015-05-09 Jason Merrill * lib/target-supports.exp (cxx_default): New global. diff --git a/gcc/testsuite/gfortran.dg/bound_simplification_5.f90 b/gcc/testsuite/gfortran.dg/bound_simplification_5.f90 new file mode 100644 index 00000000000..7c9f040b842 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bound_simplification_5.f90 @@ -0,0 +1,75 @@ +! { dg-do run } +! { dg-additional-options "-fcoarray=single -fdump-tree-original" } +! +! Check that {L,U}{,CO}BOUND intrinsics are properly simplified. +! + implicit none + + type :: t + integer :: c + end type t + + type(t) :: d(3:8) = t(7) + type(t) :: e[5:9,-1:*] + type(t) :: h(3), j(4), k(0) + + !Test full arrays vs subarrays + if (lbound(d, 1) /= 3) call abort + if (lbound(d(3:5), 1) /= 1) call abort + if (lbound(d%c, 1) /= 1) call abort + if (ubound(d, 1) /= 8) call abort + if (ubound(d(3:5), 1) /= 3) call abort + if (ubound(d%c, 1) /= 6) call abort + + if (lcobound(e, 1) /= 5) call abort + if (lcobound(e%c, 1) /= 5) call abort + if (lcobound(e, 2) /= -1) call abort + if (lcobound(e%c, 2) /= -1) call abort + if (ucobound(e, 1) /= 9) call abort + if (ucobound(e%c, 1) /= 9) call abort + ! no simplification for ucobound(e{,%c}, dim=2) + + if (any(lbound(d ) /= [3])) call abort + if (any(lbound(d(3:5)) /= [1])) call abort + if (any(lbound(d%c ) /= [1])) call abort + if (any(ubound(d ) /= [8])) call abort + if (any(ubound(d(3:5)) /= [3])) call abort + if (any(ubound(d%c ) /= [6])) call abort + + if (any(lcobound(e ) /= [5, -1])) call abort + if (any(lcobound(e%c) /= [5, -1])) call abort + ! no simplification for ucobound(e{,%c}) + + call test_empty_arrays(h, j, k) + +contains + subroutine test_empty_arrays(a, c, d) + type(t) :: a(:), c(-3:0), d(3:1) + type(t) :: f(4:2), g(0:6) + + if (lbound(a, 1) /= 1) call abort + if (lbound(c, 1) /= -3) call abort + if (lbound(d, 1) /= 1) call abort + if (lbound(f, 1) /= 1) call abort + if (lbound(g, 1) /= 0) call abort + + if (ubound(c, 1) /= 0) call abort + if (ubound(d, 1) /= 0) call abort + if (ubound(f, 1) /= 0) call abort + if (ubound(g, 1) /= 6) call abort + + if (any(lbound(a) /= [ 1])) call abort + if (any(lbound(c) /= [-3])) call abort + if (any(lbound(d) /= [ 1])) call abort + if (any(lbound(f) /= [ 1])) call abort + if (any(lbound(g) /= [ 0])) call abort + + if (any(ubound(c) /= [0])) call abort + if (any(ubound(d) /= [0])) call abort + if (any(ubound(f) /= [0])) call abort + if (any(ubound(g) /= [6])) call abort + + end subroutine +end +! { dg-final { scan-tree-dump-not "abort" "original" } } +! { dg-final { cleanup-tree-dump "original" } } -- 2.30.2