From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 27 Mar 2020 11:12:36 +0000 (+0100)
Subject: [Fortran] Fix ICE with deferred-rank arrays (PR93957)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=62ede14d30f5d083f1ab23bcab6e0e3c9c649006;p=gcc.git

[Fortran] Fix ICE with deferred-rank arrays (PR93957)

	PR fortran/93957
	* trans-array.c (gfc_alloc_allocatable_for_assignment): Accept
	nonallocatable, nonpointer deferred-rank arrays.

	PR fortran/93957
	* gfortran.dg/assumed_rank_19.f90: New.
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 39aa22df298..02f0141bebf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/93957
+	* trans-array.c (gfc_alloc_allocatable_for_assignment): Accept
+	nonallocatable, nonpointer deferred-rank arrays.
+
 2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/93363
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a4b1cba8501..9c928d04e0a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10672,7 +10672,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
    Do likewise, recursively if necessary, with the allocatable components of
-   derived types.  */
+   derived types.  This function is also called for assumed-rank arrays, which
+   are always dummy arguments.  */
 
 void
 gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
@@ -10694,7 +10695,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 
   /* Make sure the frontend gets these right.  */
   gcc_assert (sym->attr.pointer || sym->attr.allocatable || sym_has_alloc_comp
-	      || has_finalizer);
+	      || has_finalizer
+	      || (sym->as->type == AS_ASSUMED_RANK && sym->attr.dummy));
 
   gfc_save_backend_locus (&loc);
   gfc_set_backend_locus (&sym->declared_at);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8107f008999..d5a1c8e1a8e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/93957
+	* gfortran.dg/assumed_rank_19.f90: New.
+
 2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/93363
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_19.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_19.f90
new file mode 100644
index 00000000000..f77f6fb47da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_19.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! PR fortran/93957
+!
+! Contributed by José Rui Faustino de Sousa
+
+function f_ice(this) result(that) bind(c)
+  use, intrinsic :: iso_c_binding, only: c_int
+
+  implicit none
+  
+  integer(kind=c_int), intent(in) :: this(..)
+  integer(kind=c_int)             :: that
+
+  that = size(this)
+  return
+end function f_ice
+
+program ice_p
+  use, intrinsic :: iso_c_binding, only: c_int
+  implicit none
+
+  interface
+    function f_ice(this) result(that) bind(c)
+      use, intrinsic :: iso_c_binding, only: c_int
+      integer(kind=c_int), intent(in) :: this(..)
+      integer(kind=c_int)             :: that
+    end function f_ice
+  end interface
+
+  integer(kind=c_int), parameter :: n = 10
+    
+  integer(kind=c_int) :: intp(n)
+
+  if(size(intp)/=n)  stop 1
+  if(f_ice(intp)/=n) stop 2
+end program ice_p