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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8306bc8a37cdbc199be8e3ae795110c75d959c0a..4d9f0c3ce26643f559807613b4d8d2129fc8b851 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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>

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index dba51b081f476d023b71a821f3aa7d7628aa41bf..81f213711775d83a57812c3581b7e8f35e96090b 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 62b13fcf5f495b562ef66e25eabe6d2fa20f9a17..2b5e354d79a42e57f742076a23cc5f40d0472ba8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/allocatable_function_8.f90 b/gcc/testsuite/gfortran.dg/allocatable_function_8.f90
new file mode 100644 (file)
index 0000000..48f6dd2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_8.f90
@@ -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