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

re PR fortran/61459 (segfault when assigning to allocatable function result from matmul result)

Browse source 
2014-07-07  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/61459
	PR fortran/58883
	* trans-expr.c (fcncall_realloc_result): Use the natural type
	for the address expression of 'res_desc'.

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

	PR fortran/61459
	PR fortran/58883
	* gfortran.dg/allocatable_function_8.f90 : New test

From-SVN: r212339
This commit is contained in:
Paul Thomas 2014-07-07 20:04:05 +00:00
parent 72732f3ef0
commit 3af52023d7
4 changed files with 76 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2014-07-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/61459
PR fortran/58883
* trans-expr.c (fcncall_realloc_result): Use the natural type
for the address expression of 'res_desc'.
2014-07-07 Gerald Pfeifer <gerald@pfeifer.com>
* gfortran.texi (Fortran 2003 status): Fix grammar.
@ -8,7 +15,7 @@
* trans-array.c (gfc_conv_descriptor_token): Change assert.
for select-type temporaries.
* trans-decl.c (generate_coarray_sym_init): Skip for
attr.select_type_temporary.
attr.select_type_temporary.
* trans-expr.c (gfc_conv_procedure_call): Fix for
select-type temporaries.
* trans-intrinsic.c (get_caf_token_offset): Ditto.
@ -18,7 +25,7 @@
* trans-types.c (gfc_get_dtype_rank_type): Ditto.
2014-07-03 Tobias Burnus <burnus@net-b.de>
* scanner.c (skip_free_comments): Fix indentation.
2014-07-02 Jakub Jelinek <jakub@redhat.com>

4
gcc/fortran/trans-expr.c
View file

@ -6518,7 +6518,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr)
tmp = build_fold_indirect_ref_loc (input_location, se->expr);
tmp = gfc_deallocate_alloc_comp (expr->ts.u.derived, tmp, expr->rank);
/* The components shall be deallocated before
their containing entity. */
gfc_prepend_expr_to_block (&se->post, tmp);
@ -7302,7 +7302,7 @@ fcncall_realloc_result (gfc_se *se, int rank)
res_desc = gfc_evaluate_now (desc, &se->pre);
gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node);
se->expr = gfc_build_addr_expr (TREE_TYPE (se->expr), res_desc);
se->expr = gfc_build_addr_expr (NULL_TREE, res_desc);
/* Free the lhs after the function call and copy the result data to
the lhs descriptor. */

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2014-07-07 Paul Thomas <pault@gcc.gnu.org>
PR fortran/61459
PR fortran/58883
* gfortran.dg/allocatable_function_8.f90 : New test
2014-07-07 Maciej W. Rozycki <macro@codesourcery.com>
* gcc.target/powerpc/spe-evmerge.c: New file.

59
gcc/testsuite/gfortran.dg/allocatable_function_8.f90 Normal file
View file

@ -0,0 +1,59 @@
! { dg-do run }
! Test the fix for PR61459 and PR58883.
!
! Contributed by John Wingate <johnww@tds.net>
! and Tao Song <songtao.thu@gmail.com>
!
module a
implicit none
private
public :: f_segfault, f_segfault_plus, f_workaround
integer, dimension(2,2) :: b = reshape([1,-1,1,1],[2,2])
contains
function f_segfault(x)
real, dimension(:), allocatable :: f_segfault
real, dimension(:), intent(in) :: x
allocate(f_segfault(2))
f_segfault = matmul(b,x)
end function f_segfault
! Sefaulted without the ALLOCATE as well.
function f_segfault_plus(x)
real, dimension(:), allocatable :: f_segfault_plus
real, dimension(:), intent(in) :: x
f_segfault_plus = matmul(b,x)
end function f_segfault_plus
function f_workaround(x)
real, dimension(:), allocatable :: f_workaround
real, dimension(:), intent(in) :: x
real, dimension(:), allocatable :: tmp
allocate(f_workaround(2),tmp(2))
tmp = matmul(b,x)
f_workaround = tmp
end function f_workaround
end module a
program main
use a
implicit none
real, dimension(2) :: x = 1.0, y
! PR61459
y = f_workaround (x)
if (any (f_segfault (x) .ne. y)) call abort
if (any (f_segfault_plus (x) .ne. y)) call abort
! PR58883
if (any (foo () .ne. reshape([1,2,3,4,5,6,7,8],[2,4]))) call abort
contains
function foo()
integer, allocatable :: foo(:,:)
integer, allocatable :: temp(:)
temp = [1,2,3,4,5,6,7,8]
foo = reshape(temp,[2,4])
end function
end program main