This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] PR86242 [6/7/8/9 Regression] [OOP] ICE for derived type with allocatable component and proc-ptr component
- From: Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>
- 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: Sat, 30 Jun 2018 16:32:18 +0100
- Subject: [Patch, fortran] PR86242 [6/7/8/9 Regression] [OOP] ICE for derived type with allocatable component and proc-ptr component
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.
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