FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/45507 (Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4))

Browse source 
2010-09-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45507
	* resolve.c (resolve_allocate_expr): Generate default initializers
	already at this point, resolve them and put them into expr3, ...
	* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
	translation stage.


2010-09-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/45507
	* gfortran.dg/allocate_alloc_opt_12.f90: New.

From-SVN: r163856
This commit is contained in:
Janus Weil 2010-09-04 11:29:11 +02:00
parent 502ef838c9
commit b6ff8128de
5 changed files with 77 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,3 +1,11 @@
2010-09-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/45507
* resolve.c (resolve_allocate_expr): Generate default initializers
already at this point, resolve them and put them into expr3, ...
* trans-stmt.c (gfc_trans_allocate): ... instead of waiting until
translation stage.
2010-09-03 Tobias Burnus <burnus@net-b.de>
PR fortran/45186

28
gcc/fortran/resolve.c
View file

@ -6714,6 +6714,34 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
goto failure;
}
if (!code->expr3)
{
/* Set up default initializer if needed. */
gfc_typespec ts;
if (code->ext.alloc.ts.type == BT_DERIVED)
ts = code->ext.alloc.ts;
else
ts = e->ts;
if (ts.type == BT_CLASS)
ts = ts.u.derived->components->ts;
if (ts.type == BT_DERIVED)
{
code->expr3 = gfc_default_initializer (&ts);
gfc_resolve_expr (code->expr3);
}
}
else if (code->expr3->mold && code->expr3->ts.type == BT_DERIVED)
{
/* Default initialization via MOLD (non-polymorphic). */
gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
gfc_resolve_expr (rhs);
gfc_free_expr (code->expr3);
code->expr3 = rhs;
}
if (e->ts.type == BT_CLASS)
{
/* Make sure the vtab symbol is present when

64
gcc/fortran/trans-stmt.c
View file

@ -4475,9 +4475,10 @@ gfc_trans_allocate (gfc_code * code)
tmp = gfc_finish_block (&se.pre);
gfc_add_expr_to_block (&block, tmp);
/* Initialization via SOURCE block. */
if (code->expr3 && !code->expr3->mold)
{
/* Initialization via SOURCE block
(or static default initializer). */
gfc_expr *rhs = gfc_copy_expr (code->expr3);
if (al->expr->ts.type == BT_CLASS)
{
@ -4497,53 +4498,22 @@ gfc_trans_allocate (gfc_code * code)
gfc_free_expr (rhs);
gfc_add_expr_to_block (&block, tmp);
}
else
else if (code->expr3 && code->expr3->mold
&& code->expr3->ts.type == BT_CLASS)
{
/* Add default initializer for those derived types that need them. */
gfc_expr *rhs = NULL;
gfc_typespec ts;
if (code->ext.alloc.ts.type == BT_DERIVED)
ts = code->ext.alloc.ts;
else if (code->expr3)
ts = code->expr3->ts;
else
ts = expr->ts;
if (ts.type == BT_DERIVED)
{
rhs = gfc_default_initializer (&ts);
gfc_resolve_expr (rhs);
}
else if (ts.type == BT_CLASS)
{
rhs = gfc_copy_expr (code->expr3);
gfc_add_component_ref (rhs, "$vptr");
gfc_add_component_ref (rhs, "$def_init");
}
if (rhs)
{
gfc_expr *lhs = gfc_expr_to_initialize (expr);
if (al->expr->ts.type == BT_DERIVED)
{
tmp = gfc_trans_assignment (lhs, rhs, true, false);
gfc_add_expr_to_block (&block, tmp);
}
else if (al->expr->ts.type == BT_CLASS)
{
gfc_se dst,src;
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_conv_expr (&dst, lhs);
gfc_conv_expr (&src, rhs);
gfc_add_block_to_block (&block, &src.pre);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
gfc_add_expr_to_block (&block, tmp);
}
gfc_free_expr (lhs);
gfc_free_expr (rhs);
}
/* Default-initialization via MOLD (polymorphic). */
gfc_expr *rhs = gfc_copy_expr (code->expr3);
gfc_se dst,src;
gfc_add_component_ref (rhs, "$vptr");
gfc_add_component_ref (rhs, "$def_init");
gfc_init_se (&dst, NULL);
gfc_init_se (&src, NULL);
gfc_conv_expr (&dst, expr);
gfc_conv_expr (&src, rhs);
gfc_add_block_to_block (&block, &src.pre);
tmp = gfc_build_memcpy_call (dst.expr, src.expr, memsz);
gfc_add_expr_to_block (&block, tmp);
gfc_free_expr (rhs);
}
/* Allocation of CLASS entities. */

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2010-09-04 Janus Weil <janus@gcc.gnu.org>
PR fortran/45507
* gfortran.dg/allocate_alloc_opt_12.f90: New.
2010-09-03 Joseph Myers <joseph@codesourcery.com>
* gcc.dg/opts-4.c: New test.

19
gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 Normal file
View file

@ -0,0 +1,19 @@
! { dg-do compile }
!
! PR 45507: [4.6 Regression] Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4)
!
! Contributed by Andrew Benson <abenson@its.caltech.edu>
use, intrinsic :: iso_c_binding
type :: cType
type(c_ptr) :: accelPtr = c_null_ptr
end type cType
type(cType), allocatable, dimension(:) :: filters
class(cType), allocatable :: f
allocate(filters(1))
allocate(f,MOLD=filters(1))
end