Am 25.04.2015 um 20:12 schrieb Mikael Morin:
> I've double-checked in the standard, and it seems it is not possible to
> simplify after all:
>
> If ARRAY is a whole array and either ARRAY is an assumed-size
> array of rank DIM or dimension DIM of ARRAY has nonzero extent,
> LBOUND (ARRAY, DIM) has a value equal to the lower bound for
> subscript DIM of ARRAY. Otherwise the result value is 1.
>
> We can't tell whether the array is zero-sized, so we can't tell the
> lbound value.
So it is only possible to simplify LBOUND if the lower bound is
equal to one, both for assumed-shape and explicit-shape arrays...
OK.
The attached patch does that, including a test case which catches
that particular case.
> As you may want to simplify in the limited scope of the matmul inlining,
> I'm giving comments about the patch (otherwise you can ignore them):
> - No need to check for allocatable or pointer, it should be excluded by
> as->type == AS_ASSUMED_SHAPE (but does no harm either).
Actually, no. You can have assumed-shape allocatable or pointer
dummy arguments which keep their original lbound; see the subroutine
'bar' in the test case.
> - Please modify the early return condition:
> if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE
> || as->type == AS_ASSUMED_RANK))
> return NULL;
> and let the existing code do the simplification work.
That is not part of my patch.
> Or drop the lbound simplification idea, and fetch the lbound "by hand"
> at matmul inline time.
I will probably do so as a future optimization, but I think that most
people will see no reason for using different lower bounds, so it is
OK for the time being to (slightly) pessimize this case.
So... here is the new patch. OK for trunk?
Thomas
2015-04-25 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/37131
* simplify.c (simplify_bound): Get constant lower bounds of one
from array spec for assumed and explicit shape shape arrays if
the lower bounds are indeed one.
2015-04-25 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/37131
* gfortran.dg/coarray_lib_this_image_2.f90: Adjust
scan pattern.
* gfortran.dg/bound_9.f90: New test case.
P.S:
In an earlier version, I also added
Index: trans-array.c
===================================================================
--- trans-array.c (Revision 222431)
+++ trans-array.c (Arbeitskopie)
@@ -5693,6 +5693,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sy
to being zero size. */
tmp = fold_build2_loc (input_location, GE_EXPR, boolean_type_node,
stride, gfc_index_zero_node);
+ tmp = gfc_likely (tmp, PRED_FORTRAN_SIZE_ZERO);
tmp = fold_build3_loc (input_location, COND_EXPR,
gfc_array_index_type, tmp,
stride, gfc_index_zero_node);
but that caused the condition to always return true. I haven't figured
out why, but either I am misunderstanding something here, or gfc_likely
is buggy, or both.
Index: simplify.c
===================================================================
--- simplify.c (Revision 222431)
+++ simplify.c (Arbeitskopie)
@@ -3445,6 +3445,39 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gf
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))
return NULL;
! { dg-do run }
! { dg-options "-fdump-tree-original" }
! Check for different combinations of lbound for dummy arrays,
! stressing empty arrays. The assignments with "one =" should
! be simplified at compile time.
module tst
implicit none
contains
subroutine foo (a, b, one, m)
integer, dimension(:), intent(in) :: a
integer, dimension (-2:), intent(in) :: b
integer, intent(out) :: one, m
one = lbound(a,1)
m = lbound(b,1)
end subroutine foo
subroutine bar (a, b, n, m)
integer, dimension(:), allocatable, intent(inout) :: a
integer, dimension(:), pointer, intent(inout) :: b
integer, intent(out) :: n, m
n = lbound(a,1)
m = lbound(b,1)
end subroutine bar
subroutine baz (a, n, m, s)
integer, intent(in) :: n,m
integer, intent(out) :: s
integer, dimension(n:m) :: a
s = lbound(a,1)
end subroutine baz
subroutine qux (a, s, one)
integer, intent(in) :: s
integer, dimension(s) :: a
integer, intent(out) :: one
one = lbound(a,1)
end subroutine qux
end module tst
program main
use tst
implicit none
integer, dimension(3), target :: a, b
integer, dimension(0) :: empty
integer, dimension(:), allocatable :: x
integer, dimension(:), pointer :: y
integer :: n,m
call foo(a,b,n,m)
if (n .ne. 1 .or. m .ne. -2) call abort
call foo(a(2:0), empty, n, m)
if (n .ne. 1 .or. m .ne. 1) call abort
call foo(empty, a(2:0), n, m)
if (n .ne. 1 .or. m .ne. 1) call abort
allocate (x(0))
call bar (x, y, n, m)
if (n .ne. 1 .or. m .ne. 1) call abort
call baz(a,3,2,n)
if (n .ne. 1) call abort
call baz(a,2,3,n)
if (n .ne. 2) call abort
call qux(a, -3, n)
if (n .ne. 1) call abort
end program main
! { dg-final { scan-tree-dump-times "\\*one = 1" 2 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
