diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-09-25 21:54:12 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-09-25 21:54:12 +0200 |
| commit | 71e482dcc0c583887cb5e9ea7b9590aac1335bfb (patch) | |
| tree | 53370fa886d4e0792ef91fd1ea8c97fe80488b02 /gcc/fortran | |
| parent | 2272ddac7e097e53f2929b30767dec06396f642e (diff) | |
| download | gcc-71e482dcc0c583887cb5e9ea7b9590aac1335bfb.zip gcc-71e482dcc0c583887cb5e9ea7b9590aac1335bfb.tar.gz gcc-71e482dcc0c583887cb5e9ea7b9590aac1335bfb.tar.bz2 | |
re PR fortran/57697 ([OOP] Segfault with defined assignment for components during intrinsic assignment)
2013-09-25 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
PR fortran/58469
* resolve.c (generate_component_assignments): Avoid double free
at runtime and freeing a still-being used expr.
2013-09-25 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
PR fortran/58469
* gfortran.dg/defined_assignment_8.f90: New.
* gfortran.dg/defined_assignment_9.f90: New.
From-SVN: r202922
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 39 |
2 files changed, 35 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f43196b..445dfae 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-09-25 Tobias Burnus <burnus@net-b.de> + + PR fortran/57697 + PR fortran/58469 + * resolve.c (generate_component_assignments): Avoid double free + at runtime and freeing a still-being used expr. + 2013-09-25 Tom Tromey <tromey@redhat.com> * Make-lang.in (fortran_OBJS): Use fortran/gfortranspec.o. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d33fe49..4befb9fd 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9602,8 +9602,9 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) && gfc_expr_attr ((*code)->expr1).allocatable) { gfc_code *block; - gfc_expr *cond; - cond = gfc_get_expr (); + gfc_expr *cond; + + cond = gfc_get_expr (); cond->ts.type = BT_LOGICAL; cond->ts.kind = gfc_default_logical_kind; cond->expr_type = EXPR_OP; @@ -9621,7 +9622,7 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) add_code_to_chain (&block, &head, &tail); } } - } + } else if (this_code->op == EXEC_ASSIGN && !this_code->next) { /* Don't add intrinsic assignments since they are already @@ -9643,13 +9644,6 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) } } - /* This is probably not necessary. */ - if (this_code) - { - gfc_free_statements (this_code); - this_code = NULL; - } - /* Put the temporary assignments at the top of the generated code. */ if (tmp_head && component_assignment_level == 1) { @@ -9658,6 +9652,28 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) tmp_head = tmp_tail = NULL; } + // If we did a pointer assignment - thus, we need to ensure that the LHS is + // not accidentally deallocated. Hence, nullify t1. + if (t1 && (*code)->expr1->symtree->n.sym->attr.allocatable + && gfc_expr_attr ((*code)->expr1).allocatable) + { + gfc_code *block; + gfc_expr *cond; + gfc_expr *e; + + e = gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym); + cond = gfc_build_intrinsic_call (ns, GFC_ISYM_ASSOCIATED, "associated", + (*code)->loc, 2, gfc_copy_expr (t1), e); + block = gfc_get_code (EXEC_IF); + block->block = gfc_get_code (EXEC_IF); + block->block->expr1 = cond; + block->block->next = build_assignment (EXEC_POINTER_ASSIGN, + t1, gfc_get_null_expr (&(*code)->loc), + NULL, NULL, (*code)->loc); + gfc_append_code (tail, block); + tail = block; + } + /* Now attach the remaining code chain to the input code. Step on to the end of the new code since resolution is complete. */ gcc_assert ((*code)->op == EXEC_ASSIGN); @@ -9667,7 +9683,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) gfc_free_expr ((*code)->expr1); gfc_free_expr ((*code)->expr2); **code = *head; - free (head); + if (head != tail) + free (head); *code = tail; component_assignment_level--; |