[flang] Fix bug that disallows coindexed-object in event-post-stmt

[ktras]

Summary

Fix bug in check for constraint C1604. The bug disallows the
event-variable in an event-post-stmt to be a coindexed-object, which
is allowed by the standard. Fix event-post-stmt and event-wait-stmt
tests so that the type of error that hides other errors are isolated
in one test, leaving one test with only standard conforming
statements. This change in testing makes it possible to check
that an event-variable in an event-post-stmt that is a
coindexed-object is now accepted by the compiler after this bugfix.

[PeteSteinfeld]

Thanks, for working on this, @krtras.

All builds and tests correctly and looks good.

[ktras]

Thanks for the review, @PeteSteinfeld. You have requested changes to this revision but from the text of your comment, it seems like you accidentally requested changes. If you did mean to request changes, please let me know what needs to be updated.

[PeteSteinfeld]

Oops. You're correct @ktras. This patch is good to go.

[PeteSteinfeld]

Thanks for working on this, but this code doesn't work for arrays of coarrays. Here's a test case that shows the problem:

Program bug
  Use Iso_Fortran_Env
  Implicit None
  Integer i
  Type(event_type) :: ev(2)[*]
  If (This_Image()==Num_Images()) Then
    Do i=1,Size(ev)
      Event Post (ev(i)[1])
    End Do
  End If
End Program

