From 15e5858fbe6245b07f9115990bc58d4dfb76e46a Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Fri, 10 May 2019 20:14:22 +0000 Subject: [PATCH] re PR fortran/61968 (ICE (assembly failure) due to wrongly generating a vtable for TYPE(*) / BT_ASSUMED_TYPE) 2019-05-10 Thomas Koenig 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 PR fortran/61968 * gfortran.dg/assumed_type_10.f90: New test case. * gfortran.dg/assumed_type_11.f90: New test case. From-SVN: r271076 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/interface.c | 3 +- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/assumed_type_10.f90 | 46 +++++++++++++++++++ gcc/testsuite/gfortran.dg/assumed_type_11.f90 | 46 +++++++++++++++++++ 5 files changed, 106 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/assumed_type_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/assumed_type_11.f90 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 + + 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 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 + + 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 * 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" } } -- 2.30.2