1! { dg-do run }
2! { dg-additional-sources bind_c_dts_driver.c }
3module bind_c_dts
4  use, intrinsic :: iso_c_binding
5  implicit none
6
7  type, bind(c) :: MYFTYPE_1
8     integer(c_int) :: i, j
9     real(c_float) :: s
10  end type MYFTYPE_1
11
12  TYPE, BIND(C) :: particle
13     REAL(C_DOUBLE) :: x,vx
14     REAL(C_DOUBLE) :: y,vy
15     REAL(C_DOUBLE) :: z,vz
16     REAL(C_DOUBLE) :: m
17  END TYPE particle
18
19  type(myftype_1), bind(c, name="myDerived") :: myDerived
20
21contains
22  subroutine types_test(my_particles, num_particles) bind(c)
23    integer(c_int), value :: num_particles
24    type(particle), dimension(num_particles) :: my_particles
25    integer :: i
26
27    ! going to set the particle in the middle of the list
28    i = num_particles / 2;
29    my_particles(i)%x = my_particles(i)%x + .2d0
30    my_particles(i)%vx = my_particles(i)%vx + .2d0
31    my_particles(i)%y = my_particles(i)%y + .2d0
32    my_particles(i)%vy = my_particles(i)%vy + .2d0
33    my_particles(i)%z = my_particles(i)%z + .2d0
34    my_particles(i)%vz = my_particles(i)%vz + .2d0
35    my_particles(i)%m = my_particles(i)%m + .2d0
36
37    myDerived%i = myDerived%i + 1
38    myDerived%j = myDerived%j + 1
39    myDerived%s = myDerived%s + 1.0;
40  end subroutine types_test
41end module bind_c_dts
42