diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.c | 21 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 38 |
3 files changed, 49 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 960a6e8..3c7b4f4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-12-18 Tobias Burnus <burnus@net-b.de> + + PR fortran/46974 + * target-memory.c (gfc_interpret_derived): Handle C_PTR/C_FUNPTR. + * trans-expr.c (gfc_trans_structure_assign): Ditto. + (gfc_conv_expr): Avoid crashes using non-C_NULL_(FUN)PTR const expr. + 2010-12-17 Janus Weil <janus@gcc.gnu.org> Tobias Burnus <burnus@gcc.gnu.org> diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c index 01383c7..0a09f5a 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.c @@ -442,9 +442,27 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu /* The attributes of the derived type need to be bolted to the floor. */ result->expr_type = EXPR_STRUCTURE; - type = gfc_typenode_for_spec (&result->ts); cmp = result->ts.u.derived->components; + if (result->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING + && (result->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR + || result->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR)) + { + gfc_constructor *c; + gfc_expr *e; + /* Needed as gfc_typenode_for_spec as gfc_typenode_for_spec + sets this to BT_INTEGER. */ + result->ts.type = BT_DERIVED; + e = gfc_get_constant_expr (cmp->ts.type, cmp->ts.kind, &result->where); + c = gfc_constructor_append_expr (&result->value.constructor, e, NULL); + c->n.component = cmp; + gfc_target_interpret_expr (buffer, buffer_size, e); + e->ts.is_iso_c = 1; + return int_size_in_bytes (ptr_type_node); + } + + type = gfc_typenode_for_spec (&result->ts); + /* Run through the derived type components. */ for (;cmp; cmp = cmp->next) { @@ -483,6 +501,7 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu sizes of the components are multiples of BITS_PER_UNIT, i.e. there are, e.g., no bit fields. */ + gcc_assert (cmp->backend_decl); ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl)); gcc_assert (ptr % 8 == 0); ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl)); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index cf2cdb6..3e994aa 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4514,6 +4514,24 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) gfc_start_block (&block); cm = expr->ts.u.derived->components; + + if (expr->ts.u.derived->from_intmod == INTMOD_ISO_C_BINDING + && (expr->ts.u.derived->intmod_sym_id == ISOCBINDING_PTR + || expr->ts.u.derived->intmod_sym_id == ISOCBINDING_FUNPTR)) + { + gfc_se se, lse; + + gcc_assert (cm->backend_decl == NULL); + gfc_init_se (&se, NULL); + gfc_init_se (&lse, NULL); + gfc_conv_expr (&se, gfc_constructor_first (expr->value.constructor)->expr); + lse.expr = dest; + gfc_add_modify (&block, lse.expr, + fold_convert (TREE_TYPE (lse.expr), se.expr)); + + return gfc_finish_block (&block); + } + for (c = gfc_constructor_first (expr->value.constructor); c; c = gfc_constructor_next (c), cm = cm->next) { @@ -4521,20 +4539,6 @@ gfc_trans_structure_assign (tree dest, gfc_expr * expr) if (!c->expr) continue; - /* Handle c_null_(fun)ptr. */ - if (c && c->expr && c->expr->ts.is_iso_c) - { - field = cm->backend_decl; - tmp = fold_build3_loc (input_location, COMPONENT_REF, - TREE_TYPE (field), - dest, field, NULL_TREE); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), - tmp, fold_convert (TREE_TYPE (tmp), - null_pointer_node)); - gfc_add_expr_to_block (&block, tmp); - continue; - } - field = cm->backend_decl; tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field), dest, field, NULL_TREE); @@ -4664,8 +4668,10 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) if (expr->ts.type == BT_DERIVED && expr->ts.u.derived && expr->ts.u.derived->attr.is_iso_c) { - if (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR - || expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_FUNPTR) + if (expr->expr_type == EXPR_VARIABLE + && (expr->symtree->n.sym->intmod_sym_id == ISOCBINDING_NULL_PTR + || expr->symtree->n.sym->intmod_sym_id + == ISOCBINDING_NULL_FUNPTR)) { /* Set expr_type to EXPR_NULL, which will result in null_pointer_node being used below. */ |