OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Tobias Burnus 2013-09-25 21:54:12 +02:00 committed by Tobias Burnus
parent 2272ddac7e
commit 71e482dcc0
5 changed files with 127 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -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.

39
gcc/fortran/resolve.c
View File

@ -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--;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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.
2013-09-25 Marek Polacek <polacek@redhat.com>
PR sanitizer/58413

40
gcc/testsuite/gfortran.dg/defined_assignment_8.f90 Normal file
View File

@ -0,0 +1,40 @@
! { dg-do compile }
!
! PR fortran/58469
!
! Related: PR fortran/57697
!
! Was ICEing before
!
module m0
implicit none
type :: component
integer :: i = 42
contains
procedure :: assign0
generic :: assignment(=) => assign0
end type
type, extends(component) :: comp2
real :: aa
end type comp2
type parent
type(comp2) :: foo
end type
contains
elemental subroutine assign0(lhs,rhs)
class(component), intent(INout) :: lhs
class(component), intent(in) :: rhs
lhs%i = 20
end subroutine
end module
program main
use m0
implicit none
type(parent), allocatable :: left
type(parent) :: right
print *, right%foo
left = right
print *, left%foo
if (left%foo%i /= 42) call abort()
end

45
gcc/testsuite/gfortran.dg/defined_assignment_9.f90 Normal file
View File

@ -0,0 +1,45 @@
! { dg-do run }
!
! PR fortran/57697
!
! Further test of typebound defined assignment
!
module m0
implicit none
type component
integer :: i = 42
contains
procedure :: assign0
generic :: assignment(=) => assign0
end type
type parent
type(component) :: foo
end type
contains
elemental subroutine assign0(lhs,rhs)
class(component), intent(INout) :: lhs
class(component), intent(in) :: rhs
lhs%i = 20
end subroutine
end module
program main
use m0
implicit none
block
type(parent), allocatable :: left
type(parent) :: right
! print *, right%foo
left = right
! print *, left%foo
if (left%foo%i /= 20) call abort()
end block
block
type(parent), allocatable :: left(:)
type(parent) :: right(5)
! print *, right%foo
left = right
! print *, left%foo
if (any (left%foo%i /= 20)) call abort()
end block
end