gcc/testsuite/gfortran.dg/coarray/event_2.f90

   1 ! { dg-do run }
   2 !
   3 ! Run-time test for EVENT_TYPE
   4 !
   5 use iso_fortran_env, only: event_type
   6 implicit none
   7
   8 type(event_type), save, allocatable :: var(:)[:]
   9 integer :: count, stat
  10
  11 allocate(var(3)[*])
  12
  13 count = -42
  14 call event_query (var(1), count)
  15 if (count /= 0) call abort()
  16 call event_query (var(1), count)
  17 if (count /= 0) call abort()
  18 call event_query (var(2), count)
  19 if (count /= 0) call abort()
  20 call event_query (var(3), count)
  21 if (count /= 0) call abort()
  22
  23 stat = 99
  24 event post (var(2), stat=stat)
  25 if (stat /= 0) call abort()
  26 call event_query (var(1), count)
  27 if (count /= 0) call abort()
  28 call event_query(var(2), count, stat=stat)
  29 if (count /= 1 .or. stat /= 0) call abort()
  30 call event_query (var(3), count)
  31 if (count /= 0) call abort()
  32
  33 stat = 99
  34 event post (var(2)[this_image()])
  35 call event_query(var(1), count)
  36 if (count /= 0) call abort()
  37 call event_query(var(2), count)
  38 if (count /= 2) call abort()
  39 call event_query(var(2), count)
  40 if (count /= 2) call abort()
  41 call event_query(var(3), count)
  42 if (count /= 0) call abort()
  43
  44 stat = 99
  45 event wait (var(2))
  46 call event_query(var(1), count)
  47 if (count /= 0) call abort()
  48 call event_query(var(2), count)
  49 if (count /= 1) call abort()
  50 call event_query(var(3), count)
  51 if (count /= 0) call abort()
  52
  53 stat = 99
  54 event post (var(2))
  55 call event_query(var(1), count)
  56 if (count /= 0) call abort()
  57 call event_query(var(2), count)
  58 if (count /= 2) call abort()
  59 call event_query(var(3), count)
  60 if (count /= 0) call abort()
  61
  62 stat = 99
  63 event post (var(2))
  64 call event_query(var(1), count)
  65 if (count /= 0) call abort()
  66 call event_query(var(2), count)
  67 if (count /= 3) call abort()
  68 call event_query(var(3), count)
  69 if (count /= 0) call abort()
  70
  71 stat = 99
  72 event wait (var(2), until_count=2)
  73 call event_query(var(1), count)
  74 if (count /= 0) call abort()
  75 call event_query(var(2), count)
  76 if (count /= 1) call abort()
  77 call event_query(var(3), count)
  78 if (count /= 0) call abort()
  79
  80 stat = 99
  81 event wait (var(2), stat=stat, until_count=1)
  82 if (stat /= 0) call abort()
  83 call event_query(event=var(1), stat=stat, count=count)
  84 if (count /= 0 .or. stat /= 0) call abort()
  85 call event_query(event=var(2), stat=stat, count=count)
  86 if (count /= 0 .or. stat /= 0) call abort()
  87 call event_query(event=var(3), stat=stat, count=count)
  88 if (count /= 0 .or. stat /= 0) call abort()
  89 end