Commit d14fc2c6 by Tobias Burnus Committed by Tobias Burnus

re PR fortran/57697 ([OOP] Segfault with defined assignment for components…

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
parent 2c995b63
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> 2013-09-15 Tobias Burnus <burnus@net-b.de>
PR fortran/57697 PR fortran/57697
......
...@@ -9547,17 +9547,20 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) ...@@ -9547,17 +9547,20 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
t1, (*code)->expr1, t1, (*code)->expr1,
NULL, NULL, (*code)->loc); NULL, NULL, (*code)->loc);
/* For allocatable LHS, check whether it is allocated. */ /* For allocatable LHS, check whether it is allocated. Note
if (gfc_expr_attr((*code)->expr1).allocatable) 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_code *block;
gfc_expr *e =
gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
block = gfc_get_code (EXEC_IF); block = gfc_get_code (EXEC_IF);
block->block = gfc_get_code (EXEC_IF); block->block = gfc_get_code (EXEC_IF);
block->block->expr1 block->block->expr1
= gfc_build_intrinsic_call (ns, = gfc_build_intrinsic_call (ns,
GFC_ISYM_ASSOCIATED, "allocated", GFC_ISYM_ALLOCATED, "allocated",
(*code)->loc, 2, (*code)->loc, 1, e);
gfc_copy_expr ((*code)->expr1), NULL);
block->block->next = temp_code; block->block->next = temp_code;
temp_code = block; temp_code = block;
} }
...@@ -9570,9 +9573,11 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) ...@@ -9570,9 +9573,11 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
this_code->ext.actual->expr = gfc_copy_expr (t1); this_code->ext.actual->expr = gfc_copy_expr (t1);
add_comp_ref (this_code->ext.actual->expr, comp1); add_comp_ref (this_code->ext.actual->expr, comp1);
/* If the LHS is not allocated, we pointer-assign the LHS address /* If the LHS variable is allocatable and wasn't allocated and
to the temporary - after the LHS has been allocated. */ the temporary is allocatable, pointer assign the address of
if (gfc_expr_attr((*code)->expr1).allocatable) 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_code *block;
gfc_expr *cond; gfc_expr *cond;
...@@ -9583,9 +9588,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns) ...@@ -9583,9 +9588,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
cond->where = (*code)->loc; cond->where = (*code)->loc;
cond->value.op.op = INTRINSIC_NOT; cond->value.op.op = INTRINSIC_NOT;
cond->value.op.op1 = gfc_build_intrinsic_call (ns, cond->value.op.op1 = gfc_build_intrinsic_call (ns,
GFC_ISYM_ASSOCIATED, "allocated", GFC_ISYM_ALLOCATED, "allocated",
(*code)->loc, 2, (*code)->loc, 1, gfc_copy_expr (t1));
gfc_copy_expr (t1), NULL);
block = gfc_get_code (EXEC_IF); block = gfc_get_code (EXEC_IF);
block->block = gfc_get_code (EXEC_IF); block->block = gfc_get_code (EXEC_IF);
block->block->expr1 = cond; block->block->expr1 = cond;
......
2013-09-16 Tobias Burnus <burnus@net-b.de>
PR fortran/57697
* gfortran.dg/defined_assignment_10.f90: Comment print statement.
2013-09-15 Tobias Burnus <burnus@net-b.de> 2013-09-15 Tobias Burnus <burnus@net-b.de>
PR fortran/57697 PR fortran/57697
......
...@@ -28,7 +28,7 @@ program main ...@@ -28,7 +28,7 @@ program main
implicit none implicit none
type(parent), allocatable :: left type(parent), allocatable :: left
type(parent) :: right type(parent) :: right
print *, right%foo ! print *, right%foo
left = right left = right
! print *, left%foo ! print *, left%foo
if (left%foo%i /= 20) call abort() if (left%foo%i /= 20) call abort()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment