[Patch, fortran] PR32880 - User operator & allocatable TYPE components: wrong deallocate

[Patch, fortran] PR32880 - User operator & allocatable TYPE components: wrong deallocate

[Paul Thomas]

[-- Attachment #1: Type: text/plain, Size: 657 bytes --]

:ADDPATCH fortran:

This fix for pr32880 is blessedly simple and self-explanatory.  We now 
have a clean sweep on the iso_varying_string testsuite:)

Thanks to Tobias for pointing out where the problem was.

Regtested on Cygwin_NT/amd64 - OK for trunk?

I'll add a testcase - I was in such a burning hurry to communicate this 
that I couldn't wait!

2007-07-27  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/32880
    * trans-expr.c (gfc_trans_scalar_assign): Revert to fixed order
    for lse and rse pre expressions, for derived types with
    allocatable components.  Instead, assign the lhs to a temporary
    and deallocate after the assignment.

 

[-- Attachment #2: pr32880.diff --]
[-- Type: text/x-patch, Size: 1713 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 126973)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_trans_scalar_assign (gfc_se * lse, g
*** 3512,3536 ****
  	}
  
        /* Deallocate the lhs allocated components as long as it is not
! 	 the same as the rhs.  */
        if (!l_is_temp)
  	{
! 	  tmp = gfc_deallocate_alloc_comp (ts.derived, lse->expr, 0);
  	  if (r_is_var)
  	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
! 	  gfc_add_expr_to_block (&lse->pre, tmp);
  	}
  
!       if (r_is_var)
! 	{
! 	  gfc_add_block_to_block (&block, &lse->pre);
! 	  gfc_add_block_to_block (&block, &rse->pre);
! 	}
!       else
! 	{
! 	  gfc_add_block_to_block (&block, &rse->pre);
! 	  gfc_add_block_to_block (&block, &lse->pre);
! 	}
  
        gfc_add_modify_expr (&block, lse->expr,
  			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
--- 3512,3531 ----
  	}
  
        /* Deallocate the lhs allocated components as long as it is not
! 	 the same as the rhs.  This must be done following the assignment
! 	 to prevent deallocating data that could be used in the rhs
! 	 expression.  */
        if (!l_is_temp)
  	{
! 	  tmp = gfc_evaluate_now (lse->expr, &lse->pre);
! 	  tmp = gfc_deallocate_alloc_comp (ts.derived, tmp, 0);
  	  if (r_is_var)
  	    tmp = build3_v (COND_EXPR, cond, build_empty_stmt (), tmp);
! 	  gfc_add_expr_to_block (&lse->post, tmp);
  	}
  
!       gfc_add_block_to_block (&block, &rse->pre);
!       gfc_add_block_to_block (&block, &lse->pre);
  
        gfc_add_modify_expr (&block, lse->expr,
  			   fold_convert (TREE_TYPE (lse->expr), rse->expr));

Re: [Patch, fortran] PR32880 - User operator & allocatable TYPE components: wrong deallocate

[Tobias Burnus]

:REVIEWMAIL:

Paul Thomas wrote:
> Regtested on Cygwin_NT/amd64 - OK for trunk?
OK. Thanks for the fix.

> I'll add a testcase.
Thanks.  How about the attached file of the PR?

Tobias

Re: [Patch, fortran] PR32880 - User operator & allocatable TYPE components: wrong deallocate

[Paul Thomas]

[-- Attachment #1: Type: text/plain, Size: 341 bytes --]

Tobias,
>> add a testcase.
>>     
> Thanks.  How about the attached file of the PR?
>
>   
That's what I have done so far (see attached).  However, in the course 
of the investigation, I found that parentheses were not working 
correctly.  I'll add a tests of that too.

We need to add the IVS testsuite to cp2k and all the others:-)

Paul

[-- Attachment #2: pr32880.f90 --]
[-- Type: text/plain, Size: 1930 bytes --]

! { dg-do run }
! Tests the fix for pr32880, in which 'res' was deallocated
! before it could be used in the concatenation.
! Adapted from vst28.f95, in Lawrie Schonfeld's iso_varying_string
! testsuite, by Tobias Burnus.
!
module iso_varying_string
  type varying_string
     character(LEN=1), dimension(:), allocatable :: chars
  end type varying_string
  interface assignment(=)
     module procedure op_assign_VS_CH
  end interface assignment(=)
  interface operator(//)
     module procedure op_concat_VS_CH
  end interface operator(//)
contains
  elemental subroutine op_assign_VS_CH (var, exp)
    type(varying_string), intent(out) :: var
    character(LEN=*), intent(in)      :: exp
    integer                      :: length
    integer                      :: i_char
    length = len(exp)
    allocate(var%chars(length))
    forall(i_char = 1:length)
       var%chars(i_char) = exp(i_char:i_char)
    end forall
  end subroutine op_assign_VS_CH
  elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)
    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    type(varying_string)             :: concat_string
    len_string_a = size(string_a%chars)
    allocate(concat_string%chars(len_string_a+len(string_b)))
    if (len_string_a >0) &
       concat_string%chars(:len_string_a) = string_a%chars
    if (len (string_b) > 0) &
       concat_string%chars(len_string_a+1:) = string_b
  end function op_concat_VS_CH
end module iso_varying_string

program VST28
  use iso_varying_string
  character(len=10) :: char_a
  type(VARYING_STRING) :: res
  char_a = "abcdefghij"
  res = char_a(5:5)
  res = res//char_a(6:6)
  if(size(res%chars) /= 2 .or. any(res%chars /= ['e','f'])) then
    write(*,*) 'ERROR: should be ef, got: ', res%chars, size(res%chars)
    call abort ()
  end if
end program VST28

! { dg-final { cleanup-modules "iso_varying_string" } }