diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2013-09-15 12:54:10 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-09-15 12:54:10 +0200 |
| commit | 5ef7093dde1dee4faeb6f2207ecccdf20c79d7d7 (patch) | |
| tree | 0cd0183c7f8c82e506048dfb3024b9830dbcbdc8 /gcc/fortran | |
| parent | 97191ad09302f458e7861f8680370985f19ffed5 (diff) | |
| download | gcc-5ef7093dde1dee4faeb6f2207ecccdf20c79d7d7.zip gcc-5ef7093dde1dee4faeb6f2207ecccdf20c79d7d7.tar.gz gcc-5ef7093dde1dee4faeb6f2207ecccdf20c79d7d7.tar.bz2 | |
re PR fortran/57697 ([OOP] Segfault with defined assignment for components during intrinsic assignment)
2013-09-15 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
* resolve.c (generate_component_assignments): Handle unallocated
LHS with defined assignment of components.
2013-09-15 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
* gfortran.dg/defined_assignment_10.f90: New.
From-SVN: r202601
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 40 |
2 files changed, 46 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9695e9b..fdbe4b3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-09-15 Tobias Burnus <burnus@net-b.de> + + PR fortran/57697 + * resolve.c (generate_component_assignments): Handle unallocated + LHS with defined assignment of components. + 2013-09-12 Brooks Moses <bmoses@google.com> PR driver/42955 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2929679..f2892e2 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9546,6 +9546,21 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) temp_code = build_assignment (EXEC_ASSIGN, t1, (*code)->expr1, NULL, NULL, (*code)->loc); + + /* For allocatable LHS, check whether it is allocated. */ + if (gfc_expr_attr((*code)->expr1).allocatable) + { + gfc_code *block; + block = gfc_get_code (EXEC_IF); + block->block = gfc_get_code (EXEC_IF); + block->block->expr1 + = gfc_build_intrinsic_call (ns, + GFC_ISYM_ASSOCIATED, "allocated", + (*code)->loc, 2, + gfc_copy_expr ((*code)->expr1), NULL); + block->block->next = temp_code; + temp_code = block; + } add_code_to_chain (&temp_code, &tmp_head, &tmp_tail); } @@ -9554,6 +9569,31 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) gfc_free_expr (this_code->ext.actual->expr); this_code->ext.actual->expr = gfc_copy_expr (t1); add_comp_ref (this_code->ext.actual->expr, comp1); + + /* If the LHS is not allocated, we pointer-assign the LHS address + to the temporary - after the LHS has been allocated. */ + if (gfc_expr_attr((*code)->expr1).allocatable) + { + gfc_code *block; + gfc_expr *cond; + cond = gfc_get_expr (); + cond->ts.type = BT_LOGICAL; + cond->ts.kind = gfc_default_logical_kind; + cond->expr_type = EXPR_OP; + cond->where = (*code)->loc; + cond->value.op.op = INTRINSIC_NOT; + cond->value.op.op1 = gfc_build_intrinsic_call (ns, + GFC_ISYM_ASSOCIATED, "allocated", + (*code)->loc, 2, + gfc_copy_expr (t1), NULL); + 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, (*code)->expr1, + NULL, NULL, (*code)->loc); + add_code_to_chain (&block, &head, &tail); + } } } else if (this_code->op == EXEC_ASSIGN && !this_code->next) |