gcc/testsuite/gfortran.dg/coarray_alloc_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
   8 program main
   9
  10 implicit none
  11
  12 type :: mytype
  13   integer :: i
  14   integer, allocatable :: indices(:)
  15   real, dimension(2,5,3) :: volume
  16   integer, allocatable :: scalar
  17   integer :: j
  18   integer, allocatable :: matrix(:,:)
  19   real, allocatable :: dynvol(:,:,:)
  20 end type
  21
  22 type arrtype
  23   type(mytype), allocatable :: vec(:)
  24   type(mytype), allocatable :: mat(:,:)
  25 end type arrtype
  26
  27 type(mytype), save :: object[*]
  28 type(arrtype), save :: bar[*]
  29 integer :: i,j,me,neighbor
  30 integer :: idx(5)
  31 real, allocatable :: volume(:,:,:), vol2(:,:,:)
  32 real :: vol_static(2,5,3)
  33
  34 idx = (/ 1,2,1,7,5 /)
  35
  36 me=this_image()
  37 neighbor = merge(1,me+1,me==num_images())
  38 object[neighbor]%indices=[(i,i=1,5)]
  39 object[neighbor]%i = 37
  40 object[neighbor]%scalar = 42
  41 vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
  42 object[neighbor]%volume = vol_static
  43 object[neighbor]%matrix = reshape([(i, i=1, 70)], [10, 7])
  44 object[neighbor]%dynvol = vol_static
  45 sync all
  46 if (object%scalar /= 42) call abort()
  47 if (any( object%indices /= [1,2,3,4,5] )) call abort()
  48 if (any( object%matrix /= reshape([(i, i=1, 70)], [10, 7]))) call abort()
  49 if (any( object%volume /= vol_static)) call abort()
  50 if (any( object%dynvol /= vol_static)) call abort()
  51
  52 vol2 = vol_static
  53 vol2(:, ::2, :) = 42
  54 object[neighbor]%volume(:, ::2, :) = 42
  55 object[neighbor]%dynvol(:, ::2, :) = 42
  56 if (any( object%volume /= vol2)) call abort()
  57 if (any( object%dynvol /= vol2)) call abort()
  58
  59 allocate(bar%vec(-2:2))
  60
  61 bar[neighbor]%vec(1)%volume = vol_static
  62 if (any(bar%vec(1)%volume /= vol_static)) call abort()
  63
  64 i = 15
  65 bar[neighbor]%vec(1)%scalar = i
  66 if (.not. allocated(bar%vec(1)%scalar)) call abort()
  67 if (bar%vec(1)%scalar /= 15) call abort()
  68
  69 bar[neighbor]%vec(0)%scalar = 27
  70 if (.not. allocated(bar%vec(0)%scalar)) call abort()
  71 if (bar%vec(0)%scalar /= 27) call abort()
  72
  73 bar[neighbor]%vec(1)%indices = [ 3, 4, 15 ]
  74 allocate(bar%vec(2)%indices(5))
  75 bar[neighbor]%vec(2)%indices = 89
  76
  77 if (.not. allocated(bar%vec(1)%indices)) call abort()
  78 if (allocated(bar%vec(-2)%indices)) call abort()
  79 if (allocated(bar%vec(-1)%indices)) call abort()
  80 if (allocated(bar%vec( 0)%indices)) call abort()
  81 if (.not. allocated(bar%vec( 2)%indices)) call abort()
  82 if (any(bar%vec(2)%indices /= 89)) call abort()
  83
  84 if (any (bar%vec(1)%indices /= [ 3,4,15])) call abort()
  85 end program