Fortran: Fix ICE in argument_rank_mismatch [PR103287]
authorSandra Loosemore <sandra@codesourcery.com>
Wed, 5 Jan 2022 21:18:10 +0000 (13:18 -0800)
committerSandra Loosemore <sandra@codesourcery.com>
Thu, 6 Jan 2022 20:45:56 +0000 (12:45 -0800)
This patch removes an incorrect assertion.  A user-friendly error for this
case is already given elsewhere.

2022-01-05  Steve Kargl  <kargl@gcc.gnu.org>
    Sandra Loosemore  <sandra@codesourcery.com>

PR fortran/103287

gcc/fortran/
* interface.c (argument_rank_mismatch): Replace incorrect assertion
with return.

gcc/testsuite/
* gfortran.dg/c-interop/pr103287-1.f90: new.
* gfortran.dg/c-interop/pr103287-2.f90: new.

gcc/fortran/interface.c
gcc/testsuite/gfortran.dg/c-interop/pr103287-1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/c-interop/pr103287-2.f90 [new file with mode: 0644]

index 4be9583..0fd881d 100644 (file)
@@ -2237,7 +2237,11 @@ argument_rank_mismatch (const char *name, locus *where,
     }
   else
     {
-      gcc_assert (rank2 != -1);
+      if (rank2 == -1)
+       /* This is an assumed rank-actual passed to a function without
+          an explicit interface, which is already diagnosed in
+          gfc_procedure_use.  */
+       return;
       if (rank1 == 0)
        gfc_error_opt (0, "Rank mismatch between actual argument at %L "
                       "and actual argument at %L (scalar and rank-%d)",
diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103287-1.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103287-1.f90
new file mode 100644 (file)
index 0000000..aeca52f
--- /dev/null
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+subroutine g
+   call s([1])
+end
+subroutine h(x)
+   integer, pointer :: x(..)
+   call s(x) ! { dg-error "Assumed-rank argument requires an explicit interface" } 
+end
diff --git a/gcc/testsuite/gfortran.dg/c-interop/pr103287-2.f90 b/gcc/testsuite/gfortran.dg/c-interop/pr103287-2.f90
new file mode 100644 (file)
index 0000000..0e724b8
--- /dev/null
@@ -0,0 +1,9 @@
+! { dg-do compile }
+
+subroutine g
+   call s(1)
+end
+subroutine h(x)
+   integer, pointer :: x(..)
+   call s(x) ! { dg-error "Assumed-rank argument requires an explicit interface" } 
+end