[Patch, fortran] PR86242 [6/7/8/9 Regression] [OOP] ICE for derived type with allocatable component and proc-ptr component

[Patch, fortran] PR86242 [6/7/8/9 Regression] [OOP] ICE for derived type with allocatable component and proc-ptr component

[Paul Richard Thomas]

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

This patch is 'obvious' and I will commit to trunk tomorrow night if
there are no objections. The other branches will follow next week.

Bootstrapped and regtested on FC28/x86_64.

Cheers

Paul

2018-06-30  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/82969
    PR fortran/86242
    * trans-array.c (structure_alloc_comps): Do not explicitly copy
    procedure pointer components.

2018-06-30  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/82969
    PR fortran/86242
    * gfortran.dg/proc_ptr_50.f90: New test.

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

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 261974)
--- gcc/fortran/trans-array.c	(working copy)
*************** structure_alloc_comps (gfc_symbol * der_
*** 8842,8848 ****
  	  break;
  
  	case COPY_ALLOC_COMP:
! 	  if (c->attr.pointer)
  	    continue;
  
  	  /* We need source and destination components.  */
--- 8842,8848 ----
  	  break;
  
  	case COPY_ALLOC_COMP:
! 	  if (c->attr.pointer || c->attr.proc_pointer)
  	    continue;
  
  	  /* We need source and destination components.  */
Index: gcc/testsuite/gfortran.dg/proc_ptr_50.f90
===================================================================
*** gcc/testsuite/gfortran.dg/proc_ptr_50.f90	(nonexistent)
--- gcc/testsuite/gfortran.dg/proc_ptr_50.f90	(working copy)
***************
*** 0 ****
--- 1,68 ----
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR86242, in which the procedure pointer in 'tester'
+ ! was being copied as if it were an allocatable class component.
+ !
+ ! Contributed by <cfd@mnet-mail.de>
+ !
+ module test
+ 
+    implicit none
+ 
+    private
+    public :: tester
+ 
+    type :: wrapper
+       integer(4) :: n
+    end type wrapper
+ 
+    type :: output
+       real(8) :: dummy
+    end type output
+ 
+    type :: tester
+       class(wrapper),  allocatable :: wrap
+       procedure(proc1), pointer :: ptr => null()
+    end type tester
+ 
+    abstract interface
+       function proc1(self) result(uc)
+          import :: tester, output
+          class(tester), intent(in) :: self
+          class(output), allocatable :: uc
+       end function proc1
+    end interface
+ 
+ end module test
+ 
+ ! Comment #2 from Janus Weil  <janus@gcc.gnu.org>
+ module test1
+ 
+    implicit none
+ 
+    type :: output
+    end type
+ 
+    type :: tester
+       integer,  allocatable :: wrap
+       procedure(proc1), pointer, nopass :: ptr
+    end type
+ 
+    interface                              ! Originally abstract
+       function proc1() result(uc)
+          import :: output
+          class(output), allocatable :: uc ! Works if a pointer
+       end function
+    end interface
+ 
+ ! PR82969 from Gerhard Steinmetz  <gscfq@t-online.de>
+    type t
+       real, allocatable :: x(:)
+       procedure(f), nopass, pointer :: g
+    end type
+ contains
+    function f() result(z)
+       class(t), allocatable :: z
+    end
+ 
+ end module test1