diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-09-16 08:42:02 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-09-16 08:42:02 +0200 |
| commit | d14fc2c6b49df42586749b44a5e0df1ad69ff182 (patch) | |
| tree | 03ee176eb8a2cbc4b88523c093cc5f42ecd6a55e /gcc/fortran | |
| parent | 2c995b637dcec7a51aabee43ff6c1f2d90a696a7 (diff) | |
| download | gcc-d14fc2c6b49df42586749b44a5e0df1ad69ff182.zip gcc-d14fc2c6b49df42586749b44a5e0df1ad69ff182.tar.gz gcc-d14fc2c6b49df42586749b44a5e0df1ad69ff182.tar.bz2 | |
re PR fortran/57697 ([OOP] Segfault with defined assignment for components during intrinsic assignment)
2013-09-16 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
* resolve.c (generate_component_assignments): Correctly handle
* the
case that the LHS is not allocated.
2013-09-16 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
* gfortran.dg/defined_assignment_10.f90: Comment print
* statement.
From-SVN: r202609
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 26 |
2 files changed, 21 insertions, 11 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fdbe4b3..0f73dfe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-09-16 Tobias Burnus <burnus@net-b.de> + + PR fortran/57697 + * resolve.c (generate_component_assignments): Correctly handle the + case that the LHS is not allocated. + 2013-09-15 Tobias Burnus <burnus@net-b.de> PR fortran/57697 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f2892e2..fbd9a6a 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -9547,17 +9547,20 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) t1, (*code)->expr1, NULL, NULL, (*code)->loc); - /* For allocatable LHS, check whether it is allocated. */ - if (gfc_expr_attr((*code)->expr1).allocatable) + /* For allocatable LHS, check whether it is allocated. Note + that allocatable components with defined assignment are + not yet support. See PR 57696. */ + if ((*code)->expr1->symtree->n.sym->attr.allocatable) { gfc_code *block; + gfc_expr *e = + gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym); 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); + GFC_ISYM_ALLOCATED, "allocated", + (*code)->loc, 1, e); block->block->next = temp_code; temp_code = block; } @@ -9570,9 +9573,11 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) 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) + /* If the LHS variable is allocatable and wasn't allocated and + the temporary is allocatable, pointer assign the address of + the freshly allocated LHS to the temporary. */ + if ((*code)->expr1->symtree->n.sym->attr.allocatable + && gfc_expr_attr ((*code)->expr1).allocatable) { gfc_code *block; gfc_expr *cond; @@ -9583,9 +9588,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) 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); + GFC_ISYM_ALLOCATED, "allocated", + (*code)->loc, 1, gfc_copy_expr (t1)); block = gfc_get_code (EXEC_IF); block->block = gfc_get_code (EXEC_IF); block->block->expr1 = cond; |