diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index e5a01657e4a15..4d20d4670a9ac 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -3717,6 +3717,20 @@ void CheckHelper::CheckSymbolType(const Symbol &symbol) { "'%s' has a type %s with a deferred type parameter but is neither an allocatable nor an object pointer"_err_en_US, symbol.name(), dyType->AsFortran()); } + if (!symbol.has()) { + if (const DerivedTypeSpec * + derived{evaluate::GetDerivedTypeSpec(*dyType)}) { + if (IsEventTypeOrLockType(derived)) { + messages_.Say( + "Entity '%s' with EVENT_TYPE or LOCK_TYPE must be an object"_err_en_US, + symbol.name()); + } else if (auto iter{FindEventOrLockPotentialComponent(*derived)}) { + messages_.Say( + "Entity '%s' with EVENT_TYPE or LOCK_TYPE potential subobject component '%s' must be an object"_err_en_US, + symbol.name(), iter.BuildResultDesignatorName()); + } + } + } } } diff --git a/flang/test/Semantics/event02b.f90 b/flang/test/Semantics/event02b.f90 index 94971022878ac..0cf8c70b78415 100644 --- a/flang/test/Semantics/event02b.f90 +++ b/flang/test/Semantics/event02b.f90 @@ -18,6 +18,20 @@ program test_event_wait character(len=128) error_message, non_scalar_char(1), co_indexed_character[*], superfluous_errmsg logical invalid_type + type t + type(event_type) event + end type + !ERROR: Entity 'badfunc0' with EVENT_TYPE or LOCK_TYPE must be an object + procedure(type(event_type)) :: badfunc0 + !ERROR: Entity 'badfunc1' with EVENT_TYPE or LOCK_TYPE must be an object + procedure(type(event_type)), pointer :: badfunc1 + !ERROR: Entity 'badfunc2' with EVENT_TYPE or LOCK_TYPE potential subobject component '%event' must be an object + procedure(type(t)) badfunc2 + !ERROR: Entity 'badfunc3' with EVENT_TYPE or LOCK_TYPE must be an object + type(event_type), external :: badfunc3 + !ERROR: Entity 'badfunc4' with EVENT_TYPE or LOCK_TYPE potential subobject component '%event' must be an object + type(t), external :: badfunc4 + !____________________ non-standard-conforming statements __________________________ !_________________________ invalid event-variable ________________________________