diff mbox series

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

Message ID 0cc507e7-1385-573d-85d8-ae23bcfdbdfb@codesourcery.com
State New
Headers show
Series [committed,Fortran] Fix ICE with deferred-rank arrays (PR93957) | expand

Commit Message

Tobias Burnus March 27, 2020, 11:14 a.m. UTC 
Another patch – the last non-Solaris '[10 Regression]'
gfortran regression, which is in Bugzilla.

The patch is obvious: assumed-rank arrays may be also
nonallocatable, nonpointer variables. They are handled
fine by this routine as it has an early exit for
dummy variables (after doing the minimal setup required).

Committed as r10-7416-g62ede14d30f5d083f1ab23bcab6e0e3c9c649006

Cheers,

Tobias

-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
diff mbox series

Patch

commit 62ede14d30f5d083f1ab23bcab6e0e3c9c649006
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Fri Mar 27 12:12:36 2020 +0100

    [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.
---
 gcc/fortran/ChangeLog                         |  6 +++++
 gcc/fortran/trans-array.c                     |  6 +++--
 gcc/testsuite/ChangeLog                       |  5 ++++
 gcc/testsuite/gfortran.dg/assumed_rank_19.f90 | 37 +++++++++++++++++++++++++++
 4 files changed, 52 insertions(+), 2 deletions(-)

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