re PR fortran/71936 (ICE in wide_int_to_tree, at tree.c:1487)

gcc/fortran/ChangeLog:

2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/71936
	* trans-array.c (gfc_array_allocate): When SOURCE= is a function
	stick with the ref of the object to allocate.

gcc/testsuite/ChangeLog:

2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/71936
	* gfortran.dg/allocate_with_source_21.f03: New test.

From-SVN: r239237

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3b54ee38c7ede27cda7060def953bcc57c6b0004..6a56ed047a8cd6ff530d91747156700553e00a4b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/71936
+       * trans-array.c (gfc_array_allocate): When SOURCE= is a function
+       stick with the ref of the object to allocate.
+
 2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/72698

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 0a66f83562c95f229d6058028efcb341230d0d6e..450d7db2076a64b4fabd1e198dfb441bca834536 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5431,12 +5431,19 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   if (ref->u.ar.type == AR_FULL && expr3 != NULL)
     {
+      gfc_ref *old_ref = ref;
       /* F08:C633: Array shape from expr3.  */
       ref = expr3->ref;
 
       /* Find the last reference in the chain.  */
       if (!retrieve_last_ref (&ref, &prev_ref))
-       return false;
+       {
+         if (expr3->expr_type == EXPR_FUNCTION
+             && gfc_expr_attr (expr3).dimension)
+           ref = old_ref;
+         else
+           return false;
+       }
       alloc_w_e3_arr_spec = true;
     }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6b7135cfecaad05cef842fb0593f1b83a410637b..18f6e46e7bfffaa3e80dd12965199f5f8528ac9a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/71936
+       * gfortran.dg/allocate_with_source_21.f03: New test.
+
 2016-08-08  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/72698

diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03
new file mode 100644 (file)
index 0000000..fbf3159
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_21.f03
@@ -0,0 +1,52 @@
+! { dg-do compile }
+
+! Check fix for pr71936.
+! Contributed by Gerhard Steinmetz
+
+program p
+  type t
+  end type
+
+  call test2()
+  call test4()
+  call test1()
+  call test3()
+contains
+  function f_p()
+    class(t), pointer :: f_p(:)
+    nullify(f_p)
+  end
+
+  function f_a()
+    class(t), allocatable :: f_a(:)
+  end
+
+  subroutine test1()
+    class(t), allocatable :: x(:)
+    allocate (x, mold=f_a())
+    deallocate (x)
+    allocate (x, source=f_a())
+  end subroutine
+
+  subroutine test2()
+    class(t), pointer :: x(:)
+    allocate (x, mold=f_p())
+    deallocate (x)
+    allocate (x, source=f_p())
+  end
+
+  subroutine test3()
+    class(t), pointer :: x(:)
+    allocate (x, mold=f_a())
+    deallocate (x)
+    allocate (x, source=f_a())
+  end
+
+  subroutine test4()
+    class(t), allocatable :: x(:)
+    allocate (x, mold=f_p())
+    deallocate (x)
+    allocate (x, source=f_p())
+  end subroutine
+end
+