mirrors/llvm-project
0
0
Fork 0
mirror of https://github.com/llvm/llvm-project.git synced 2025-04-18 19:06:44 +00:00
Code Issues Projects Releases Wiki Activity

[flang] Recognize and check EVENT_QUERY (#123429)

Browse Source 
Recognize the intrinsic subroutine EVENT_QUERY and enforce semantic
requirements on calls to it.
This commit is contained in:
Peter Klausler 2025-01-27 11:56:41 -08:00 committed by GitHub
parent 2e5a5237da
commit 1e9b60cfa4
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 71 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
flang/lib/Evaluate/intrinsics.cpp
View File

@ -96,6 +96,7 @@ ENUM_CLASS(KindCode, none, defaultIntegerKind,
typeless, // BOZ literals are INTEGER with this kind
ieeeFlagType, // IEEE_FLAG_TYPE from ISO_FORTRAN_EXCEPTION
ieeeRoundType, // IEEE_ROUND_TYPE from ISO_FORTRAN_ARITHMETIC
eventType, // EVENT_TYPE from module ISO_FORTRAN_ENV (for coarrays)
teamType, // TEAM_TYPE from module ISO_FORTRAN_ENV (for coarrays)
kindArg, // this argument is KIND=
effectiveKind, // for function results: "kindArg" value, possibly defaulted
@ -129,6 +130,7 @@ static constexpr TypePattern DefaultChar{CharType, KindCode::defaultCharKind};
static constexpr TypePattern DefaultLogical{
LogicalType, KindCode::defaultLogicalKind};
static constexpr TypePattern BOZ{IntType, KindCode::typeless};
static constexpr TypePattern EventType{DerivedType, KindCode::eventType};
static constexpr TypePattern IeeeFlagType{DerivedType, KindCode::ieeeFlagType};
static constexpr TypePattern IeeeRoundType{
DerivedType, KindCode::ieeeRoundType};
@ -1471,6 +1473,13 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"time", TypePattern{RealType, KindCode::exactKind, 4},
Rank::scalar, Optionality::required, common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"event_query",
{{"event", EventType, Rank::scalar},
{"count", AnyInt, Rank::scalar, Optionality::required,
common::Intent::Out},
{"stat", AnyInt, Rank::scalar, Optionality::optional,
common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"execute_command_line",
{{"command", DefaultChar, Rank::scalar},
{"wait", AnyLogical, Rank::scalar, Optionality::optional},
@ -1592,7 +1601,6 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
};
// TODO: Intrinsic subroutine EVENT_QUERY
// TODO: Collective intrinsic subroutines: co_reduce
// Finds a built-in derived type and returns it as a DynamicType.
@ -1968,6 +1976,11 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case KindCode::typeless:
argOk = false;
break;
case KindCode::eventType:
argOk = !type->IsUnlimitedPolymorphic() &&
type->category() == TypeCategory::Derived &&
semantics::IsEventType(&type->GetDerivedTypeSpec());
break;
case KindCode::ieeeFlagType:
argOk = !type->IsUnlimitedPolymorphic() &&
type->category() == TypeCategory::Derived &&
@ -3239,7 +3252,7 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
"Argument of ALLOCATED() must be an ALLOCATABLE object or component"_err_en_US);
}
} else if (name == "atomic_add" || name == "atomic_and" ||
name == "atomic_or" || name == "atomic_xor") {
name == "atomic_or" || name == "atomic_xor" || name == "event_query") {
return CheckForCoindexedObject(
context.messages(), call.arguments[2], name, "stat");
} else if (name == "atomic_cas") {

32
flang/lib/Semantics/check-call.cpp
View File

@ -1616,6 +1616,36 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
}
}
// EVENT_QUERY (F'2023 16.9.82)
static void CheckEvent_Query(evaluate::ActualArguments &arguments,
evaluate::FoldingContext &foldingContext) {
if (arguments.size() > 0 && arguments[0] &&
ExtractCoarrayRef(*arguments[0]).has_value()) {
foldingContext.messages().Say(arguments[0]->sourceLocation(),
"EVENT= argument to EVENT_QUERY must not be coindexed"_err_en_US);
}
if (arguments.size() > 1 && arguments[1]) {
if (auto dyType{arguments[1]->GetType()}) {
int defaultInt{
foldingContext.defaults().GetDefaultKind(TypeCategory::Integer)};
if (dyType->category() == TypeCategory::Integer &&
dyType->kind() < defaultInt) {
foldingContext.messages().Say(arguments[1]->sourceLocation(),
"COUNT= argument to EVENT_QUERY must be an integer with kind >= %d"_err_en_US,
defaultInt);
}
}
}
if (arguments.size() > 2 && arguments[2]) {
if (auto dyType{arguments[2]->GetType()}) {
if (dyType->category() == TypeCategory::Integer && dyType->kind() < 2) {
foldingContext.messages().Say(arguments[2]->sourceLocation(),
"STAT= argument to EVENT_QUERY must be an integer with kind >= 2 when present"_err_en_US);
}
}
}
}
// IMAGE_INDEX (F'2023 16.9.107)
static void CheckImage_Index(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
@ -1952,6 +1982,8 @@ static void CheckSpecificIntrinsic(const characteristics::Procedure &proc,
const Scope *scope, const evaluate::SpecificIntrinsic &intrinsic) {
if (intrinsic.name == "associated") {
CheckAssociated(arguments, context, scope);
} else if (intrinsic.name == "event_query") {
CheckEvent_Query(arguments, context.foldingContext());
} else if (intrinsic.name == "image_index") {
CheckImage_Index(arguments, context.foldingContext().messages());
} else if (intrinsic.name == "max" || intrinsic.name == "min") {

32
flang/test/Semantics/event_query.f90
View File

@ -1,14 +1,10 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
! XFAIL: *
! This test checks for semantic errors in event_query() subroutine based on the
! statement specification in section 16.9.72 of the Fortran 2018 standard.
program test_event_query
use iso_fortran_env, only : event_type
implicit none
! event_type variables must be coarrays
type(event_type) non_coarray
implicit none(type,external)
type(event_type) concert[*], occurrences(2)[*]
integer non_event[*], counter, array(1), coarray[*], sync_status, coindexed[*], non_scalar(1)
@ -33,70 +29,90 @@ program test_event_query
!___ non-standard-conforming calls _______
! event-variable must be event_type
! ERROR: Actual argument for 'event=' has bad type 'INTEGER(4)'
call event_query(non_event, counter)
! event-variable must be a coarray
call event_query(non_coarray, counter)
! event-variable must be a scalar variable
! ERROR: 'event=' argument has unacceptable rank 1
call event_query(occurrences, counter)
! event-variable must not be coindexed
! ERROR: EVENT= argument to EVENT_QUERY must not be coindexed
call event_query(concert[1], counter)
! event-variable has an unknown keyword argument
! ERROR: unknown keyword argument to intrinsic 'event_query'
call event_query(events=concert, count=counter)
! event-variable has an argument mismatch
! ERROR: Actual argument for 'event=' has bad type 'INTEGER(4)'
call event_query(event=non_event, count=counter)
! count must be an integer
! ERROR: Actual argument for 'count=' has bad type 'LOGICAL(4)'
call event_query(concert, non_integer)
! count must be an integer scalar
! ERROR: 'count=' argument has unacceptable rank 1
call event_query(concert, non_scalar)
! count must be have a decimal exponent range
! no smaller than that of default integer
! ERROR: COUNT= argument to EVENT_QUERY must be an integer with kind >= 4
call event_query(concert, non_default)
! count is an intent(out) argument
! ERROR: Actual argument associated with INTENT(OUT) dummy argument 'count=' is not definable
! ERROR: '4_4' is not a variable or pointer
call event_query(concert, 4)
! count has an unknown keyword argument
! ERROR: unknown keyword argument to intrinsic 'event_query'
call event_query(concert, counts=counter)
! count has an argument mismatch
! ERROR: Actual argument for 'count=' has bad type 'LOGICAL(4)'
call event_query(concert, count=non_integer)
! stat must be an integer
! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
call event_query(concert, counter, non_integer)
! stat must be an integer scalar
! ERROR: 'stat=' argument has unacceptable rank 1
call event_query(concert, counter, non_scalar)
! stat is an intent(out) argument
! ERROR: Actual argument associated with INTENT(OUT) dummy argument 'stat=' is not definable
! ERROR: '8_4' is not a variable or pointer
call event_query(concert, counter, 8)
! stat has an unknown keyword argument
! ERROR: unknown keyword argument to intrinsic 'event_query'
call event_query(concert, counter, status=sync_status)
! stat has an argument mismatch
! ERROR: Actual argument for 'stat=' has bad type 'LOGICAL(4)'
call event_query(concert, counter, stat=non_integer)
! stat must not be coindexed
! ERROR: 'stat' argument to 'event_query' may not be a coindexed object
call event_query(concert, counter, coindexed[1])
! Too many arguments
! ERROR: too many actual arguments for intrinsic 'event_query'
call event_query(concert, counter, sync_status, array(1))
! Repeated event keyword
! ERROR: repeated keyword argument to intrinsic 'event_query'
call event_query(event=concert, event=occurrences(1), count=counter)
! Repeated count keyword
! ERROR: repeated keyword argument to intrinsic 'event_query'
call event_query(event=concert, count=counter, count=array(1))
! Repeated stat keyword
! ERROR: repeated keyword argument to intrinsic 'event_query'
call event_query(event=concert, count=counter, stat=sync_status, stat=array(1))
end program test_event_query