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-02-01  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47565
	* gfortran.dg/typebound_call_20.f03: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@169480 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e05645d..bb1d89e 100644 (file)
--- 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 b5b6d61..57bdb5d 100644 (file)
--- 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 d047f87..8773238 100644 (file)
--- 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 (file)
index 0000000..61eee5b
--- /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" } }