diff mbox series

[fortran] PR fortran/100024 PR fortran/100025 ICE on subroutine missing explicit interface

Message ID a90391c3-b543-d58d-4e61-7a865e6dd5fe@gmail.com
State New
Headers show
Series [fortran] PR fortran/100024 PR fortran/100025 ICE on subroutine missing explicit interface | expand

Commit Message

José Rui Faustino de Sousa April 10, 2021, 9:18 p.m. UTC 
Hi all!

Proposed patch to PR100024 & PR100025 - ICE on missing polymorphic argument.

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

Remove assertion checking for possible assumed rank arrays and added an 
explicit error message.

Change if clause to allow the handling of assumed-rank arrays as arrays.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE on the handling of assumed-rank procedures 
[PR100024/PR100025]

gcc/fortran/ChangeLog:

	* interface.c (argument_rank_mismatch): Remove assertion and add
	an explicit error message.
	(gfc_get_formal_from_actual_arglist): Allow handling of
	assume-rank arrays.

gcc/testsuite/ChangeLog:

	* gfortran.dg/PR100024.f90: New test.
	* gfortran.dg/PR100025.f90: New test.
diff mbox series

Patch

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 60736123550..5868bf23f11 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2237,8 +2237,11 @@  argument_rank_mismatch (const char *name, locus *where,
     }
   else
     {
-      gcc_assert (rank2 != -1);
-      if (rank1 == 0)
+      if (rank2 == -1)
+	gfc_error_opt (0, "The assumed-rank array actual argument at %L and "
+		       "actual argument at %L are ambiguous, an explicit "
+		       "interface is required.", where, where_formal);
+      else if (rank1 == 0)
 	gfc_error_opt (0, "Rank mismatch between actual argument at %L "
 		       "and actual argument at %L (scalar and rank-%d)",
 		       where, where_formal, rank2);
@@ -5358,7 +5361,7 @@  gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
 	      s->ts.is_iso_c = 0;
 	      s->ts.is_c_interop = 0;
 	      s->attr.flavor = FL_VARIABLE;
-	      if (a->expr->rank > 0)
+	      if (a->expr->rank)
 		{
 		  s->attr.dimension = 1;
 		  s->as = gfc_get_array_spec ();
diff --git a/gcc/testsuite/gfortran.dg/PR100024.f90 b/gcc/testsuite/gfortran.dg/PR100024.f90
new file mode 100644
index 00000000000..fe82ef6da0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100024.f90
@@ -0,0 +1,37 @@ 
+! { dg-do compile }
+!
+program foobar
+
+  implicit none
+
+  type :: foo_t
+  end type foo_t
+
+  class(foo_t), pointer :: a
+  type(foo_t),   target :: b
+
+  call bar1(a)
+  call bar2(b)
+  stop
+
+contains
+  
+  subroutine bar1(this)
+    class(foo_t), pointer, intent(in) :: this(..)
+
+    call foo(this)
+    return
+  end subroutine bar1
+
+  subroutine bar2(this)
+    type(foo_t), pointer, intent(in) :: this(..)
+
+    call foo(this)
+    return
+  end subroutine bar2
+  
+end program foobar
+! { dg-error "Explicit interface required for polymorphic argument at \\\(1\\\)" "" { target "*-*-*" } 22 }
+! { dg-excess-errors "" }
+
+
diff --git a/gcc/testsuite/gfortran.dg/PR100025.f90 b/gcc/testsuite/gfortran.dg/PR100025.f90
new file mode 100644
index 00000000000..ef8b58ad94a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100025.f90
@@ -0,0 +1,25 @@ 
+! { dg-do compile }
+!
+program foo_p
+
+  implicit none
+
+  class(*), pointer :: a
+  
+  call foo(a)
+  call sub_s(a)
+  stop
+
+contains
+  
+  subroutine bar_s(this)
+    class(*), intent(in) :: this(..)
+
+    call foo(this)
+    return
+  end subroutine bar_s
+  
+end program foo_p
+! { dg-error "Explicit interface required for polymorphic argument at \\\(1\\\)" "" { target "*-*-*" } 10 }
+! { dg-excess-errors "" }
+