Re: [PATCH, Fortran, pr79344, v1] [7 Regression] segmentation faults and run-time errors
Hi Mikael, thanks for the fast review. Committed as r245193. Regards, Andre On Sun, 5 Feb 2017 15:32:25 +0100 Mikael Morinwrote: > 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 + PR fortran/79344 + * gfortran.dg/allocate_with_source_24.f90: New test. + +2017-02-05 Andre Vehreschild + 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
Re: [PATCH, Fortran, pr79344, v1] [7 Regression] segmentation faults and run-time errors
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
[PATCH, Fortran, pr79344, v1] [7 Regression] segmentation faults and run-time errors
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? Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de gcc/fortran/ChangeLog: 2017-02-04 Andre VehreschildPR 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. gcc/testsuite/ChangeLog: 2017-02-04 Andre Vehreschild * gfortran.dg/allocate_with_source_24.f90: New test. diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 61e597f..773ca70 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5572,7 +5572,8 @@ gfc_trans_allocate (gfc_code * code) 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 @@ gfc_trans_allocate (gfc_code * code) 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 (, ); gfc_add_block_to_block (, ); @@ -5714,11 +5715,12 @@ gfc_trans_allocate (gfc_code * code) } /* 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, diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 new file mode 100644 index 000..ec11d7a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 @@ -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) +