gcc/testsuite/gfortran.dg/coarray_alloc_comp_7.f08

   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_send_by_ref is done for components.
   6
   7 program 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   allocate(bar%obj)
  34   i1 = INT(1, 1)
  35   i4 = 4
  36   r4 = REAL(4.0, 4)
  37   r8 = 8.0
  38   arr_i1 = INT((/ 5,6,7,8 /), 1)
  39   arr_i4 = (/ 1,2,3,4 /)
  40   arr_r8 = (/ 1.2,3.4,5.6,7.8 /)
  41   arr_r4 = REAL((/ 8.7,6.5,4.3,2.1 /), 4)
  42
  43   bar[1]%obj%r4 = i1
  44   if (abs(bar%obj%r4 - 1.0) > 1E-4) stop 1
  45   bar[1]%obj%r8 = i4
  46   if (abs(bar%obj%r8 - 4.0) > 1E-6) stop 2
  47   bar[1]%obj%i1 = r4
  48   if (bar%obj%i1 /= 4) stop 3
  49   bar[1]%obj%i4 = r8
  50   if (bar%obj%i4 /= 8) stop 4
  51
  52   bar[1]%obj%arr_r4 = arr_i1
  53   print *, bar%obj%arr_r4
  54   if (any(abs(bar%obj%arr_r4 - REAL((/ 5,6,7,8 /), 4)) > 1E-4)) stop 5
  55   bar[1]%obj%arr_r8 = arr_i4
  56   if (any(abs(bar%obj%arr_r8 - (/ 1,2,3,4 /)) > 1E-6)) stop 6
  57   bar[1]%obj%arr_i1 = arr_r4
  58   if (any(bar%obj%arr_i1 /= INT((/ 8,6,4,2 /), 1))) stop 7
  59   bar[1]%obj%arr_i4 = arr_r8
  60   if (any(bar%obj%arr_i4 /= (/ 1,3,5,7 /))) stop 8
  61 end program
  62