[flang-commits] [flang] [flang] Complete semantic checks for FORM TEAM (PR #131022)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/131022

Add remaining checking for the FORM TEAM statement, complete and enable a test.

>From 2ac85304463468e3665b5644f9276dba44e96222 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 12 Mar 2025 13:28:50 -0700
Subject: [PATCH] [flang] Complete semantic checks for FORM TEAM

Add remaining checking for the FORM TEAM statement, complete
and enable a test.
---
 flang/lib/Semantics/check-coarray.cpp | 16 ++++++++++++++--
 flang/test/Semantics/form_team01a.f90 |  2 +-
 flang/test/Semantics/form_team01b.f90 | 17 +++++++----------
 3 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index 833a08899308a..6548e262468c9 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -64,11 +64,15 @@ class CriticalBodyEnforce {
 };
 
 template <typename T>
-static void CheckTeamType(SemanticsContext &context, const T &x) {
+static void CheckTeamType(
+    SemanticsContext &context, const T &x, bool mustBeVariable = false) {
   if (const auto *expr{GetExpr(context, x)}) {
     if (!IsTeamType(evaluate::GetDerivedTypeSpec(expr->GetType()))) {
       context.Say(parser::FindSourceLocation(x), // C1114
           "Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV"_err_en_US);
+    } else if (mustBeVariable && !IsVariable(*expr)) {
+      context.Say(parser::FindSourceLocation(x),
+          "Team must be a variable in this context"_err_en_US);
     }
   }
 }
@@ -356,7 +360,15 @@ void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
 }
 
 void CoarrayChecker::Leave(const parser::FormTeamStmt &x) {
-  CheckTeamType(context_, std::get<parser::TeamVariable>(x.t));
+  CheckTeamType(
+      context_, std::get<parser::TeamVariable>(x.t), /*mustBeVariable=*/true);
+  for (const auto &spec :
+      std::get<std::list<parser::FormTeamStmt::FormTeamSpec>>(x.t)) {
+    if (const auto *statOrErrmsg{std::get_if<parser::StatOrErrmsg>(&spec.u)}) {
+      CheckCoindexedStatOrErrmsg(
+          context_, *statOrErrmsg, "form-team-spec-list");
+    }
+  }
 }
 
 void CoarrayChecker::Enter(const parser::CriticalConstruct &x) {
diff --git a/flang/test/Semantics/form_team01a.f90 b/flang/test/Semantics/form_team01a.f90
index 4dd60305305a9..2593dc999d05a 100644
--- a/flang/test/Semantics/form_team01a.f90
+++ b/flang/test/Semantics/form_team01a.f90
@@ -1,5 +1,5 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! Check for semantic errors in form team statements
+! Check for parsing errors in form team statements
 ! This subtest contains syntactic tests that prevent the main tests from being emitted.
 
 subroutine test
diff --git a/flang/test/Semantics/form_team01b.f90 b/flang/test/Semantics/form_team01b.f90
index ba14240c64e69..fd0443ac27165 100644
--- a/flang/test/Semantics/form_team01b.f90
+++ b/flang/test/Semantics/form_team01b.f90
@@ -1,5 +1,4 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
-! XFAIL: *
 ! Check for semantic errors in form team statements
 ! This subtest contains tests for unimplemented errors.
 
@@ -7,15 +6,13 @@ subroutine test
   use, intrinsic :: iso_fortran_env, only: team_type
   type(team_type) :: team
   integer :: team_number
-  integer, codimension[*] :: co_statvar
-  character(len=50), codimension[*] :: co_errvar
-
-  ! Semantically invalid invocations.
-  ! argument 'stat' shall not be a coindexed object
-  !ERROR: to be determined
+  integer, save, codimension[*] :: co_statvar
+  character(len=50), save, codimension[*] :: co_errvar
+  procedure(type(team_type)) teamfunc
+  !ERROR: The stat-variable or errmsg-variable in a form-team-spec-list may not be a coindexed object
   FORM TEAM (team_number, team, STAT=co_statvar[this_image()])
-  ! argument 'errmsg' shall not be a coindexed object
-  !ERROR: to be determined
+  !ERROR: The stat-variable or errmsg-variable in a form-team-spec-list may not be a coindexed object
   FORM TEAM (team_number, team, ERRMSG=co_errvar[this_image()])
-
+  !ERROR: Team must be a variable in this context
+  form team (team_number, teamfunc())
 end subroutine