[patch, fortran] Fix PR 68560

[patch, fortran] Fix PR 68560

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 681 bytes --]

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.

[-- Attachment #2: p1.diff --]
[-- Type: text/x-patch, Size: 1037 bytes --]

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;

[-- Attachment #3: shape_9.f90 --]
[-- Type: text/x-fortran, Size: 500 bytes --]

! { 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

Re: [patch, fortran] Fix PR 68560

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 553 bytes --]

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.


[-- Attachment #2: p2.diff --]
[-- Type: text/x-patch, Size: 1001 bytes --]

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;

[-- Attachment #3: shape_9.f90 --]
[-- Type: text/x-fortran, Size: 500 bytes --]

! { 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

Re: [patch, fortran] Fix PR 68560

[Steve Kargl]

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.

-- 
Steve