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   ! event-variable must be event_type
  25   event wait(non_event)
  26
  27   ! event-variable must be a coarray
  28   event wait(non_coarray)
  29
  30   ! event-variable must not be coindexed
  31   event wait(concert[1])
  32
  33   ! event-variable must not be coindexed
  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   ! No specifier shall appear more than once in a given event-wait-spec-list
  66   event wait(concert, until_count=threshold, until_count=indexed(1))
  67
  68   ! No specifier shall appear more than once in a given event-wait-spec-list
  69   event wait(concert, stat=sync_status, stat=superfluous_stat)
  70
  71   ! No specifier shall appear more than once in a given event-wait-spec-list
  72   event wait(concert, errmsg=error_message, errmsg=superfluous_errmsg)
  73
  74   !_____________ invalid sync-stat-lists: coindexed stat-variable __________________
  75
  76   ! Check constraint C1173 from the Fortran 2018 standard
  77   event wait(concert, stat=co_indexed_integer[1])
  78
  79   ! Check constraint C1173 from the Fortran 2018 standard
  80   event wait(concert, errmsg=co_indexed_character[1])
  81
  82 end program test_event_wait