re PR fortran/55037 ([OOP] ICE with local allocatable variable of abstract type)

2012-10-24  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55037
	* trans-expr.c (gfc_conv_procedure_call): Move a piece of code and
	remove an assert.

2012-10-24  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/55037
	* gfortran.dg/class_dummy_4.f03: New.

From-SVN: r192768

4 files changed, 62 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 14f78d5..25928e1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-10-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55037
+	* trans-expr.c (gfc_conv_procedure_call): Move a piece of code and
+	remove an assert.
+
 2012-10-21  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/54725
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b4f9f26..b0bd7f5 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4180,13 +4180,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     CLASS_DATA (fsym)->attr.class_pointer
 				     || CLASS_DATA (fsym)->attr.allocatable);
 
-		  if (fsym && (fsym->ts.type == BT_DERIVED
-			       || fsym->ts.type == BT_ASSUMED)
-		      && e->ts.type == BT_CLASS
-		      && !CLASS_DATA (e)->attr.dimension
-		      && !CLASS_DATA (e)->attr.codimension)
-		    parmse.expr = gfc_class_data_get (parmse.expr);
-
 		  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is 
 		     allocated on entry, it must be deallocated.  */
 		  if (fsym && fsym->attr.intent == INTENT_OUT
@@ -4215,7 +4208,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      if (fsym->ts.type == BT_CLASS)
 			{
 			  gfc_symbol *vtab;
-			  gcc_assert (fsym->ts.u.derived == e->ts.u.derived);
 			  vtab = gfc_find_derived_vtab (fsym->ts.u.derived);
 			  tmp = gfc_get_symbol_decl (vtab);
 			  tmp = gfc_build_addr_expr (NULL_TREE, tmp);
@@ -4241,6 +4233,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      gfc_add_expr_to_block (&se->pre, tmp);
 		    }
 
+		  if (fsym && (fsym->ts.type == BT_DERIVED
+			       || fsym->ts.type == BT_ASSUMED)
+		      && e->ts.type == BT_CLASS
+		      && !CLASS_DATA (e)->attr.dimension
+		      && !CLASS_DATA (e)->attr.codimension)
+		    parmse.expr = gfc_class_data_get (parmse.expr);
+
 		  /* Wrap scalar variable in a descriptor. We need to convert
 		     the address of a pointer back to the pointer itself before,
 		     we can assign it to the data field.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8027bf4..5d588ca 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-10-24  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/55037
+	* gfortran.dg/class_dummy_4.f03: New.
+
 2012-10-24  Jakub Jelinek  <jakub@redhat.com>
 
 	PR rtl-optimization/55010
diff --git a/gcc/testsuite/gfortran.dg/class_dummy_4.f03 b/gcc/testsuite/gfortran.dg/class_dummy_4.f03
new file mode 100644
index 0000000..fa302bf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_dummy_4.f03
@@ -0,0 +1,44 @@
+! { dg-do compile }
+!
+! PR 55037: [4.8 Regression] [OOP] ICE with local allocatable variable of abstract type
+!
+! Contributed by <mrestelli@gmail.com>
+
+module m1
+ implicit none
+ type, abstract :: c_stv
+ contains
+  procedure, pass(x) :: source
+ end type c_stv
+contains
+ pure subroutine source(y,x)
+  class(c_stv), intent(in)               :: x
+  class(c_stv), allocatable, intent(out) :: y
+ end subroutine source
+end module m1
+
+module m2
+ use m1, only : c_stv
+ implicit none
+contains
+ subroutine sub(u0)
+  class(c_stv), intent(inout) :: u0
+  class(c_stv), allocatable :: tmp
+   call u0%source(tmp)
+ end subroutine sub
+end module m2 
+
+
+program p
+ implicit none
+ type :: c_stv
+ end type
+ class(c_stv), allocatable :: tmp
+ call source(tmp)
+contains
+ subroutine source(y)
+  type(c_stv), allocatable, intent(out) :: y
+ end subroutine
+end
+
+! { dg-final { cleanup-modules "m1 m2" } }