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

[via flang-commits]

Author: Peter Klausler
Date: 2025-03-19T11:59:18-07:00
New Revision: abebac5b861b7e67dcd3e3adc1ec5b6c2172c06a

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

LOG: [flang] Dig deeper to find more EVENT_TYPE/LOCK_TYPE misuse (#130687)

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

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/event02b.f90

Removed: 
    


################################################################################
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 ________________________________