Hello,
Le 30/04/2015 20:19, Mikael Morin a écrit :
>>> 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.
>>
> I'm not sure I expressed what I was asking for clearly enough.
> Anyway, I may as well submit the requested changes myself.
>
I present here the announced above follow-up change to Thomas' recent
bound simplification patch.
It basically removes the code added and tighten the condition
mentioned above, so that we don't give up too early to simplify the
lbound of an assumed shape array, and let the existing code do the
simplification.
To not regression wrt to Thomas work, I had to also adjust early
give-ups in simplify_bound_dim.
But the code has been reorganized, so that it doesn't appear clearly.
The declared bound and empty bound value have been abstracted
from the differentiated lbound/ubound specifics. Then the
simplification is applied indifferently on those abstractions.
Finally, the empty array tricks have been disabled for the CO{L,U}BOUND
intrinsics.
With these changes, Thomas' tests continue to work and one gets DIM-less
bound simplification "for free".
The testsuite adds tests for zero sized arrays and DIM-less {L,U}BOUND
calls.
I had to remove the check for absence of string "bound" in the dump:
there is code generated for assumed shape arrays that plays tricks with
bounds and contains that string, even if the code generated for the body
itself of the procedure is empty.
Regression tested on x86_64-unknown-linux-gnu. OK for trunk?
Mikael
2015-05-01 Mikael Morin <mik...@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-01 Mikael Morin <mik...@gcc.gnu.org>
* gfortran.dg/bound_simplification_4.f90: Disable implicit typing.
Add checks for bound simplification without DIM argument.
Add checks for empty array and assumed shape bound simplification.
Remove check for absence of string "bound" in the dump.
Index: fortran/simplify.c
===================================================================
--- fortran/simplify.c (révision 222681)
+++ fortran/simplify.c (copie de travail)
@@ -3340,29 +3340,43 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kin
/* 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, 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 (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_RANK
+ || (as->type == AS_ASSUMED_SHAPE && upper)))
+ return NULL;
- 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;
+ gcc_assert (!as
+ || (as->type != AS_DEFERRED
+ && array->expr_type == EXPR_VARIABLE
+ && !array->symtree->n.sym->attr.allocatable
+ && !array->symtree->n.sym->attr.pointer));
- 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;
-
if (dim == NULL)
{
/* Multi-dimensional bounds. */
Index: testsuite/gfortran.dg/bound_simplification_4.f90
===================================================================
--- testsuite/gfortran.dg/bound_simplification_4.f90 (révision 222681)
+++ testsuite/gfortran.dg/bound_simplification_4.f90 (copie de travail)
@@ -3,6 +3,8 @@
!
! Check that {L,U}{,CO}BOUND intrinsics are properly simplified.
!
+ implicit none
+
type :: t
integer :: c
end type t
@@ -9,11 +11,13 @@
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 (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
@@ -24,7 +28,48 @@
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 "bound" "original" } }
! { dg-final { scan-tree-dump-not "abort" "original" } }
! { dg-final { cleanup-tree-dump "original" } }
