From: Janus Weil <janus@gcc.gnu.org>
Date: Sat, 23 Feb 2013 14:40:49 +0000 (+0100)
Subject: re PR fortran/56385 ([OOP] ICE with allocatable function result in a procedure-pointe... 
X-Git-Tag: releases/gcc-4.6.4~131
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e4644a99da919ae0e276b922688dce69d58c4f3e;p=thirdparty%2Fgcc.git

re PR fortran/56385 ([OOP] ICE with allocatable function result in a procedure-pointer component)

2013-02-23  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56385
	* trans-array.c (structure_alloc_comps): Handle procedure-pointer
	components with allocatable result.

2013-02-23  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56385
	* gfortran.dg/proc_ptr_comp_37.f90: New.

From-SVN: r196237
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 417106ef4486..72af533d760d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-02-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56385
+	* trans-array.c (structure_alloc_comps): Handle procedure-pointer
+	components with allocatable result.
+
 2013-02-15  Tobias Burnus  <burnus@net-b.de>
 	    Mikael Morin  <mikael@gcc.gnu.org>
 
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c3e993415ce9..c76cd115cb0a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6560,7 +6560,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 	      gfc_add_expr_to_block (&fnblock, tmp);
 	    }
 
-	  if (c->attr.allocatable && c->attr.dimension)
+	  if (c->attr.allocatable && c->attr.dimension && !c->attr.proc_pointer)
 	    {
 	      comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
 				      decl, cdecl, NULL_TREE);
@@ -6659,7 +6659,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 				  cdecl, NULL_TREE);
 	  dcmp = fold_convert (TREE_TYPE (comp), dcmp);
 
-	  if (c->attr.allocatable && !cmp_has_alloc_comps)
+	  if (c->attr.allocatable && !c->attr.proc_pointer
+	      && !cmp_has_alloc_comps)
 	    {
 	      rank = c->as ? c->as->rank : 0;
 	      tmp = gfc_duplicate_allocatable (dcmp, comp, ctype, rank);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7e7942dc424d..d4aef859ef91 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-02-23  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56385
+	* gfortran.dg/proc_ptr_comp_37.f90: New.
+
 2013-02-15  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/56318
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90
new file mode 100644
index 000000000000..9695b96066cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_37.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! PR 56385: [4.6/4.7/4.8 Regression] [OOP] ICE with allocatable function result in a procedure-pointer component
+!
+! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
+
+  implicit none
+  
+  type :: TGeometricShape
+  end type
+
+  type :: TVolumeSourceBody
+    class(TGeometricShape), allocatable :: GeometricShape
+    procedure(scalar_flux_interface), pointer :: get_scalar_flux
+  end type
+
+  abstract interface
+    function scalar_flux_interface(self) result(res)
+      import
+      real, allocatable :: res(:)
+      class(TVolumeSourceBody), intent(in) :: self
+    end function
+  end interface
+
+end