+2015-05-10 Mikael Morin <mikael@gcc.gnu.org>
+
+ * 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 <mikael@gcc.gnu.org>
PR fortran/65894
/* 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
{
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. */
+2015-05-10 Mikael Morin <mikael@gcc.gnu.org>
+
+ * gfortran.dg/bound_simplification_5.f90: New.
+
2015-05-09 Jason Merrill <jason@redhat.com>
* lib/target-supports.exp (cxx_default): New global.
--- /dev/null
+! { 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" } }
projects / gcc.git / commitdiff