The attached patch fixes an ICE-on-invalid code when the TRANSFER
intrinsic is being handed procedures to the SOURCE or MOLD arguments.
My reading of the standard suggests that this is not allowed:

  SOURCE shall be a scalar or array of any type.

  MOLD shall be a scalar or array of any type. ...

I was struggling for some moment with the idea that SOURCE could be
a procedure pointer (technically), but finally dismissed it.
The patch thus rejects procedures as arguments.

Regtests cleanly on x86_64-pc-linux-gnu.

OK for trunk?

Harald

2019-03-17  Harald Anlauf  <anl...@gmx.de>

        PR fortran/85797
        * check.c (gfc_check_transfer): Reject procedures as actual
        arguments for SOURCE and MOLD of TRANSFER intrinsic.

2019-03-17  Harald Anlauf  <anl...@gmx.de>

        PR fortran/85797
        * gfortran.dg/pr85797.f90: New test.

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (revision 269717)
+++ gcc/fortran/check.c (working copy)
@@ -5544,6 +5544,24 @@
   size_t source_size;
   size_t result_size;
 
+  /* SOURCE shall be a scalar or array of any type.  */
+  if (source->ts.type == BT_PROCEDURE)
+    {
+      gfc_error ("%<SOURCE%> argument of %<TRANSFER%> intrinsic at %L "
+                 "must not be a %s", &source->where,
+                gfc_basic_typename (source->ts.type));
+      return false;
+    }
+
+  /* MOLD shall be a scalar or array of any type.  */
+  if (mold->ts.type == BT_PROCEDURE)
+    {
+      gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L "
+                 "must not be a %s", &mold->where,
+                gfc_basic_typename (mold->ts.type));
+      return false;
+    }
+
   if (mold->ts.type == BT_HOLLERITH)
     {
       gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L must not 
be"
@@ -5551,6 +5569,8 @@
       return false;
     }
 
+  /* SIZE (optional) shall be an integer scalar.  The corresponding actual
+     argument shall not be an optional dummy argument.  */
   if (size != NULL)
     {
       if (!type_check (size, 2, BT_INTEGER))
Index: gcc/testsuite/gfortran.dg/pr85797.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr85797.f90       (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr85797.f90       (working copy)
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! PR fortran/85797 - ICE in gfc_element_size, at fortran/target-memory.c:126
+! Derived from original test cases by Gerhard Steinmetz
+
+module test
+contains
+  function f ()
+    f = 1.
+  end function f
+  subroutine sub ()
+  end subroutine sub
+  recursive subroutine a ()
+    integer(8) :: p
+    procedure(sub), pointer :: x => sub
+    p = transfer (sub, p)     ! { dg-error "must not be a PROCEDURE" }
+    p = transfer (p, sub)     ! { dg-error "must not be a PROCEDURE" }
+    p = transfer (f, p)       ! { dg-error "must not be a PROCEDURE" }
+    p = transfer (p, f)       ! { dg-error "must not be a PROCEDURE" }
+    c = transfer (a, b)       ! { dg-error "must not be a PROCEDURE" }
+    print *, transfer (x, x)  ! { dg-error "must not be a PROCEDURE" }
+  end subroutine a
+end module test

Reply via email to