gcc/testsuite/gfortran.dg/coarray_ptr_comp_2.f08

   1 ! { dg-do run }
   2 ! { dg-options "-fcoarray=lib -lcaf_single" }
   3 ! { dg-additional-options "-latomic" { target libatomic_available } }
   4
   5 ! Contributed by Damian Rouson
   6 ! Check the new _caf_send_by_ref()-routine.
   7 ! Same as coarray_alloc_comp_2 but for pointers.
   8
   9 program main
  10
  11 implicit none
  12
  13 type :: mytype
  14   integer :: i
  15   integer, pointer :: indices(:)
  16   real, dimension(2,5,3) :: volume
  17   integer, pointer :: scalar
  18   integer :: j
  19   integer, pointer :: matrix(:,:)
  20   real, pointer :: dynvol(:,:,:)
  21 end type
  22
  23 type arrtype
  24   type(mytype), pointer :: vec(:)
  25   type(mytype), pointer :: mat(:,:)
  26 end type arrtype
  27
  28 type(mytype), save :: object[*]
  29 type(arrtype), save :: bar[*]
  30 integer :: i,j,me,neighbor
  31 integer :: idx(5)
  32 real, allocatable :: volume(:,:,:), vol2(:,:,:)
  33 real :: vol_static(2,5,3)
  34
  35 idx = (/ 1,2,1,7,5 /)
  36
  37 me=this_image()
  38 neighbor = merge(1,me+1,me==num_images())
  39 allocate(object%indices(5), object%scalar, object%matrix(10,7), object%dynvol(2,5,3))
  40 object[neighbor]%indices=[(i,i=1,5)]
  41 object[neighbor]%i = 37
  42 object[neighbor]%scalar = 42
  43 vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
  44 object[neighbor]%volume = vol_static
  45 object[neighbor]%matrix = reshape([(i, i=1, 70)], [10, 7])
  46 object[neighbor]%dynvol = vol_static
  47 sync all
  48 if (object%scalar /= 42) call abort()
  49 if (any( object%indices /= [1,2,3,4,5] )) call abort()
  50 if (any( object%matrix /= reshape([(i, i=1, 70)], [10, 7]))) call abort()
  51 if (any( object%volume /= vol_static)) call abort()
  52 if (any( object%dynvol /= vol_static)) call abort()
  53
  54 vol2 = vol_static
  55 vol2(:, ::2, :) = 42
  56 object[neighbor]%volume(:, ::2, :) = 42
  57 object[neighbor]%dynvol(:, ::2, :) = 42
  58 if (any( object%volume /= vol2)) call abort()
  59 if (any( object%dynvol /= vol2)) call abort()
  60
  61 allocate(bar%vec(-2:2))
  62
  63 bar[neighbor]%vec(1)%volume = vol_static
  64 if (any(bar%vec(1)%volume /= vol_static)) call abort()
  65
  66 allocate(bar%vec(1)%scalar, bar%vec(0)%scalar, bar%vec(1)%indices(3))
  67 i = 15
  68 bar[neighbor]%vec(1)%scalar = i
  69 if (.not. associated(bar%vec(1)%scalar)) call abort()
  70 if (bar%vec(1)%scalar /= 15) call abort()
  71
  72 bar[neighbor]%vec(0)%scalar = 27
  73 if (.not. associated(bar%vec(0)%scalar)) call abort()
  74 if (bar%vec(0)%scalar /= 27) call abort()
  75
  76 bar[neighbor]%vec(1)%indices = [ 3, 4, 15 ]
  77 allocate(bar%vec(2)%indices(5))
  78 bar[neighbor]%vec(2)%indices = 89
  79
  80 if (.not. associated(bar%vec(1)%indices)) call abort()
  81 if (associated(bar%vec(-2)%indices)) call abort()
  82 if (associated(bar%vec(-1)%indices)) call abort()
  83 if (associated(bar%vec( 0)%indices)) call abort()
  84 if (.not. associated(bar%vec( 2)%indices)) call abort()
  85 if (any(bar%vec(2)%indices /= 89)) call abort()
  86
  87 if (any (bar%vec(1)%indices /= [ 3,4,15])) call abort()
  88 end program