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

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 9127064fbced650408d1b9bead84cfeec92b2219..0198637f366c8db7088394d9e1181caa0571a397 100644 (file)
--- 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 5b8a0f92643acb1d3ac91a814953f3bf27db83d0..a3a9528814d60cc56f3f9c643513553b8acf2260 100644 (file)
--- 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 83092ee4de95a360ee1dfac75af67b0c6aa617f1..5a579407439e2f75dd2a4a588c7d13585da7d165 100644 (file)
--- 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 (file)
index 0000000..bf0c873
--- /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 (file)
index 0000000..df6572d
--- /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" } }