re PR fortran/56385 ([OOP] ICE with allocatable function result in a procedure-pointe...

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

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

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

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

From-SVN: r196227

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 00adaf87db92a240f84cd837204f2a8f8f3295be..c2a7a8b8ff0a017a5484d36b4a56cc5568669b51 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-02-22  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/56385
+       * trans-array.c (structure_alloc_comps): Handle procedure-pointer
+       components with allocatable result.
+
 2013-02-17  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 d3114798c6d7d678a9f550736f05fe3c10ed360a..4b701710f750dd20bc48d8f0fc77117b24f866ee 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7392,8 +7392,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
          called_dealloc_with_status = false;
          gfc_init_block (&tmpblock);
 
-         if (c->attr.allocatable
-             && (c->attr.dimension || c->attr.codimension))
+         if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension)
+             && !c->attr.proc_pointer)
            {
              comp = fold_build3_loc (input_location, COMPONENT_REF, ctype,
                                      decl, cdecl, NULL_TREE);
@@ -7575,7 +7575,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
              continue;
            }
 
-         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 5ea9e38d910b52e207bd3a867252dbe2c3c492f2..a9f84c41def7268b507eff02136bba671c49259e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-02-22  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/56385
+       * gfortran.dg/proc_ptr_comp_37.f90: New.
+
 2013-02-20  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        Backport from mainline:

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 (file)
index 0000000..9695b96
--- /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