diff options
author | mikael <mikael@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-08-02 19:48:50 +0000 |
---|---|---|
committer | mikael <mikael@138bc75d-0d04-0410-961f-82ee72b054a4> | 2012-08-02 19:48:50 +0000 |
commit | 495b772b61debc16d8b0587787e8ecbdf4ebe2b3 (patch) | |
tree | 5d2a87b55e2491858ef9c60a627013cbfe35796c /gcc/fortran/trans-array.c | |
parent | d2116dba8cb5f0c3bd06c41c97a4f6e094a0372f (diff) | |
download | gcc-495b772b61debc16d8b0587787e8ecbdf4ebe2b3.tar.gz |
fortran/
PR fortran/48820
* trans-array.c (gfc_conv_ss_startstride): Set the intrinsic
result's lower and upper bounds according to the rank.
(set_loop_bounds): Set the loop upper bound in the intrinsic case.
testsuite/
PR fortran/48820
* gfortran.dg/assumed_rank_bounds_1.f90: New test.
* gfortran.dg/assumed_rank_bounds_2.f90: New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@190098 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/trans-array.c')
-rw-r--r-- | gcc/fortran/trans-array.c | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b799e241163..187eab01b00 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3808,6 +3808,40 @@ done: /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: + { + gfc_expr *arg; + + /* This is the variant without DIM=... */ + gcc_assert (expr->value.function.actual->next->expr == NULL); + + arg = expr->value.function.actual->expr; + if (arg->rank == -1) + { + gfc_se se; + tree rank, tmp; + + /* The rank (hence the return value's shape) is unknown, + we have to retrieve it. */ + gfc_init_se (&se, NULL); + se.descriptor_only = 1; + gfc_conv_expr (&se, arg); + /* This is a bare variable, so there is no preliminary + or cleanup code. */ + gcc_assert (se.pre.head == NULL_TREE + && se.post.head == NULL_TREE); + rank = gfc_conv_descriptor_rank (se.expr); + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + fold_convert (gfc_array_index_type, + rank), + gfc_index_one_node); + info->end[0] = gfc_evaluate_now (tmp, &loop->pre); + info->start[0] = gfc_index_zero_node; + info->stride[0] = gfc_index_one_node; + continue; + } + /* Otherwise fall through GFC_SS_FUNCTION. */ + } case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_THIS_IMAGE: @@ -4526,6 +4560,20 @@ set_loop_bounds (gfc_loopinfo *loop) gcc_assert (loop->to[n] == NULL_TREE); break; + case GFC_SS_INTRINSIC: + { + gfc_expr *expr = loopspec[n]->info->expr; + + /* The {l,u}bound of an assumed rank. */ + gcc_assert ((expr->value.function.isym->id == GFC_ISYM_LBOUND + || expr->value.function.isym->id == GFC_ISYM_UBOUND) + && expr->value.function.actual->next->expr == NULL + && expr->value.function.actual->expr->rank == -1); + + loop->to[n] = info->end[dim]; + break; + } + default: gcc_unreachable (); } |