procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/79344 (segmentation faults and run-time errors)

Browse source 
gcc/fortran/ChangeLog:

2017-02-05  Andre Vehreschild  <vehre@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.

gcc/testsuite/ChangeLog:

2017-02-04  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/79344
	* gfortran.dg/allocate_with_source_24.f90: New test.

From-SVN: r245194
This commit is contained in:
Andre Vehreschild 2017-02-05 16:43:03 +01:00
parent ea06c7b0c4
commit 139d4065e8
4 changed files with 153 additions and 5 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 @@
2017-02-05 Andre Vehreschild <vehre@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 <vehre@gcc.gnu.org>
PR fortran/79335

12
gcc/fortran/trans-stmt.c
View file

@ -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 (&block, &se.pre);
gfc_add_block_to_block (&post, &se.post);
@ -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,

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/79344
* gfortran.dg/allocate_with_source_24.f90: New test.
2017-02-05 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/79230

134
gcc/testsuite/gfortran.dg/allocate_with_source_24.f90 Normal file
View file

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