[flang-commits] [flang] [flang] Dig deeper to find more EVENT_TYPE/LOCK_TYPE misuse (PR #130687)

[Peter Klausler via flang-commits]

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

Only objects may have these types, or have potential subobject components with these types.

>From 07fae8c23a5144f33877f9f0505f7536d1fbfd56 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 10 Mar 2025 16:45:19 -0700
Subject: [PATCH] [flang] Dig deeper to find more EVENT_TYPE/LOCK_TYPE misuse

Only objects may have these types, or have potential subobject components
with these types.
---
 flang/lib/Semantics/check-declarations.cpp | 14 ++++++++++++++
 flang/test/Semantics/event02b.f90          | 14 ++++++++++++++
 2 files changed, 28 insertions(+)

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<ObjectEntityDetails>()) {
+      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 ________________________________