flang/lib/Semantics/check-coarray.cpp

 }
 
 static void CheckEventVariable(
     SemanticsContext &context, const parser::EventVariable &eventVar) {
   if (const auto *expr{GetExpr(context, eventVar)}) {
     if (!IsEventType(evaluate::GetDerivedTypeSpec(expr->GetType()))) { // C1176
       context.Say(parser::FindSourceLocation(eventVar),
           "The event-variable must be of type EVENT_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
-    } else if (!evaluate::IsCoarray(*expr)) { // C1604
+    } else if (!evaluate::IsCoarray(
+                   *evaluate::UnwrapWholeSymbolOrComponentOrCoarrayRef(
+                       *expr))) { // C1604
       context.Say(parser::FindSourceLocation(eventVar),
           "The event-variable must be a coarray"_err_en_US);
     }
   }
 }
 
 void CoarrayChecker::Leave(const parser::ChangeTeamStmt &x) {
   CheckNamesAreDistinct(std::get<std::list<parser::CoarrayAssociation>>(x.t));

flang/test/Semantics/event01a.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! This test checks for semantic errors in event post statements based on the
-! statement specification in section 11.6.7 of the Fortran 2018 standard.
+! This test checks that standard conforming event post statements,
+! based on the statement specification in section 11.6.7 of the
+! Fortran 2018 standard, are accepted by the compiler.
 
 program test_event_post
   use iso_fortran_env, only : event_type
   implicit none
 
-  ! event_type variables must be coarrays
-  type(event_type) non_coarray
-
   type(event_type) concert[*], occurrences(2)[*]
-  integer non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
-  character(len=128) error_message, co_indexed_character[*], superfluous_errmsg
-  logical invalid_type
+  integer sync_status
+  character(len=128) error_message
 
   !___ standard-conforming statements ___
 
   event post(concert)
   event post(concert[1])
   event post(occurrences(1))
   event post(occurrences(1)[1])
   event post(concert, stat=sync_status)
   event post(concert,                   errmsg=error_message)
   event post(concert, stat=sync_status, errmsg=error_message)
 
-  !___ non-standard-conforming statements ___
-
-  !______ invalid event-variable ____________________________
-
-  ! event-variable has an unknown keyword argument
-  !ERROR: expected ')'
-  event post(event=concert)
-
-  !______ invalid sync-stat-lists: invalid stat= ____________
-
-  ! Invalid stat-variable keyword
-  !ERROR: expected ')'
-  event post(concert, status=sync_status)
-
-  ! Invalid sync-stat-list: missing stat-variable
-  !ERROR: expected ')'
-  event post(concert, stat)
-
-  ! Invalid sync-stat-list: missing 'stat='
-  !ERROR: expected ')'
-  event post(concert, sync_status)
-
-  !______ invalid sync-stat-lists: invalid errmsg= ____________
-
-  ! Invalid errmsg-variable keyword
-  !ERROR: expected ')'
-  event post(concert, errormsg=error_message)
-
-  ! Invalid sync-stat-list: missing 'errmsg='
-  !ERROR: expected ')'
-  event post(concert, error_message)
-
-  ! Invalid sync-stat-list: missing errmsg-variable
-  !ERROR: expected ')'
-  event post(concert, errmsg)
-
-  !______ invalid event-variable: redundant event-variable ____________
-
-  ! Too many arguments
-  !ERROR: expected ')'
-  event post(concert, occurrences(1))
-
-  ! Too many arguments
-  !ERROR: expected ')'
-  event post(concert, occurrences(1), stat=sync_status, errmsg=error_message)
-
 end program test_event_post

flang/test/Semantics/event01c.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! This test checks for semantic errors in event post statements based on the
+! statement specification in section 11.6.7 of the Fortran 2018 standard.
+
+program test_event_post
+  use iso_fortran_env, only : event_type
+  implicit none
+
+  type(event_type) concert[*], occurrences(2)[*]
+  integer non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
+  character(len=128) error_message, co_indexed_character[*], superfluous_errmsg
+  logical invalid_type
+
+  !___ non-standard-conforming statements ___
+
+  !______ invalid event-variable ____________________________
+
+  ! event-variable has an unknown keyword argument
+  !ERROR: expected '('
+  event post(event=concert)
+
+  !______ invalid sync-stat-lists: invalid stat= ____________
+
+  ! Invalid stat-variable keyword
+  !ERROR: expected '('
+  event post(concert, status=sync_status)
+
+  ! Invalid sync-stat-list: missing stat-variable
+  !ERROR: expected '('
+  event post(concert, stat)
+
+  ! Invalid sync-stat-list: missing 'stat='
+  !ERROR: expected '('
+  event post(concert, sync_status)
+
+  !______ invalid sync-stat-lists: invalid errmsg= ____________
+
+  ! Invalid errmsg-variable keyword
+  !ERROR: expected '('
+  event post(concert, errormsg=error_message)
+
+  ! Invalid sync-stat-list: missing 'errmsg='
+  !ERROR: expected '('
+  event post(concert, error_message)
+
+  ! Invalid sync-stat-list: missing errmsg-variable
+  !ERROR: expected '('
+  event post(concert, errmsg)
+
+  !______ invalid event-variable: redundant event-variable ____________
+
+  ! Too many arguments
+  !ERROR: expected '('
+  event post(concert, occurrences(1))
+
+  ! Too many arguments
+  !ERROR: expected '('
+  event post(concert, occurrences(1), stat=sync_status, errmsg=error_message)
+
+end program test_event_post

flang/test/Semantics/event02a.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! This test checks for semantic errors in event wait statements based on the
-! statement specification in section 11.6.8 of the Fortran 2018 standard.
+! This test checks that standard conforming event wait statements,
+! based on the statement specification in section 11.6.8 of the
+! Fortran 2018 standard, are accepted by the compiler.
 
 program test_event_wait
   use iso_fortran_env, only : event_type
   implicit none
 
-  ! event_type variables must be coarrays
-  type(event_type) non_coarray
-
   type(event_type) concert[*], occurrences(2)[*]
-  integer threshold, indexed(1), non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
-  character(len=128) error_message, non_scalar_char(1), co_indexed_character[*], superfluous_errmsg
-  logical invalid_type
+  integer threshold, indexed(1), sync_status, co_indexed_integer[*]
+  character(len=128) error_message
 
   !_______________________ standard-conforming statements ___________________________
 
   event wait(concert)
   event wait(occurrences(1))
   event wait(concert, until_count=threshold)
   event wait(concert, until_count=indexed(1))
   event wait(concert, until_count=co_indexed_integer[1])
   event wait(concert,                        stat=sync_status)
   event wait(concert, until_count=threshold, stat=sync_status)
   event wait(concert,                                          errmsg=error_message)
   event wait(concert, until_count=threshold,                   errmsg=error_message)
   event wait(concert,                        stat=sync_status, errmsg=error_message)
   event wait(concert, until_count=threshold, stat=sync_status, errmsg=error_message)
 
-  !____________________ non-standard-conforming statements __________________________
-
-  !_________________________ invalid event-variable ________________________________
-
-  ! event-variable has an unknown expression
-  !ERROR: expected ')'
-  event wait(event=concert)
-
-  !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
-
-  ! Invalid until-spec keyword
-  !ERROR: expected ')'
-  event wait(concert, until_amount=threshold)
-
-  ! Invalid until-spec: missing until-spec variable
-  !ERROR: expected ')'
-  event wait(concert, until_count)
-
-  ! Invalid until-spec: missing 'until_count='
-  !ERROR: expected ')'
-  event wait(concert, threshold)
-
-  !_________________ invalid sync-stat-lists: invalid stat= ________________________
-
-  ! Invalid stat-variable keyword
-  !ERROR: expected ')'
-  event wait(concert, status=sync_status)
-
-  ! Invalid sync-stat-list: missing stat-variable
-  !ERROR: expected ')'
-  event wait(concert, stat)
-
-  ! Invalid sync-stat-list: missing 'stat='
-  !ERROR: expected ')'
-  event wait(concert, sync_status)
-
-  !________________ invalid sync-stat-lists: invalid errmsg= _______________________
-
-  ! Invalid errmsg-variable keyword
-  !ERROR: expected ')'
-  event wait(concert, errormsg=error_message)
-
-  ! Invalid sync-stat-list: missing 'errmsg='
-  !ERROR: expected ')'
-  event wait(concert, error_message)
-
-  ! Invalid sync-stat-list: missing errmsg-variable
-  !ERROR: expected ')'
-  event wait(concert, errmsg)
-
-  !______________ invalid event-variable: redundant event-variable _________________
-
-  !ERROR: expected ')'
-  event wait(concert, occurrences(1))
-
-  !ERROR: expected ')'
-  event wait(concert, occurrences(1), stat=sync_status, errmsg=error_message)
-
 end program test_event_wait

flang/test/Semantics/event02c.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! This test checks for semantic errors in event wait statements based on the
+! statement specification in section 11.6.8 of the Fortran 2018 standard.
+
+program test_event_wait
+  use iso_fortran_env, only : event_type
+  implicit none
+
+  type(event_type) concert[*], occurrences(2)[*]
+  integer threshold, indexed(1), non_event[*], sync_status, co_indexed_integer[*], superfluous_stat, non_scalar(1)
+  character(len=128) error_message, non_scalar_char(1), co_indexed_character[*], superfluous_errmsg
+  logical invalid_type
+
+  !____________________ non-standard-conforming statements __________________________
+
+  !_________________________ invalid event-variable ________________________________
+
+  ! event-variable has an unknown expression
+  !ERROR: expected '('
+  event wait(event=concert)
+
+  !_____________ invalid event-wait-spec-lists: invalid until-spec _________________
+
+  ! Invalid until-spec keyword
+  !ERROR: expected '('
+  event wait(concert, until_amount=threshold)
+
+  ! Invalid until-spec: missing until-spec variable
+  !ERROR: expected '('
+  event wait(concert, until_count)
+
+  ! Invalid until-spec: missing 'until_count='
+  !ERROR: expected '('
+  event wait(concert, threshold)
+
+  !_________________ invalid sync-stat-lists: invalid stat= ________________________
+
+  ! Invalid stat-variable keyword
+  !ERROR: expected '('
+  event wait(concert, status=sync_status)
+
+  ! Invalid sync-stat-list: missing stat-variable
+  !ERROR: expected '('
+  event wait(concert, stat)
+
+  ! Invalid sync-stat-list: missing 'stat='
+  !ERROR: expected '('
+  event wait(concert, sync_status)
+
+  !________________ invalid sync-stat-lists: invalid errmsg= _______________________
+
+  ! Invalid errmsg-variable keyword
+  !ERROR: expected '('
+  event wait(concert, errormsg=error_message)
+
+  ! Invalid sync-stat-list: missing 'errmsg='
+  !ERROR: expected '('
+  event wait(concert, error_message)
+
+  ! Invalid sync-stat-list: missing errmsg-variable
+  !ERROR: expected '('
+  event wait(concert, errmsg)
+
+  !______________ invalid event-variable: redundant event-variable _________________
+
+  !ERROR: expected '('
+  event wait(concert, occurrences(1))
+
+  !ERROR: expected '('
+  event wait(concert, occurrences(1), stat=sync_status, errmsg=error_message)
+
+end program test_event_wait