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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 14f78d502af00eb9c8ec0565221186981b872a39..25928e18c38dc48eb5fa8b5ec6eb11f5a8ab7a9b 100644 (file)
--- 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 b4f9f260326ee7b74531804ef627c90567fe34c1..b0bd7f57004a18ddec16fb1f67a9991516a846eb 100644 (file)
--- 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 8027bf4abcf3adc2d9d7a269121715879a443e3a..5d588ca590c4ed552be0281aca8e9e0cdde83ff7 100644 (file)
--- 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 (file)
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" } }