Dear All,
This PR is caused by a rather unfortunate cast for the pointer to the
return value from matmul:
struct array1_real(kind=4) D.2357;
D.2357 = *(struct array1_real(kind=4) *) __result;
D.2357.data = 0B;
....snip....
_gfortran_matmul_r4 (*(struct array1_real(kind=4) * *) &D.2357,
D.2384, D.2391, 0, 0, 0B);
Unsurprisingly, matmul_r4 segfaults because it is passed a NULL for
the descriptor.
The fix is obvious (ie use its natural kind) and results in:
_gfortran_matmul_r4 (&D.2357, D.2384, D.2391, 0, 0, 0B);
Dominique points out that the patch fixes PR58883 as well. I'll
enhance the testcase appropriately.
Unless anybody has any objections, I'll commit to trunk tonight and to
4.8 and 4.9 next weekend.
Cheers
Paul
2014-07-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/61459
* trans-expr.c (fcncall_realloc_result): Use the natural type
for the address expression of 'res_desc'.
2014-07-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/61459
* gfortran.dg/allocatable_function_8.f90 : New test
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 211867)
--- gcc/fortran/trans-expr.c (working copy)
*************** fcncall_realloc_result (gfc_se *se, int
*** 7299,7305 ****
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);
/* Free the lhs after the function call and copy the result data to
the lhs descriptor. */
--- 7299,7305 ----
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 (NULL_TREE, res_desc);
/* Free the lhs after the function call and copy the result data to
the lhs descriptor. */
Index: gcc/testsuite/gfortran.dg/allocatable_function_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocatable_function_8.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/allocatable_function_8.f90 (working copy)
***************
*** 0 ****
--- 1,47 ----
+ ! { dg-do run }
+ ! Test the fix for PR61459.
+ !
+ ! Contributed by John Wingate <joh...@tds.net>
+ !
+ 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
+ y = f_workaround (x)
+ if (any (f_segfault (x) .ne. y)) call abort
+ if (any (f_segfault_plus (x) .ne. y)) call abort
+ end program main
