OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Janus Weil 2012-10-24 17:23:25 +02:00
parent c2d9083df2
commit 7780fd2a13
4 changed files with 62 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

15
gcc/fortran/trans-expr.c
View File

@ -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. */

5
gcc/testsuite/ChangeLog
View File

@ -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

44
gcc/testsuite/gfortran.dg/class_dummy_4.f03 Normal file
View File

@ -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" } }