gcc/testsuite/gfortran.dg/coarray_stat_function.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original -fcoarray=lib" }
   3 !
   4 program function_stat
   5   implicit none
   6
   7   integer :: me[*],tmp,stat,stat2,next
   8
   9   me = this_image()
  10   next = me + 1
  11   if(me == num_images()) next = 1
  12   stat = 0
  13
  14   sync all(stat=stat)
  15
  16   if(stat /= 0) write(*,*) 'Image failed during sync'
  17
  18   stat = 0
  19   if(me == 1) then
  20      tmp = func(me[4,stat=stat])
  21      if(stat /= 0) write(*,*) me,'failure in func arg'
  22    else if(me == 2) then
  23       tmp = func2(me[1,stat=stat2],me[3,stat=stat])
  24       if(stat2 /= 0 .or. stat /= 0) write(*,*) me,'failure in func2 args'
  25   endif
  26
  27 contains
  28
  29   function func(remote_me)
  30     integer func
  31     integer remote_me
  32     func = remote_me
  33   end function func
  34
  35   function func2(remote_me,remote_neighbor)
  36     integer func2
  37     integer remote_me,remote_neighbor
  38     func2 = remote_me + remote_neighbor
  39   end function func2
  40
  41 end program function_stat
  42
  43 ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 4, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }
  44 ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 1, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat2\\\);" 1 "original" } }
  45 ! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) desc.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) me, 3, &desc.\[0-9\]+, 0B, &desc.\[0-9\]+, 4, 4, 0, &stat\\\);" 1 "original" } }