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 <[email protected]>
PR fortran/68560
* trans-intrinsic.c (gfc_conv_intrinsic_shape): New function.
(gfc_conv_intrinsic_function): Call it.
2018-02-01 Thomas Koenig <[email protected]>
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
