gcc/testsuite/gfortran.dg/coarray_alloc_comp_1.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_get_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 object%indices=[(i,i=1,5)]
  38 allocate(object%scalar, object%matrix(10,7))
  39 object%i = 37
  40 object%scalar = 42
  41 vol_static = reshape([(i, i=1, 2*5*3)], [2, 5, 3])
  42 object%volume = vol_static
  43 object%matrix = reshape([(i, i=1, 70)], [10, 7])
  44 object%dynvol = vol_static
  45 sync all
  46 neighbor = merge(1,neighbor,me==num_images())
  47 if (object[neighbor]%scalar /= 42) STOP 1
  48 if (object[neighbor]%indices(4) /= 4) STOP 2
  49 if (object[neighbor]%matrix(3,6) /= 53) STOP 3
  50 if (any( object[neighbor]%indices(:) /= [1,2,3,4,5] )) STOP 4
  51 if (any( object[neighbor]%matrix(:,:) /= reshape([(i, i=1, 70)], [10, 7]))) STOP 5
  52 if (any( object[neighbor]%matrix(3,:) /= [(i * 10 + 3, i=0, 6)])) STOP 6
  53 if (any( object[neighbor]%matrix(:,2) /= [(i + 10, i=1, 10)])) STOP 7
  54 if (any( object[neighbor]%matrix(idx,2) /= [11, 12, 11, 17, 15])) STOP 8
  55 if (any( object[neighbor]%matrix(3,idx) /= [3, 13, 3, 63, 43])) STOP 9
  56 if (any( object[neighbor]%matrix(2:8:4, 5:1:-1) /= reshape([42, 46, 32, 36, 22, 26, 12, 16, 2, 6], [2,5]))) STOP 10
  57 if (any( object[neighbor]%matrix(:8:4, 2::2) /= reshape([11, 15, 31, 35, 51, 55], [2,3]))) STOP 11
  58 if (any( object[neighbor]%volume /= vol_static)) STOP 12
  59 if (any( object[neighbor]%dynvol /= vol_static)) STOP 13
  60 if (any( object[neighbor]%volume(:, 2:4, :) /= vol_static(:, 2:4, :))) STOP 14
  61 if (any( object[neighbor]%dynvol(:, 2:4, :) /= vol_static(:, 2:4, :))) STOP 15
  62
  63 vol2 = vol_static(:, ::2, :)
  64 if (any( object[neighbor]%volume(:, ::2, :) /= vol2)) STOP 16
  65 if (any( object[neighbor]%dynvol(:, ::2, :) /= vol2)) STOP 17
  66
  67 allocate(bar%vec(-2:2))
  68
  69 bar%vec(1)%volume = vol_static
  70 if (any(bar[neighbor]%vec(1)%volume /= vol_static)) STOP 18
  71
  72 i = 15
  73 bar%vec(1)%scalar = i
  74 if (.not. allocated(bar%vec(1)%scalar)) STOP 19
  75 if (bar[neighbor]%vec(1)%scalar /= 15) STOP 20
  76
  77 bar%vec(0)%scalar = 27
  78 if (.not. allocated(bar%vec(0)%scalar)) STOP 21
  79 if (bar[neighbor]%vec(0)%scalar /= 27) STOP 22
  80
  81 bar%vec(1)%indices = [ 3, 4, 15 ]
  82 allocate(bar%vec(2)%indices(5))
  83 bar%vec(2)%indices = 89
  84
  85 if (.not. allocated(bar%vec(1)%indices)) STOP 23
  86 if (allocated(bar%vec(-2)%indices)) STOP 24
  87 if (allocated(bar%vec(-1)%indices)) STOP 25
  88 if (allocated(bar%vec( 0)%indices)) STOP 26
  89 if (.not. allocated(bar%vec( 2)%indices)) STOP 27
  90 if (any(bar[me]%vec(2)%indices /= 89)) STOP 28
  91
  92 if (any (bar[neighbor]%vec(1)%indices /= [ 3,4,15])) STOP 29
  93
  94 deallocate(bar%vec(2)%indices, object%scalar, object%matrix)
  95 deallocate(bar%vec)
  96 end program