diff options
-rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 2 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_50.f90 | 68 |
4 files changed, 82 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4d2768c..b8e7197 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,12 @@ 2018-07-02 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-07-02 Paul Thomas <pault@gcc.gnu.org> + PR fortran/45305 * expr.c : Add a prototype for scalarize_intrinsic_call. (gfc_simplify_expr): Use scalarize_intrinsic_call for elemental diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f0f5c1b..8133794 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -8842,7 +8842,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, break; case COPY_ALLOC_COMP: - if (c->attr.pointer) + if (c->attr.pointer || c->attr.proc_pointer) continue; /* We need source and destination components. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 196d7fe..7a27de4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,11 @@ 2018-07-02 Paul Thomas <pault@gcc.gnu.org> + PR fortran/82969 + PR fortran/86242 + * gfortran.dg/proc_ptr_50.f90: New test. + +2018-07-02 Paul Thomas <pault@gcc.gnu.org> + PR fortran/45305 * gfortran.dg/scalarize_parameter_array_2.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_50.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_50.f90 new file mode 100644 index 0000000..14f0c0a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/proc_ptr_50.f90 @@ -0,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 |