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

2014-07-08  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-08  Paul Thomas  <pault@gcc.gnu.org>

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

From-SVN: r212369

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 65cfa6ffe9361ee6247b0c3b65fc9e48b2f0c8fa..c0ab45701357215a22be7668af1b791fa547fd23 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2014-07-08  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-02  Jakub Jelinek  <jakub@redhat.com>
            Fritz Reese  <Reese-Fritz@zai.com>
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index d6411b0f5ecd59f9733ad9771792c060dc1fb8da..850ed834a58b030c78f5a733a3f3a4a47a2b9d65 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -7096,7 +7096,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 95ea849ae0654a6ea1c9ec8f3005e05cd65c2544..212d42a0923ae73d4620c432122522491dc93520 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2014-07-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/61459
+       PR fortran/58883
+       * gfortran.dg/allocatable_function_8.f90 : New test
+
 2014-07-04  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/61684

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..7d0d69d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocatable_function_8.f90
@@ -0,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