diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e05645d14afcd9e365a48f8a094925f802845924..bb1d89e49fc50dd6246844d4cafe4ff06b9dda7d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-02-01 Janus Weil <janus@gcc.gnu.org> + + PR fortran/47565 + * trans-expr.c (gfc_conv_structure): Handle constructors for procedure + pointer components with allocatable result. + 2011-01-31 Janus Weil <janus@gcc.gnu.org> PR fortran/47455 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b5b6d614984878210ffdaebb4c810c40bc4356dc..57bdb5d23188d377112d2afc7c7c5ae65dc45537 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4627,7 +4627,7 @@ gfc_conv_structure (gfc_se * se, gfc_expr * expr, int init) components. Although the latter have a default initializer of EXPR_NULL,... by default, the static nullify is not needed since this is done every time we come into scope. */ - if (!c->expr || cm->attr.allocatable) + if (!c->expr || (cm->attr.allocatable && cm->attr.flavor != FL_PROCEDURE)) continue; if (strcmp (cm->name, "_size") == 0) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d047f874911388fb24a204f309d656f844519e98..8773238cda392a86945b07c7a72e823e28533bae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-02-01 Janus Weil <janus@gcc.gnu.org> + + PR fortran/47565 + * gfortran.dg/typebound_call_20.f03: New. + 2011-02-01 Richard Guenther <rguenther@suse.de> PR tree-optimization/47555 diff --git a/gcc/testsuite/gfortran.dg/typebound_call_20.f03 b/gcc/testsuite/gfortran.dg/typebound_call_20.f03 new file mode 100644 index 0000000000000000000000000000000000000000..61eee5ba004d98f39fee99ec07e0752a06caff7c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/typebound_call_20.f03 @@ -0,0 +1,41 @@ +! { dg-do run } +! +! PR 47565: [4.6 Regression][OOP] Segfault with TBP +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> + +module class_t + type :: t + procedure(find_y), pointer, nopass :: ppc + contains + procedure, nopass :: find_y + end type + integer, private :: count = 0 +contains + function find_y() result(res) + integer, allocatable :: res + allocate(res) + count = count + 1 + res = count + end function +end module + +program p + use class_t + class(t), allocatable :: this + integer :: y + + allocate(this) + this%ppc => find_y + ! (1) ordinary procedure + y = find_y() + if (y/=1) call abort() + ! (2) procedure pointer component + y = this%ppc() + if (y/=2) call abort() + ! (3) type-bound procedure + y = this%find_y() + if (y/=3) call abort() +end + +! { dg-final { cleanup-modules "class_t" } }