Hello world,

the attached patch fixes an error where TYPE(*) ended up in a vtab,
with not-so delectable results.  The solultion is simple - do not
create a vtab if the actual argument is TYPE(*).

This also clears the ICE for my inline packing patch which
was reported by Dominique.

Regression-tested. OK for trunk?

Regards

        Thomas
Index: interface.c
===================================================================
--- interface.c	(Revision 270622)
+++ interface.c	(Arbeitskopie)
@@ -2989,7 +2989,8 @@ compare_actual_formal (gfc_actual_arglist **ap, gf
 	 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
! { 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" } }

Reply via email to