re PR fortran/47565 ([OOP] Segfault with TBP)

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.

From-SVN: r169480

gcc/fortran/ChangeLog

+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

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)

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/typebound_call_20.f03

+! { 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" } }