1! { dg-do run }
2! { dg-options "-fcoarray=lib -lcaf_single" }
3! { dg-additional-options "-latomic" { target libatomic_available } }
4
5! Check that type conversion during caf_get_by_ref is done for components.
6
7program main
8
9  implicit none
10
11  type :: mytype
12    integer :: i
13    integer :: i4
14    integer(kind=1) :: i1
15    real :: r8
16    real(kind=4) :: r4
17    integer :: arr_i4(4)
18    integer(kind=1) :: arr_i1(4)
19    real :: arr_r8(4)
20    real(kind=4) :: arr_r4(4)
21  end type
22
23  type T
24    type(mytype), allocatable :: obj
25  end type T
26
27  type(T), save :: bar[*]
28  integer :: i4, arr_i4(4)
29  integer(kind=1) :: i1, arr_i1(4)
30  real :: r8, arr_r8(4)
31  real(kind=4) :: r4, arr_r4(4)
32
33  bar%obj = mytype(42, 4, INT(1, 1), 8.0, REAL(4.0, 4), (/ 1,2,3,4 /), &
34  &       INT((/ 5,6,7,8 /), 1), (/ 1.2,3.4,5.6,7.8 /), REAL( &
35  &       (/ 8.7,6.5,4.3,2.1 /), 4))
36
37  i1 = bar[1]%obj%r4
38  if (i1 /= 4) stop 1
39  i4 = bar[1]%obj%r8
40  if (i4 /= 8) stop 2
41  r4 = bar[1]%obj%i1
42  if (abs(r4 - 1.0) > 1E-4) stop 3
43  r8 = bar[1]%obj%i4
44  if (abs(r8 - 4.0) > 1E-6) stop 4
45
46  arr_i1 = bar[1]%obj%arr_r4
47  if (any(arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 5
48  arr_i4 = bar[1]%obj%arr_r8
49  if (any(arr_i4 /= (/ 1,3,5,7 /))) stop 6
50  arr_r4 = bar[1]%obj%arr_i1
51  if (any(abs(arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 7
52  arr_r8 = bar[1]%obj%arr_i4
53  if (any(abs(arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 8
54end program
55
56