diff options
| author | Francois-Xavier Coudert <coudert@clipper.ens.fr> | 2006-11-16 13:25:11 +0100 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2006-11-16 12:25:11 +0000 |
| commit | 9f1dce5609ca54d2caa87d0ecfece64a7bb58c81 (patch) | |
| tree | f14cc63483c17ad4c8e486eae4a98c3d88d24e41 /gcc/fortran/trans-intrinsic.c | |
| parent | 6c0e51c4fad90d1a93040fe92695890b5715d6f5 (diff) | |
| download | gcc-9f1dce5609ca54d2caa87d0ecfece64a7bb58c81.zip gcc-9f1dce5609ca54d2caa87d0ecfece64a7bb58c81.tar.gz gcc-9f1dce5609ca54d2caa87d0ecfece64a7bb58c81.tar.bz2 | |
re PR fortran/29391 ([4.2/4.1 only] LBOUND and UBOUND are broken)
PR fortran/29391
PR fortran/29489
* simplify.c (simplify_bound): Fix the simplification of
LBOUND/UBOUND intrinsics.
* trans-intrinsic.c (simplify_bound): Fix the logic, and
remove an erroneous assert.
* gcc/testsuite/gfortran.dg/bound_2.f90: Add more checks.
* gcc/testsuite/gfortran.dg/bound_3.f90: New test.
From-SVN: r118888
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 32 |
1 files changed, 20 insertions, 12 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index ec857a53..5facd5b 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -712,14 +712,13 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) tree type; tree bound; tree tmp; - tree cond, cond1, cond2, cond3, size; + tree cond, cond1, cond2, cond3, cond4, 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; arg2 = arg->next; @@ -761,9 +760,14 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) if (INTEGER_CST_P (bound)) { - gcc_assert (TREE_INT_CST_HIGH (bound) == 0); - i = TREE_INT_CST_LOW (bound); - gcc_assert (i >= 0 && i < GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))); + int hi, low; + + hi = TREE_INT_CST_HIGH (bound); + low = TREE_INT_CST_LOW (bound); + if (hi || low < 0 || low >= GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))) + gfc_error ("'dim' argument of %s intrinsic at %L is not a valid " + "dimension index", upper ? "UBOUND" : "LBOUND", + &expr->where); } else { @@ -842,15 +846,21 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) 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, + + cond3 = fold_build2 (GE_EXPR, boolean_type_node, stride, gfc_index_zero_node); + cond3 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); + + cond4 = fold_build2 (LT_EXPR, boolean_type_node, stride, + gfc_index_zero_node); + cond4 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond4, cond2); if (upper) { - cond = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond3, cond1); - cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond2); + cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond3, cond4); se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, ubound, gfc_index_zero_node); @@ -860,13 +870,11 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) if (as->type == AS_ASSUMED_SIZE) cond = fold_build2 (EQ_EXPR, boolean_type_node, bound, build_int_cst (TREE_TYPE (bound), - arg->expr->rank)); + arg->expr->rank - 1)); 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); - + cond1 = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond3, cond4); cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond1); se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond, |