This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, fortran] PR61459 - [4.8/4.9/4.10 Regression] segfault when assigning to allocatable function result from matmul result


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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]