diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-09-04 11:29:11 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-09-04 11:29:11 +0200 |
| commit | b6ff8128de0583a91126718e81c48320aad243ce (patch) | |
| tree | d729152a99901da881cd9e9f83314edc3ea3beb4 /gcc/fortran/trans-stmt.c | |
| parent | 502ef838c9c03499ccc8f55e0ff86f19c0f66119 (diff) | |
| download | gcc-b6ff8128de0583a91126718e81c48320aad243ce.zip gcc-b6ff8128de0583a91126718e81c48320aad243ce.tar.gz gcc-b6ff8128de0583a91126718e81c48320aad243ce.tar.bz2 | |
re PR fortran/45507 (Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4))
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
Diffstat (limited to 'gcc/fortran/trans-stmt.c')
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 64 |
1 files changed, 17 insertions, 47 deletions
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 29b3322..dda38b6 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -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. */ |