1! { dg-do compile }
2! { dg-options "-O0 -fdump-tree-original" }
3! PR 61968 - this used to generate invalid assembler containing
4! TYPE(*).
5
6module testmod
7  use iso_c_binding, only: c_size_t, c_int32_t, c_int64_t
8  implicit none
9
10  interface test
11    procedure :: test_32
12    procedure :: test_array
13  end interface test
14
15  interface
16    subroutine test_lib (a, len) bind(C, name="xxx")
17      use iso_c_binding, only: c_size_t
18      type(*), dimension(*) :: a
19      integer(c_size_t), value :: len
20   end subroutine
21  end interface
22
23contains
24
25  subroutine test_32 (a, len)
26    type(*), dimension(*) :: a
27    integer(c_int32_t), value :: len
28    call test_lib (a, int (len, kind=c_size_t))
29  end subroutine
30
31  subroutine test_array (a)
32    use iso_c_binding, only: c_size_t
33    class(*), dimension(..), target :: a
34    call test_lib (a, int (sizeof (a), kind=c_size_t))
35  end subroutine
36
37end module
38
39  subroutine test_32_ (a, len)
40    use iso_c_binding, only: c_int32_t
41    use testmod
42    type(*), dimension(*) :: a
43    integer(c_int32_t), value :: len
44    call test (a, len)
45  end subroutine
46! { dg-final { scan-tree-dump-not "! __vtype_TYPE\\(*\\)" "original" } }
47