From 1af78e731feb9327a17c99ebaa19a4cca1125caf Mon Sep 17 00:00:00 2001 From: Sandra Loosemore Date: Tue, 19 Oct 2021 21:11:15 -0700 Subject: Fortran: Fixes and additional tests for shape/ubound/size [PR94070] This patch reimplements the SHAPE intrinsic to be inlined similarly to LBOUND and UBOUND, instead of as a library call, to avoid an unnecessary array copy. Various bugs are also fixed. gcc/fortran/ PR fortran/94070 * expr.c (gfc_simplify_expr): Handle GFC_ISYM_SHAPE along with GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. * trans-array.c (gfc_conv_ss_startstride): Likewise. (set_loop_bounds): Likewise. * trans-intrinsic.c (gfc_trans_intrinsic_bound): Extend to handle SHAPE. Correct logic for zero-size special cases and detecting assumed-rank arrays associated with an assumed-size argument. (gfc_conv_intrinsic_shape): Deleted. (gfc_conv_intrinsic_function): Handle GFC_ISYM_SHAPE like GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. (gfc_add_intrinsic_ss_code): Likewise. (gfc_walk_intrinsic_bound): Likewise. gcc/testsuite/ PR fortran/94070 * gfortran.dg/c-interop/shape-bindc.f90: New test. * gfortran.dg/c-interop/shape-poly.f90: New test. * gfortran.dg/c-interop/size-bindc.f90: New test. * gfortran.dg/c-interop/size-poly.f90: New test. * gfortran.dg/c-interop/ubound-bindc.f90: New test. * gfortran.dg/c-interop/ubound-poly.f90: New test. --- gcc/fortran/trans-array.c | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f8c087e..bceb8b2 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4507,6 +4507,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_ISYM_UBOUND: case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: + case GFC_ISYM_SHAPE: case GFC_ISYM_THIS_IMAGE: loop->dimen = ss->dimen; goto done; @@ -4558,12 +4559,14 @@ done: /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: + /* This is the variant without DIM=... */ + gcc_assert (expr->value.function.actual->next->expr == NULL); + /* Fall through. */ + + case GFC_ISYM_SHAPE: { 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) { @@ -5350,10 +5353,13 @@ set_loop_bounds (gfc_loopinfo *loop) 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); + if (expr->value.function.isym->id == GFC_ISYM_SHAPE) + gcc_assert (expr->value.function.actual->expr->rank == -1); + else + 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; -- cgit v1.1