------- Comment #11 from paulthomas2 at wanadoo dot fr 2006-10-12 15:57 -------
Subject: Re: LBOUND(TRANSPOSE(I)) doesn't work
FX
! if (upper)
! {
! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound);
! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound);
! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride,
! gfc_index_zero_node);
!
! cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3,
cond1);
! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond2);
!
! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! ubound, gfc_index_zero_node);
! }
! else
! {
! tree cond1, cond2, cond3;
Repeated declaration
!
! if (as->type == AS_ASSUMED_SIZE)
! cond = fold_build2 (EQ_EXPR, boolean_type_node, bound,
! build_int_cst (TREE_TYPE (bound),
! arg->expr->rank));
! else
! cond = boolean_false_node;
!
! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound);
! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound);
! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride,
! gfc_index_zero_node);
Same assignment for upper and lower - put it before the if
! cond1 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3,
cond1);
! cond1 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond1,
cond2);
!
! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond1);
!
! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! lbound, gfc_index_one_node);
! }
I have tested the above corrections, verified the logic and regtested
the patch right now. My version of the diff is attached. I added a
comment that consists of the appropriate extracts from the standard.
gfortran and ifort now agree on the testcase in #1, whilst g95 differs
on the last line.
With an appropriate testcase and ChangeLog entries, this is OK for trunk.
Paul
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 117628)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_intrinsic_bound (gfc_se * se, g
*** 710,718 ****
tree type;
tree bound;
tree tmp;
! tree cond;
gfc_se argse;
gfc_ss *ss;
int i;
arg = expr->value.function.actual;
--- 710,722 ----
tree type;
tree bound;
tree tmp;
! tree cond, cond1, cond2, cond3, size;
! tree ubound;
! tree lbound;
gfc_se argse;
gfc_ss *ss;
+ gfc_array_spec * as;
+ gfc_ref *ref;
int i;
arg = expr->value.function.actual;
*************** gfc_conv_intrinsic_bound (gfc_se * se, g
*** 773,782 ****
}
}
! if (upper)
! se->expr = gfc_conv_descriptor_ubound(desc, bound);
else
! se->expr = gfc_conv_descriptor_lbound(desc, bound);
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, se->expr);
--- 777,883 ----
}
}
! ubound = gfc_conv_descriptor_ubound (desc, bound);
! lbound = gfc_conv_descriptor_lbound (desc, bound);
!
! /* Follow any component references. */
! if (arg->expr->expr_type == EXPR_VARIABLE
! || arg->expr->expr_type == EXPR_CONSTANT)
! {
! as = arg->expr->symtree->n.sym->as;
! for (ref = arg->expr->ref; ref; ref = ref->next)
! {
! switch (ref->type)
! {
! case REF_COMPONENT:
! as = ref->u.c.component->as;
! continue;
!
! case REF_SUBSTRING:
! continue;
!
! case REF_ARRAY:
! {
! switch (ref->u.ar.type)
! {
! case AR_ELEMENT:
! case AR_SECTION:
! case AR_UNKNOWN:
! as = NULL;
! continue;
!
! case AR_FULL:
! break;
! }
! }
! }
! }
! }
! else
! as = NULL;
!
! /* 13.14.53: Result value for LBOUND
! Case (i): For an array section or for an array expression other than a
whole
! array or array structure component, LBOUND(ARRAY, DIM) has the value 1.
For a
! whole array or array structure component, LBOUND(ARRAY, DIM) has the
value:
! (a) equal to the lower bound for subscript DIM of ARRAY if dimension DIM
of
! does not have extent zero or if ARRAY is an assumed-size array of rank
! DIM, or
! (b) 1 otherwise......
!
! 13.14.113: Result value for UBOUND
! Case (i): For an array section or for an array expression other than a
whole
! array or array structure component, UBOUND(ARRAY, DIM) has the value
equal
! to the number of elements in the given dimension; otherwise, it has a
value
! equal to the upper bound for subscript DIM of ARRAY if dimension DIM of
! ARRAY does not have size zero and has value zero if dimension DIM has
size
! zero. */
!
! if (as)
! {
! tree stride = gfc_conv_descriptor_stride (desc, bound);
! cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound);
! cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound);
! cond3 = fold_build2 (GT_EXPR, boolean_type_node, stride,
! gfc_index_zero_node);
!
! if (upper)
! {
! cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1);
! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond2);
!
! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! ubound, gfc_index_zero_node);
! }
! else
! {
! if (as->type == AS_ASSUMED_SIZE)
! cond = fold_build2 (EQ_EXPR, boolean_type_node, bound,
! build_int_cst (TREE_TYPE (bound),
! arg->expr->rank));
! else
! cond = boolean_false_node;
!
! cond1 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3,
cond1);
! cond1 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond1, cond2);
!
! cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond1);
!
! se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
! lbound, gfc_index_one_node);
! }
! }
else
! {
! if (upper)
! {
! size = fold_build2 (MINUS_EXPR, gfc_array_index_type, ubound,
lbound);
! se->expr = fold_build2 (PLUS_EXPR, gfc_array_index_type, size,
! gfc_index_one_node);
! }
! else
! se->expr = gfc_index_one_node;
! }
type = gfc_typenode_for_spec (&expr->ts);
se->expr = convert (type, se->expr);
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=29391
