This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Fix PR 68560
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: "fortran at gcc dot gnu dot org" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 1 Feb 2018 20:41:02 +0100
- Subject: [patch, fortran] Fix PR 68560
- Authentication-results: sourceware.org; auth=none
Hello world,
this patch fixes a regression by removing a KIND argument
(which is encoded into the function name anyway) from the
call to the library function. This extra argument led to
an argument mismatch between the front end and the library
and between different instances of the same function.
Regression-testing as I write this. If it passes
(which I expect), 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 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;
! { 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