flang/test/Semantics/event02b.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! This test checks for semantic errors in event wait statements based on the
   3 ! statement specification in section 11.6.8 of the Fortran 2018 standard.
   4 ! Some of the errors in this test would be hidden by the errors in
   5 ! the test event02a.f90 if they were included in that file,
   6 ! and are thus tested here.
   7
   8 program test_event_wait
   9   use iso_fortran_env, only : event_type
  10   implicit none
  11
  12   ! event_type variables must be coarrays
  13   type(event_type) non_coarray
  14
  15   type(event_type) concert[*], occurrences(2)[*]
  16   integer threshold, indexed(1), non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
  17   character(len=128) error_message, non_scalar_char(1), co_indexed_character[*], superfluous_errmsg
  18   logical invalid_type
  19
  20   !____________________ non-standard-conforming statements __________________________
  21
  22   !_________________________ invalid event-variable ________________________________
  23
  24   !ERROR: The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV
  25   event wait(non_event)
  26
  27   !ERROR: The event-variable must be a coarray
  28   event wait(non_coarray)
  29
  30   !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object
  31   event wait(concert[1])
  32
  33   !ERROR: A event-variable in a EVENT WAIT statement may not be a coindexed object
  34   event wait(occurrences(1)[1])
  35
  36   !ERROR: Must be a scalar value, but is a rank-1 array
  37   event wait(occurrences)
  38
  39   !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
  40
  41   !ERROR: Must have INTEGER type, but is LOGICAL(4)
  42   event wait(concert, until_count=invalid_type)
  43
  44   !ERROR: Must be a scalar value, but is a rank-1 array
  45   event wait(concert, until_count=non_scalar)
  46
  47   !_________________ invalid sync-stat-lists: invalid stat= ________________________
  48
  49   !ERROR: Must have INTEGER type, but is LOGICAL(4)
  50   event wait(concert, stat=invalid_type)
  51
  52   !ERROR: Must be a scalar value, but is a rank-1 array
  53   event wait(concert, stat=non_scalar)
  54
  55   !________________ invalid sync-stat-lists: invalid errmsg= _______________________
  56
  57   !ERROR: Must have CHARACTER type, but is LOGICAL(4)
  58   event wait(concert, errmsg=invalid_type)
  59
  60   !ERROR: Must be a scalar value, but is a rank-1 array
  61   event wait(concert, errmsg=non_scalar_char)
  62
  63   !______ invalid event-wait-spec-lists: redundant event-wait-spec-list ____________
  64
  65   !ERROR: Until-spec in a event-wait-spec-list may not be repeated
  66   event wait(concert, until_count=threshold, until_count=indexed(1))
  67
  68   !ERROR: Until-spec in a event-wait-spec-list may not be repeated
  69   event wait(concert, until_count=threshold, stat=sync_status, until_count=indexed(1))
  70
  71   !ERROR: Until-spec in a event-wait-spec-list may not be repeated
  72   event wait(concert, until_count=threshold, errmsg=error_message, until_count=indexed(1))
  73
  74   !ERROR: Until-spec in a event-wait-spec-list may not be repeated
  75   event wait(concert, until_count=threshold, stat=sync_status, errmsg=error_message, until_count=indexed(1))
  76
  77   !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
  78   event wait(concert, stat=sync_status, stat=superfluous_stat)
  79
  80   !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
  81   event wait(concert, stat=sync_status, until_count=threshold, stat=superfluous_stat)
  82
  83   !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
  84   event wait(concert, stat=sync_status, errmsg=error_message, stat=superfluous_stat)
  85
  86   !ERROR: A stat-variable in a event-wait-spec-list may not be repeated
  87   event wait(concert, stat=sync_status, until_count=threshold, errmsg=error_message, stat=superfluous_stat)
  88
  89   !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
  90   event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg)
  91
  92   !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
  93   event wait(concert, errmsg=error_message, until_count=threshold, errmsg=superfluous_errmsg)
  94
  95   !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
  96   event wait(concert, errmsg=error_message, stat=superfluous_stat, errmsg=superfluous_errmsg)
  97
  98   !ERROR: A errmsg-variable in a event-wait-spec-list may not be repeated
  99   event wait(concert, errmsg=error_message, until_count=threshold, stat=superfluous_stat, errmsg=superfluous_errmsg)
 100
 101   !_____________ invalid sync-stat-lists: coindexed stat-variable - C1173 __________________
 102
 103   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 104   event wait(concert, stat=co_indexed_integer[1])
 105
 106   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 107   event wait(concert, errmsg=co_indexed_character[1])
 108
 109   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 110   event wait(concert, stat=co_indexed_integer[1], errmsg=error_message)
 111
 112   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 113   event wait(concert, stat=sync_status, errmsg=co_indexed_character[1])
 114
 115   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 116   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 117   event wait(concert, stat=co_indexed_integer[1], errmsg=co_indexed_character[1])
 118
 119   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 120   !ERROR: The stat-variable or errmsg-variable in a event-wait-spec-list may not be a coindexed object
 121   event wait(concert, errmsg=co_indexed_character[1], stat=co_indexed_integer[1])
 122
 123 end program test_event_wait