diff mbox series

[fortran] PR fortran/93957 - [10 Regression] ICE (regression) passing assumed rank arrays with bind(c)

Message ID 211afab6-23e8-b9a9-d2eb-37e2ba5bbb9b@gmail.com
State New
Headers show
Series [fortran] PR fortran/93957 - [10 Regression] ICE (regression) passing assumed rank arrays with bind(c) | expand

Commit Message

José Rui Faustino de Sousa Feb. 27, 2020, 11:56 a.m. UTC 
Hi all!

Proposed patch to solve ICE.

Patch tested only on x86_64-pc-linux-gnu.

The code currently calls gfc_trans_deferred_array even when it is not 
necessary triggering an assertion error inside gfc_trans_deferred_array.

Please notice the addition of "sym->ts.type == BT_CLASS" to the 
definition of "alloc_comp_or_fini". Instead of only accepting BT_DERIVED 
it will now also accept BT_CLASS types. It seems to be missing but I may 
be wrong.

Thank you very much.

Best regards,
José Rui

2020-2-27  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

  PR fortran/93957
  * trans-decl.c (gfc_trans_deferred_vars): Change definition of
  alloc_comp_or_fini logical variable to also accept class type.
  Add if clause guarding the call to gfc_trans_deferred_array.

2020-2-27  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

  PR fortran/92621
  * PR93957.f90: New test.
diff mbox series

Patch

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e91a279..822cb3e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4645,7 +4645,7 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)

    for (sym = proc_sym->tlink; sym != proc_sym; sym = sym->tlink)
      {
-      bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED)
+      bool alloc_comp_or_fini = (sym->ts.type == BT_DERIVED || 
sym->ts.type == BT_CLASS)
  				&& (sym->ts.u.derived->attr.alloc_comp
  				    || gfc_is_finalizable (sym->ts.u.derived,
  							   NULL));
@@ -4859,8 +4859,11 @@  gfc_trans_deferred_vars (gfc_symbol * proc_sym, 
gfc_wrapped_block * block)

  	    case AS_ASSUMED_RANK:
  	    case AS_DEFERRED:
-	      seen_trans_deferred_array = true;
-	      gfc_trans_deferred_array (sym, block);
+	      if (sym->attr.pointer || sym->attr.allocatable || 
alloc_comp_or_fini)
+		{
+		  seen_trans_deferred_array = true;
+		  gfc_trans_deferred_array (sym, block);
+		}
  	      if (sym->ts.type == BT_CHARACTER && sym->ts.deferred
  		  && sym->attr.result)
  		{
diff --git a/gcc/testsuite/gfortran.dg/PR93957.f90 
b/gcc/testsuite/gfortran.dg/PR93957.f90
new file mode 100644
index 0000000..c403e15
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR93957.f90
@@ -0,0 +1,39 @@ 
+! { dg-do run }
+!
+! PR fortran/93957
+!
+
+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