From 7780fd2a1329454aab5d3cfd4b1bd77294fa5ace Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Wed, 24 Oct 2012 17:23:25 +0200 Subject: [PATCH] re PR fortran/55037 ([OOP] ICE with local allocatable variable of abstract type) 2012-10-24 Janus Weil PR fortran/55037 * trans-expr.c (gfc_conv_procedure_call): Move a piece of code and remove an assert. 2012-10-24 Janus Weil PR fortran/55037 * gfortran.dg/class_dummy_4.f03: New. From-SVN: r192768 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/trans-expr.c | 15 ++++--- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/class_dummy_4.f03 | 44 +++++++++++++++++++++ 4 files changed, 62 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_dummy_4.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 14f78d502af..25928e18c38 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-10-24 Janus Weil + + PR fortran/55037 + * trans-expr.c (gfc_conv_procedure_call): Move a piece of code and + remove an assert. + 2012-10-21 Tobias Burnus PR fortran/54725 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b4f9f260326..b0bd7f57004 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 8027bf4abcf..5d588ca590c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-10-24 Janus Weil + + PR fortran/55037 + * gfortran.dg/class_dummy_4.f03: New. + 2012-10-24 Jakub Jelinek 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 00000000000..fa302bf1ada --- /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 + +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" } }