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

Add remaining checking for the FORM TEAM statement, complete and enable
a test.
This commit is contained in:
Peter Klausler 2025-03-19 11:59:59 -07:00 committed by GitHub
parent 1dc397deed
commit 3f04fb42aa
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 22 additions and 13 deletions

View File

@ -97,11 +97,15 @@ private:
};
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) {

View File

@ -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

View File

@ -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