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

[via flang-commits]

Author: Peter Klausler
Date: 2025-03-19T11:59:59-07:00
New Revision: 3f04fb42aa54c15e21c81c12bb8afb128d859eee

URL: https://github.com/llvm/llvm-project/commit/3f04fb42aa54c15e21c81c12bb8afb128d859eee
DIFF: https://github.com/llvm/llvm-project/commit/3f04fb42aa54c15e21c81c12bb8afb128d859eee.diff

LOG: [flang] Complete semantic checks for FORM TEAM (#131022)

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

Added: 
    

Modified: 
    flang/lib/Semantics/check-coarray.cpp
    flang/test/Semantics/form_team01a.f90
    flang/test/Semantics/form_team01b.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index 789f3449772ca..9dd287e9d2495 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -97,11 +97,15 @@ class ChangeTeamBodyEnforce {
 };
 
 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);
     }
   }
 }
@@ -389,7 +393,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