Hi Mikael, thanks for the fast review. Committed as r245193.
Regards, Andre On Sun, 5 Feb 2017 15:32:25 +0100 Mikael Morin <morin-mik...@orange.fr> wrote: > Le 04/02/2017 à 19:43, Andre Vehreschild a écrit : > > Hi all, > > > > attached patch fixes the issue of losing the data in the SOURCE= expression > > of an ALLOCATE() when the source-expression is just a simple variable. The > > issue was that internally a temporary variable was created, whose > > components were freed afterwards. Now the components are only freed on > > temporary objects, i.e., when the source-expression is not an > > EXPR_VARIABLE, e.g. an EXPR_STRUCTURE or EXPR_FUNCTION. > > > > Bootstraps and regtests ok on x86_64-linux/f25. Ok for trunk? > > > Hello, > > this looks good to me. > Thanks > > Mikael > -- Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/testsuite/ChangeLog =================================================================== --- gcc/testsuite/ChangeLog (Revision 245193) +++ gcc/testsuite/ChangeLog (Arbeitskopie) @@ -1,5 +1,10 @@ 2017-02-05 Andre Vehreschild <ve...@gcc.gnu.org> + PR fortran/79344 + * gfortran.dg/allocate_with_source_24.f90: New test. + +2017-02-05 Andre Vehreschild <ve...@gcc.gnu.org> + PR fortran/79230 * gfortran.dg/der_ptr_component_2.f90: New test. Index: gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 =================================================================== --- gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 (nicht existent) +++ gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 (Revision 245194) @@ -0,0 +1,134 @@ +! { dg-do run } +! +! Test that the temporary in a sourced-ALLOCATE is not freeed. +! PR fortran/79344 +! Contributed by Juergen Reuter + +module iso_varying_string + implicit none + + type, public :: varying_string + private + 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_not_equal_VS_CA + end interface operator(/=) + + interface len + module procedure len_ + end interface len + + interface var_str + module procedure var_str_ + end interface var_str + + public :: assignment(=) + public :: operator(/=) + public :: len + + private :: op_assign_VS_CH + private :: op_not_equal_VS_CA + private :: char_auto + private :: len_ + private :: var_str_ + +contains + + elemental function len_ (string) result (length) + type(varying_string), intent(in) :: string + integer :: length + if(ALLOCATED(string%chars)) then + length = SIZE(string%chars) + else + length = 0 + endif + end function len_ + + elemental subroutine op_assign_VS_CH (var, exp) + type(varying_string), intent(out) :: var + character(LEN=*), intent(in) :: exp + var = var_str(exp) + end subroutine op_assign_VS_CH + + pure function op_not_equal_VS_CA (var, exp) result(res) + type(varying_string), intent(in) :: var + character(LEN=*), intent(in) :: exp + logical :: res + integer :: i + res = .true. + if (len(exp) /= size(var%chars)) return + do i = 1, size(var%chars) + if (var%chars(i) /= exp(i:i)) return + end do + res = .false. + end function op_not_equal_VS_CA + + pure function char_auto (string) result (char_string) + type(varying_string), intent(in) :: string + character(LEN=len(string)) :: char_string + integer :: i_char + forall(i_char = 1:len(string)) + char_string(i_char:i_char) = string%chars(i_char) + end forall + end function char_auto + + elemental function var_str_ (char) result (string) + character(LEN=*), intent(in) :: char + type(varying_string) :: string + integer :: length + integer :: i_char + length = LEN(char) + ALLOCATE(string%chars(length)) + forall(i_char = 1:length) + string%chars(i_char) = char(i_char:i_char) + end forall + end function var_str_ + +end module iso_varying_string + +!!!!! + +program test_pr79344 + + use iso_varying_string, string_t => varying_string + + implicit none + + type :: field_data_t + type(string_t), dimension(:), allocatable :: name + end type field_data_t + + type(field_data_t) :: model, model2 + allocate(model%name(2)) + model%name(1) = "foo" + model%name(2) = "bar" + call copy(model, model2) +contains + + subroutine copy(prt, prt_src) + implicit none + type(field_data_t), intent(inout) :: prt + type(field_data_t), intent(in) :: prt_src + integer :: i + if (allocated (prt_src%name)) then + if (prt_src%name(1) /= "foo") call abort() + if (prt_src%name(2) /= "bar") call abort() + + if (allocated (prt%name)) deallocate (prt%name) + allocate (prt%name (size (prt_src%name)), source = prt_src%name) + ! The issue was, that prt_src was empty after sourced-allocate. + if (prt_src%name(1) /= "foo") call abort() + if (prt_src%name(2) /= "bar") call abort() + if (prt%name(1) /= "foo") call abort() + if (prt%name(2) /= "bar") call abort() + end if + end subroutine copy + +end program test_pr79344 + Index: gcc/fortran/ChangeLog =================================================================== --- gcc/fortran/ChangeLog (Revision 245193) +++ gcc/fortran/ChangeLog (Arbeitskopie) @@ -1,5 +1,12 @@ 2017-02-05 Andre Vehreschild <ve...@gcc.gnu.org> + PR fortran/79344 + * trans-stmt.c (gfc_trans_allocate): Only deallocate the components of + the temporary, when a new object was created for the temporary. Not + when it is just an alias to an existing object. + +2017-02-05 Andre Vehreschild <ve...@gcc.gnu.org> + PR fortran/79335 * trans-decl.c (generate_coarray_sym_init): Retrieve the symbol's attributes before using them. Index: gcc/fortran/trans-stmt.c =================================================================== --- gcc/fortran/trans-stmt.c (Revision 245193) +++ gcc/fortran/trans-stmt.c (Arbeitskopie) @@ -5572,7 +5572,8 @@ expression. */ if (code->expr3) { - bool vtab_needed = false, temp_var_needed = false; + bool vtab_needed = false, temp_var_needed = false, + temp_obj_created = false; is_coarray = gfc_is_coarray (code->expr3); @@ -5645,7 +5646,7 @@ code->expr3->ts, false, true, false, false); - temp_var_needed = !VAR_P (se.expr); + temp_obj_created = temp_var_needed = !VAR_P (se.expr); } gfc_add_block_to_block (&block, &se.pre); gfc_add_block_to_block (&post, &se.post); @@ -5714,11 +5715,12 @@ } /* Deallocate any allocatable components in expressions that use a - temporary, i.e. are not of expr-type EXPR_VARIABLE or force the - use of a temporary, after the assignment of expr3 is completed. */ + temporary object, i.e. are not a simple alias of to an EXPR_VARIABLE. + E.g. temporaries of a function call need freeing of their components + here. */ if ((code->expr3->ts.type == BT_DERIVED || code->expr3->ts.type == BT_CLASS) - && (code->expr3->expr_type != EXPR_VARIABLE || temp_var_needed) + && (code->expr3->expr_type != EXPR_VARIABLE || temp_obj_created) && code->expr3->ts.u.derived->attr.alloc_comp) { tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,