From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Fri, 10 May 2019 20:14:22 +0000 (+0000)
Subject: re PR fortran/61968 (ICE (assembly failure) due to wrongly generating a vtable for... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=15e5858fbe6245b07f9115990bc58d4dfb76e46a;p=gcc.git

re PR fortran/61968 (ICE (assembly failure) due to wrongly generating a vtable for TYPE(*) / BT_ASSUMED_TYPE)

2019-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

    PR fortran/61968
    * interface.c (compare_actual_formal): Do not create a vtab if
    the actual argument is assumed type.

2019-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

    PR fortran/61968
    * gfortran.dg/assumed_type_10.f90: New test case.
    * gfortran.dg/assumed_type_11.f90: New test case.

From-SVN: r271076
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9127064fbce..0198637f366 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/61968
+	* interface.c (compare_actual_formal): Do not create a vtab if
+	the actual argument is assumed type.
+
 2019-05-10  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/90093
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 5b8a0f92643..a3a9528814d 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2989,7 +2989,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	 polymorphic formal arguments.  */
       if (UNLIMITED_POLY (f->sym)
 	  && a->expr->ts.type != BT_DERIVED
-	  && a->expr->ts.type != BT_CLASS)
+	  && a->expr->ts.type != BT_CLASS
+	  && a->expr->ts.type != BT_ASSUMED)
 	gfc_find_vtab (&a->expr->ts);
 
       if (a->expr->expr_type == EXPR_NULL
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 83092ee4de9..5a579407439 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/61968
+	* gfortran.dg/assumed_type_10.f90: New test case.
+	* gfortran.dg/assumed_type_11.f90: New test case.
+
 2019-05-10  Iain Sandoe  <iain@sandoe.co.uk>
 
 	* gcc.target/x86_64/abi/avx512f/abi-avx512f.exp: Darwin is
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_10.f90 b/gcc/testsuite/gfortran.dg/assumed_type_10.f90
new file mode 100644
index 00000000000..bf0c87320ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_10.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-O0 -fdump-tree-original" }
+! PR 61968 - this used to generate invalid assembler containing
+! TYPE(*).
+
+module testmod
+  use iso_c_binding, only: c_size_t, c_int32_t, c_int64_t
+  implicit none
+
+  interface test
+    procedure :: test_32
+    procedure :: test_array
+  end interface test
+
+  interface
+    subroutine test_lib (a, len) bind(C, name="xxx")
+      use iso_c_binding, only: c_size_t
+      type(*), dimension(*) :: a
+      integer(c_size_t), value :: len
+   end subroutine
+  end interface
+
+contains
+
+  subroutine test_32 (a, len)
+    type(*), dimension(*) :: a
+    integer(c_int32_t), value :: len
+    call test_lib (a, int (len, kind=c_size_t))
+  end subroutine
+
+  subroutine test_array (a)
+    use iso_c_binding, only: c_size_t
+    class(*), dimension(..), target :: a
+    call test_lib (a, int (sizeof (a), kind=c_size_t))
+  end subroutine
+
+end module
+
+  subroutine test_32_ (a, len)
+    use iso_c_binding, only: c_int32_t
+    use testmod
+    type(*), dimension(*) :: a
+    integer(c_int32_t), value :: len
+    call test (a, len)
+  end subroutine
+! { dg-final { scan-tree-dump-not "! __vtype_TYPE\\(*\\)" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_11.f90 b/gcc/testsuite/gfortran.dg/assumed_type_11.f90
new file mode 100644
index 00000000000..df6572dd5b3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_type_11.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! { dg-options "-O3 -fdump-tree-original" }
+! PR 61968 - this used to generate invalid assembler containing
+! TYPE(*).
+
+module testmod
+  use iso_c_binding, only: c_size_t, c_int32_t, c_int64_t
+  implicit none
+
+  interface test
+    procedure :: test_32
+    procedure :: test_array
+  end interface test
+
+  interface
+    subroutine test_lib (a, len) bind(C, name="xxx")
+      use iso_c_binding, only: c_size_t
+      type(*), dimension(*) :: a
+      integer(c_size_t), value :: len
+   end subroutine
+  end interface
+
+contains
+
+  subroutine test_32 (a, len)
+    type(*), dimension(*) :: a
+    integer(c_int32_t), value :: len
+    call test_lib (a, int (len, kind=c_size_t))
+  end subroutine
+
+  subroutine test_array (a)
+    use iso_c_binding, only: c_size_t
+    class(*), dimension(..), target :: a
+    call test_lib (a, int (sizeof (a), kind=c_size_t))
+  end subroutine
+
+end module
+
+  subroutine test_32_ (a, len)
+    use iso_c_binding, only: c_int32_t
+    use testmod
+    type(*), dimension(*) :: a
+    integer(c_int32_t), value :: len
+    call test (a, len)
+  end subroutine
+! { dg-final { scan-tree-dump-not "! __vtype_TYPE\\(*\\)" "original" } }