From b6ff8128de0583a91126718e81c48320aad243ce Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sat, 4 Sep 2010 11:29:11 +0200 Subject: [PATCH] re PR fortran/45507 (Bogus Error: Can't convert TYPE(c_ptr) to INTEGER(4)) 2010-09-04 Janus Weil 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 PR fortran/45507 * gfortran.dg/allocate_alloc_opt_12.f90: New. From-SVN: r163856 --- gcc/fortran/ChangeLog | 8 +++ gcc/fortran/resolve.c | 28 ++++++++ gcc/fortran/trans-stmt.c | 64 +++++-------------- gcc/testsuite/ChangeLog | 5 ++ .../gfortran.dg/allocate_alloc_opt_12.f90 | 19 ++++++ 5 files changed, 77 insertions(+), 47 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 517ca841f0e..428cd3f25cf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2010-09-04 Janus Weil + + 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 PR fortran/45186 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 88f43cdfcbf..9099ada8f51 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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 diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 29b33228058..dda38b6503e 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. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9834ddd02f8..52dd4e875ed 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-09-04 Janus Weil + + PR fortran/45507 + * gfortran.dg/allocate_alloc_opt_12.f90: New. + 2010-09-03 Joseph Myers * gcc.dg/opts-4.c: New test. diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 new file mode 100644 index 00000000000..2af06929353 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_12.f90 @@ -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 + + 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 -- 2.30.2