From b9bcea643a2982c926d2ed66368c4d295757d5cb Mon Sep 17 00:00:00 2001 From: tkoenig Date: Sat, 21 Feb 2009 22:25:06 +0000 Subject: [PATCH] 2008-02-21 Thomas Koenig PR fortran/38914 * array.c (ref_dimen_size): Rename to gfc_ref_dimen_size, make global. Change function name in error messages. (ref_size): Change ref_dimen_size to gfc_ref_dimen_size. (gfc_array_ref_shape): Likewise. * gfortran.h: Add prototype for gfc_ref_dimen_size. * simplify.c (simplify_bound_dim): Add ref argument. If the reference isn't a full array, return one for the lower bound and the extent for the upper bound. (simplify_bound): For array sections, take as from the argument. Add reference to all to simplify_bound_dim. 2008-02-21 Thomas Koenig PR fortran/38914 * bound_simplification_2.f90: New test case. * bound_7.f90: New test case. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@144362 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 14 ++ gcc/fortran/array.c | 14 +- gcc/fortran/gfortran.h | 3 + gcc/fortran/simplify.c | 56 ++++-- gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/bound_7.f90 | 223 +++++++++++++++++++++ .../gfortran.dg/bound_simplification_2.f90 | 9 + 7 files changed, 299 insertions(+), 26 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/bound_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/bound_simplification_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 147891a..57ad11b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2008-02-21 Thomas Koenig + + PR fortran/38914 + * array.c (ref_dimen_size): Rename to gfc_ref_dimen_size, + make global. Change function name in error messages. + (ref_size): Change ref_dimen_size to gfc_ref_dimen_size. + (gfc_array_ref_shape): Likewise. + * gfortran.h: Add prototype for gfc_ref_dimen_size. + * simplify.c (simplify_bound_dim): Add ref argument. + If the reference isn't a full array, return one for + the lower bound and the extent for the upper bound. + (simplify_bound): For array sections, take as from the + argument. Add reference to all to simplify_bound_dim. + 2009-02-19 Daniel Franke * scanner.c (load_line): At end of line, skip '\r' without setting diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index fe83ec6..46c7425 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1876,14 +1876,14 @@ spec_size (gfc_array_spec *as, mpz_t *result) /* Get the number of elements in an array section. */ -static gfc_try -ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result) +gfc_try +gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result) { mpz_t upper, lower, stride; gfc_try t; if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1) - gfc_internal_error ("ref_dimen_size(): Bad dimension"); + gfc_internal_error ("gfc_ref_dimen_size(): Bad dimension"); switch (ar->dimen_type[dimen]) { @@ -1957,7 +1957,7 @@ ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result) return t; default: - gfc_internal_error ("ref_dimen_size(): Bad dimen_type"); + gfc_internal_error ("gfc_ref_dimen_size(): Bad dimen_type"); } return t; @@ -1974,7 +1974,7 @@ ref_size (gfc_array_ref *ar, mpz_t *result) for (d = 0; d < ar->dimen; d++) { - if (ref_dimen_size (ar, d, &size) == FAILURE) + if (gfc_ref_dimen_size (ar, d, &size) == FAILURE) { mpz_clear (*result); return FAILURE; @@ -2020,7 +2020,7 @@ gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result) if (ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) dimen--; - return ref_dimen_size (&ref->u.ar, i - 1, result); + return gfc_ref_dimen_size (&ref->u.ar, i - 1, result); } } @@ -2148,7 +2148,7 @@ gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape) { if (ar->dimen_type[i] != DIMEN_ELEMENT) { - if (ref_dimen_size (ar, i, &shape[d]) == FAILURE) + if (gfc_ref_dimen_size (ar, i, &shape[d]) == FAILURE) goto cleanup; d++; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 19faa06..8795bee 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2517,6 +2517,9 @@ gfc_try spec_size (gfc_array_spec *, mpz_t *); gfc_try spec_dimen_size (gfc_array_spec *, int, mpz_t *); int gfc_is_compile_time_shape (gfc_array_spec *); +gfc_try gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *); + + /* interface.c -- FIXME: some of these should be in symbol.c */ void gfc_free_interface (gfc_interface *); int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c460f31..6893a88 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -2178,7 +2178,7 @@ gfc_simplify_kind (gfc_expr *e) static gfc_expr * simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, - gfc_array_spec *as) + gfc_array_spec *as, gfc_ref *ref) { gfc_expr *l, *u, *result; int k; @@ -2192,13 +2192,6 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, return NULL; } - /* Then, we need to know the extent of the given dimension. */ - l = as->lower[d-1]; - u = as->upper[d-1]; - - if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) - return NULL; - k = get_kind (BT_INTEGER, kind, upper ? "UBOUND" : "LBOUND", gfc_default_integer_kind); if (k == -1) @@ -2206,21 +2199,43 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper, result = gfc_constant_result (BT_INTEGER, k, &array->where); - if (mpz_cmp (l->value.integer, u->value.integer) > 0) + + /* Then, we need to know the extent of the given dimension. */ + if (ref->u.ar.type == AR_FULL) { - /* Zero extent. */ - if (upper) - mpz_set_si (result->value.integer, 0); + l = as->lower[d-1]; + u = as->upper[d-1]; + + if (l->expr_type != EXPR_CONSTANT || u->expr_type != EXPR_CONSTANT) + return NULL; + + if (mpz_cmp (l->value.integer, u->value.integer) > 0) + { + /* Zero extent. */ + if (upper) + mpz_set_si (result->value.integer, 0); + else + mpz_set_si (result->value.integer, 1); + } else - mpz_set_si (result->value.integer, 1); + { + /* Nonzero extent. */ + if (upper) + mpz_set (result->value.integer, u->value.integer); + else + mpz_set (result->value.integer, l->value.integer); + } } else { - /* Nonzero extent. */ if (upper) - mpz_set (result->value.integer, u->value.integer); + { + if (gfc_ref_dimen_size (&ref->u.ar, d-1, &result->value.integer) + != SUCCESS) + return NULL; + } else - mpz_set (result->value.integer, l->value.integer); + mpz_set_si (result->value.integer, (long int) 1); } return range_check (result, upper ? "UBOUND" : "LBOUND"); @@ -2258,9 +2273,12 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) /* Fall through. */ - case AR_SECTION: case AR_UNKNOWN: return NULL; + + case AR_SECTION: + as = ref->u.ar.as; + goto done; } gcc_unreachable (); @@ -2300,7 +2318,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) /* Simplify the bounds for each dimension. */ for (d = 0; d < array->rank; d++) { - bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as); + bounds[d] = simplify_bound_dim (array, kind, d + 1, upper, as, ref); if (bounds[d] == NULL || bounds[d] == &gfc_bad_expr) { int j; @@ -2366,7 +2384,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) return &gfc_bad_expr; } - return simplify_bound_dim (array, kind, d, upper, as); + return simplify_bound_dim (array, kind, d, upper, as, ref); } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1d2db2e..9c63dbf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2008-02-21 Thomas Koenig + + PR fortran/38914 + * bound_simplification_2.f90: New test case. + * bound_7.f90: New test case. + 2009-02-21 Joseph Myers * gcc.dg/cpp/include4.c: New test. diff --git a/gcc/testsuite/gfortran.dg/bound_7.f90 b/gcc/testsuite/gfortran.dg/bound_7.f90 new file mode 100644 index 0000000..e422845 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bound_7.f90 @@ -0,0 +1,223 @@ +! { dg-do run } +! { dg-options "-std=gnu" } +! PR fortran/29391 +! This file is here to check that LBOUND and UBOUND return correct values +! +! Contributed by Francois-Xavier Coudert (coudert@clipper.ens.fr) + implicit none + integer, allocatable :: i(:,:), j(:), u(:,:,:,:) + + allocate (i(-1:1,-1:1)) + i = 0 + allocate (j(-1:2)) + j = 0 + allocate (u(7,4,2,9)) + + call foo(u,4) + call jackal(-1,-8) + call jackal(-1,8) + + if (any(lbound(i(-1:1,-1:1)) /= 1)) call abort + if (lbound(i(-1:1,-1:1), 1) /= 1) call abort + if (lbound(i(-1:1,-1:1), 2) /= 1) call abort + + if (any(ubound(i(-1:1,-1:1)) /= 3)) call abort + if (ubound(i(-1:1,-1:1), 1) /= 3) call abort + if (ubound(i(-1:1,-1:1), 2) /= 3) call abort + + if (any(lbound(i(:,:)) /= 1)) call abort + if (lbound(i(:,:), 1) /= 1) call abort + if (lbound(i(:,:), 2) /= 1) call abort + + if (any(ubound(i(:,:)) /= 3)) call abort + if (ubound(i(:,:), 1) /= 3) call abort + if (ubound(i(:,:), 2) /= 3) call abort + + if (any(lbound(i(0:,-1:)) /= 1)) call abort + if (lbound(i(0:,-1:), 1) /= 1) call abort + if (lbound(i(0:,-1:), 2) /= 1) call abort + + if (any(ubound(i(0:,-1:)) /= [2,3])) call abort + if (ubound(i(0:,-1:), 1) /= 2) call abort + if (ubound(i(0:,-1:), 2) /= 3) call abort + + if (any(lbound(i(:0,:0)) /= 1)) call abort + if (lbound(i(:0,:0), 1) /= 1) call abort + if (lbound(i(:0,:0), 2) /= 1) call abort + + if (any(ubound(i(:0,:0)) /= 2)) call abort + if (ubound(i(:0,:0), 1) /= 2) call abort + if (ubound(i(:0,:0), 2) /= 2) call abort + + if (any(lbound(transpose(i)) /= 1)) call abort + if (lbound(transpose(i), 1) /= 1) call abort + if (lbound(transpose(i), 2) /= 1) call abort + + if (any(ubound(transpose(i)) /= 3)) call abort + if (ubound(transpose(i), 1) /= 3) call abort + if (ubound(transpose(i), 2) /= 3) call abort + + if (any(lbound(reshape(i,[2,2])) /= 1)) call abort + if (lbound(reshape(i,[2,2]), 1) /= 1) call abort + if (lbound(reshape(i,[2,2]), 2) /= 1) call abort + + if (any(ubound(reshape(i,[2,2])) /= 2)) call abort + if (ubound(reshape(i,[2,2]), 1) /= 2) call abort + if (ubound(reshape(i,[2,2]), 2) /= 2) call abort + + if (any(lbound(cshift(i,-1)) /= 1)) call abort + if (lbound(cshift(i,-1), 1) /= 1) call abort + if (lbound(cshift(i,-1), 2) /= 1) call abort + + if (any(ubound(cshift(i,-1)) /= 3)) call abort + if (ubound(cshift(i,-1), 1) /= 3) call abort + if (ubound(cshift(i,-1), 2) /= 3) call abort + + if (any(lbound(eoshift(i,-1)) /= 1)) call abort + if (lbound(eoshift(i,-1), 1) /= 1) call abort + if (lbound(eoshift(i,-1), 2) /= 1) call abort + + if (any(ubound(eoshift(i,-1)) /= 3)) call abort + if (ubound(eoshift(i,-1), 1) /= 3) call abort + if (ubound(eoshift(i,-1), 2) /= 3) call abort + + if (any(lbound(spread(i,1,2)) /= 1)) call abort + if (lbound(spread(i,1,2), 1) /= 1) call abort + if (lbound(spread(i,1,2), 2) /= 1) call abort + + if (any(ubound(spread(i,1,2)) /= [2,3,3])) call abort + if (ubound(spread(i,1,2), 1) /= 2) call abort + if (ubound(spread(i,1,2), 2) /= 3) call abort + if (ubound(spread(i,1,2), 3) /= 3) call abort + + if (any(lbound(maxloc(i)) /= 1)) call abort + if (lbound(maxloc(i), 1) /= 1) call abort + + if (any(ubound(maxloc(i)) /= 2)) call abort + if (ubound(maxloc(i), 1) /= 2) call abort + + if (any(lbound(minloc(i)) /= 1)) call abort + if (lbound(minloc(i), 1) /= 1) call abort + + if (any(ubound(minloc(i)) /= 2)) call abort + if (ubound(minloc(i), 1) /= 2) call abort + + if (any(lbound(maxval(i,2)) /= 1)) call abort + if (lbound(maxval(i,2), 1) /= 1) call abort + + if (any(ubound(maxval(i,2)) /= 3)) call abort + if (ubound(maxval(i,2), 1) /= 3) call abort + + if (any(lbound(minval(i,2)) /= 1)) call abort + if (lbound(minval(i,2), 1) /= 1) call abort + + if (any(ubound(minval(i,2)) /= 3)) call abort + if (ubound(minval(i,2), 1) /= 3) call abort + + if (any(lbound(any(i==1,2)) /= 1)) call abort + if (lbound(any(i==1,2), 1) /= 1) call abort + + if (any(ubound(any(i==1,2)) /= 3)) call abort + if (ubound(any(i==1,2), 1) /= 3) call abort + + if (any(lbound(count(i==1,2)) /= 1)) call abort + if (lbound(count(i==1,2), 1) /= 1) call abort + + if (any(ubound(count(i==1,2)) /= 3)) call abort + if (ubound(count(i==1,2), 1) /= 3) call abort + + if (any(lbound(merge(i,i,.true.)) /= 1)) call abort + if (lbound(merge(i,i,.true.), 1) /= 1) call abort + if (lbound(merge(i,i,.true.), 2) /= 1) call abort + + if (any(ubound(merge(i,i,.true.)) /= 3)) call abort + if (ubound(merge(i,i,.true.), 1) /= 3) call abort + if (ubound(merge(i,i,.true.), 2) /= 3) call abort + + if (any(lbound(lbound(i)) /= 1)) call abort + if (lbound(lbound(i), 1) /= 1) call abort + + if (any(ubound(lbound(i)) /= 2)) call abort + if (ubound(lbound(i), 1) /= 2) call abort + + if (any(lbound(ubound(i)) /= 1)) call abort + if (lbound(ubound(i), 1) /= 1) call abort + + if (any(ubound(ubound(i)) /= 2)) call abort + if (ubound(ubound(i), 1) /= 2) call abort + + if (any(lbound(shape(i)) /= 1)) call abort + if (lbound(shape(i), 1) /= 1) call abort + + if (any(ubound(shape(i)) /= 2)) call abort + if (ubound(shape(i), 1) /= 2) call abort + + if (any(lbound(product(i,2)) /= 1)) call abort + if (any(ubound(product(i,2)) /= 3)) call abort + if (any(lbound(sum(i,2)) /= 1)) call abort + if (any(ubound(sum(i,2)) /= 3)) call abort + if (any(lbound(matmul(i,i)) /= 1)) call abort + if (any(ubound(matmul(i,i)) /= 3)) call abort + if (any(lbound(pack(i,.true.)) /= 1)) call abort + if (any(ubound(pack(i,.true.)) /= 9)) call abort + if (any(lbound(unpack(j,[.true.],[2])) /= 1)) call abort + if (any(ubound(unpack(j,[.true.],[2])) /= 1)) call abort + + call sub1(i,3) + call sub1(reshape([7,9,4,6,7,9],[3,2]),3) + call sub2 + +contains + + subroutine sub1(a,n) + integer :: n, a(2:n+1,4:*) + + if (any([lbound(a,1), lbound(a,2)] /= [2, 4])) call abort + if (any(lbound(a) /= [2, 4])) call abort + end subroutine sub1 + + subroutine sub2 + integer :: x(3:2, 1:2) + + if (size(x) /= 0) call abort + if (lbound (x, 1) /= 1 .or. lbound(x, 2) /= 1) call abort + if (any (lbound (x) /= [1, 1])) call abort + if (ubound (x, 1) /= 0 .or. ubound(x, 2) /= 2) call abort + if (any (ubound (x) /= [0, 2])) call abort + end subroutine sub2 + + subroutine sub3 + integer :: x(4:5, 1:2) + + if (size(x) /= 0) call abort + if (lbound (x, 1) /= 4 .or. lbound(x, 2) /= 1) call abort + if (any (lbound (x) /= [4, 1])) call abort + if (ubound (x, 1) /= 4 .or. ubound(x, 2) /= 2) call abort + if (any (ubound (x) /= [4, 2])) call abort + end subroutine sub3 + + subroutine foo (x,n) + integer :: x(7,n,2,*), n + + if (ubound(x,1) /= 7 .or. ubound(x,2) /= 4 .or. ubound(x,3) /= 2) call abort + end subroutine foo + + subroutine jackal (b, c) + integer :: b, c + integer :: soda(b:c, 3:4) + + if (b > c) then + if (size(soda) /= 0) call abort + if (lbound (soda, 1) /= 1 .or. ubound (soda, 1) /= 0) call abort + else + if (size(soda) /= 2*(c-b+1)) call abort + if (lbound (soda, 1) /= b .or. ubound (soda, 1) /= c) call abort + end if + + if (lbound (soda, 2) /= 3 .or. ubound (soda, 2) /= 4) call abort + if (any (lbound (soda) /= [lbound(soda,1), lbound(soda,2)])) call abort + if (any (ubound (soda) /= [ubound(soda,1), ubound(soda,2)])) call abort + + end subroutine jackal + +end diff --git a/gcc/testsuite/gfortran.dg/bound_simplification_2.f90 b/gcc/testsuite/gfortran.dg/bound_simplification_2.f90 new file mode 100644 index 0000000..0547777 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bound_simplification_2.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! PR 38914 - this used to give an ICE due to missing +! simplification. +module foo + INTEGER, PARAMETER, DIMENSION(0:20,4) :: IP_ARRAY2_4_S = 0 + INTEGER, PARAMETER, DIMENSION(2) :: IP_ARRAY1_32_S = & + & (/ LBOUND(IP_ARRAY2_4_S(5:10,2:3))/) +END module foo +! { dg-final { cleanup-modules "foo" } } -- 2.7.4