gcc/testsuite/gfortran.dg/coarray_15.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single" }
   3 !
   4 ! PR fortran/18918
   5 !
   6 ! Contributed by John Reid.
   7 !
   8 program ex2
   9       implicit none
  10       real, allocatable :: z(:)[:]
  11       integer :: image
  12       character(len=80) :: str
  13
  14       allocate(z(3)[*])
  15       write(*,*) 'z allocated on image',this_image()
  16       sync all
  17       if (this_image()==1) then
  18           z = 1.2
  19           do image = 2, num_images() ! { dg-warning "will be executed zero times" }
  20             write(*,*) 'Assigning z(:) on image',image
  21             z(:)[image] = z
  22          end do
  23       end if
  24       sync all
  25
  26       str = repeat('X', len(str))
  27       write(str,*) 'z=',z(:),' on image',this_image()
  28       if (str /= " z=   1.2000000       1.2000000       1.2000000      on image           1") &
  29         call abort ()
  30
  31       str = repeat('X', len(str))
  32       write(str,*) 'z=',z,' on image',this_image()
  33       if (str /= " z=   1.2000000       1.2000000       1.2000000      on image           1") &
  34         call abort ()
  35
  36       str = repeat('X', len(str))
  37       write(str,*) 'z=',z(1:3)[this_image()],' on image',this_image()
  38       if (str /= " z=   1.2000000       1.2000000       1.2000000      on image           1") &
  39         call abort ()
  40
  41       call ex2a()
  42       call ex5()
  43 end
  44
  45 subroutine ex2a()
  46       implicit none
  47       real, allocatable :: z(:,:)[:,:]
  48       integer :: image
  49       character(len=100) :: str
  50
  51       allocate(z(2,2)[1,*])
  52       write(*,*) 'z allocated on image',this_image()
  53       sync all
  54       if (this_image()==1) then
  55           z = 1.2
  56           do image = 2, num_images() ! { dg-warning "will be executed zero times" }
  57             write(*,*) 'Assigning z(:) on image',image
  58             z(:,:)[1,image] = z
  59          end do
  60       end if
  61       sync all
  62
  63       str = repeat('X', len(str))
  64       write(str,*) 'z=',z(:,:),' on image',this_image()
  65       if (str /= " z=   1.2000000       1.2000000       1.2000000       1.2000000      on image           1") &
  66         call abort ()
  67
  68       str = repeat('X', len(str))
  69       write(str,*) 'z=',z,' on image',this_image()
  70       if (str /= " z=   1.2000000       1.2000000       1.2000000       1.2000000      on image           1") &
  71         call abort ()
  72 end subroutine ex2a
  73
  74 subroutine ex5
  75    implicit none
  76    integer :: me
  77    real, save :: w(4)[*]
  78    character(len=100) :: str
  79
  80    me = this_image()
  81    w = me
  82
  83    str = repeat('X', len(str))
  84    write(str,*) 'In main on image',this_image(), 'w= ',w
  85    if (str /= " In main on image           1 w=    1.0000000       1.0000000       1.0000000       1.0000000") &
  86      call abort ()
  87
  88    str = repeat('X', len(str))
  89    write(str,*) 'In main on image',this_image(), 'w= ',w(1:4)
  90    if (str /= " In main on image           1 w=    1.0000000       1.0000000       1.0000000       1.0000000") &
  91      call abort ()
  92
  93    str = repeat('X', len(str))
  94    write(str,*) 'In main on image',this_image(), 'w= ',w(:)[1]
  95    if (str /= " In main on image           1 w=    1.0000000       1.0000000       1.0000000       1.0000000") &
  96      call abort ()
  97
  98    sync all
  99    call ex5_sub(me,w)
 100 end subroutine ex5
 101
 102 subroutine ex5_sub(n,w)
 103    implicit none
 104    integer :: n
 105    real :: w(n)
 106    character(len=50) :: str
 107
 108    str = repeat('X', len(str))
 109    write(str,*) 'In sub on image',this_image(), 'w= ',w
 110    if (str /= " In sub on image           1 w=    1.0000000") &
 111      call abort ()
 112 end subroutine ex5_sub