| Message ID | 97d52e14-12e3-d02f-0918-7483927150af@netcologne.de |
|---|---|
| State | New |
| Headers | show |
| Series | [fortran] Fix PR 68560 | expand |
Here's an update on the patch - I realized that it is not necessary to check for the actual argument, it is always present. OK for trunk? Regards Thomas > > 2018-02-01 Thomas Koenig <tkoenig@gcc.gnu.org> > > PR fortran/68560 > * trans-intrinsic.c (gfc_conv_intrinsic_shape): New function. > (gfc_conv_intrinsic_function): Call it. > > 2018-02-01 Thomas Koenig <tkoenig@gcc.gnu.org> > > PR fortran/68560 > * gfortran.dg/shape_9.f90: New test. Index: trans-intrinsic.c =================================================================== --- trans-intrinsic.c (Revision 257347) +++ trans-intrinsic.c (Arbeitskopie) @@ -5593,6 +5593,22 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * } static void +gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) +{ + gfc_actual_arglist *s, *k; + gfc_expr *e; + + /* Remove the KIND argument, if present. */ + s = expr->value.function.actual; + k = s->next; + e = k->expr; + gfc_free_expr (e); + k->expr = NULL; + + gfc_conv_intrinsic_funcall (se, expr); +} + +static void gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift, bool arithmetic) { @@ -8718,6 +8734,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr gfc_conv_intrinsic_minmaxloc (se, expr, GT_EXPR); break; + case GFC_ISYM_SHAPE: + gfc_conv_intrinsic_shape (se, expr); + break; + default: gfc_conv_intrinsic_funcall (se, expr); break; ! { dg-do run } ! { dg-require-effective-target lto } ! { dg-options "-flto" } ! Check that there are no warnings with LTO for a KIND argument. ! program test implicit none real, allocatable :: x(:,:) allocate(x(2,5)) if (any(shape(x) /= [ 2, 5 ])) call abort if (any(shape(x,kind=1) /= [ 2, 5 ])) call abort if (any(shape(x,kind=2) /= [ 2, 5 ])) call abort if (any(shape(x,kind=4) /= [ 2, 5 ])) call abort if (any(shape(x,kind=8) /= [ 2, 5 ])) call abort end program test
On Wed, Feb 07, 2018 at 09:42:04PM +0100, Thomas Koenig wrote: > Here's an update on the patch - I realized that it is not necessary > to check for the actual argument, it is always present. > > OK for trunk? > Yes.
Index: trans-intrinsic.c =================================================================== --- trans-intrinsic.c (Revision 257131) +++ trans-intrinsic.c (Arbeitskopie) @@ -5593,6 +5593,25 @@ gfc_conv_intrinsic_ibits (gfc_se * se, gfc_expr * } static void +gfc_conv_intrinsic_shape (gfc_se *se, gfc_expr *expr) +{ + gfc_actual_arglist *s, *k; + gfc_expr *e; + + /* Remove the KIND argument, if present. */ + s = expr->value.function.actual; + k = s->next; + if (k) + { + e = k->expr; + gfc_free_expr (e); + k->expr = NULL; + } + + gfc_conv_intrinsic_funcall (se, expr); +} + +static void gfc_conv_intrinsic_shift (gfc_se * se, gfc_expr * expr, bool right_shift, bool arithmetic) { @@ -8718,6 +8737,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr gfc_conv_intrinsic_minmaxloc (se, expr, GT_EXPR); break; + case GFC_ISYM_SHAPE: + gfc_conv_intrinsic_shape (se, expr); + break; + default: gfc_conv_intrinsic_funcall (se, expr); break;