[flang-commits] [flang] [flang] Improve error message for polymorphic implicit interface (PR #177225)

[Peter Klausler via flang-commits]

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

PROCEDURE(CLASS(...)) specifies a procedure with an implicit interface whose result is polymorphic.  That turns out to never be a valid declaration, since a CLASS(...) function result is required to also be POINTER or ALLOCATABLE, both of which require the presence of an explicit interface.  We caught this error already, but the message should be improved for procedures.

Fixes https://github.com/llvm/llvm-project/issues/176861.

>From ca342b9e6edeaef767ee91555ab305709d930214 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 20 Jan 2026 16:26:56 -0800
Subject: [PATCH] [flang] Improve error message for polymorphic implicit
 interface

PROCEDURE(CLASS(...)) specifies a procedure with an implicit
interface whose result is polymorphic.  That turns out to never
be a valid declaration, since a CLASS(...) function result is required
to also be POINTER or ALLOCATABLE, both of which require the presence
of an explicit interface.  We caught this error already, but
the message should be improved for procedures.

Fixes https://github.com/llvm/llvm-project/issues/176861.
---
 flang/lib/Semantics/check-declarations.cpp | 12 +++++++++---
 flang/test/Semantics/declarations06.f90    |  8 ++++----
 2 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 684c1dcc98fa3..89fa488cced29 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -3862,9 +3862,15 @@ void CheckHelper::CheckSymbolType(const Symbol &symbol) {
   } else if (auto dyType{evaluate::DynamicType::From(relevant)}) {
     if (dyType->IsPolymorphic() && !dyType->IsAssumedType() &&
         !(IsDummy(symbol) && !IsProcedure(relevant))) { // C708
-      messages_.Say(
-          "CLASS entity '%s' must be a dummy argument, allocatable, or object pointer"_err_en_US,
-          symbol.name());
+      if (IsProcedure(symbol)) {
+        messages_.Say(
+            "Polymorphic function%s '%s' must have an explicit interface whose result is ALLOCATABLE or POINTER"_err_en_US,
+            IsPointer(symbol) ? " pointer" : "", symbol.name());
+      } else {
+        messages_.Say(
+            "CLASS entity '%s' must be a dummy argument, allocatable, or object pointer"_err_en_US,
+            symbol.name());
+      }
     }
     if (dyType->HasDeferredTypeParameter()) { // C702
       messages_.Say(
diff --git a/flang/test/Semantics/declarations06.f90 b/flang/test/Semantics/declarations06.f90
index ae9ef6acd7542..a490b8c3394fd 100644
--- a/flang/test/Semantics/declarations06.f90
+++ b/flang/test/Semantics/declarations06.f90
@@ -8,11 +8,11 @@ module m
   class(t) v1
   class(t), allocatable :: v2 ! ok
   class(t), pointer :: v3 ! ok
-  !ERROR: CLASS entity 'p1' must be a dummy argument, allocatable, or object pointer
+  !ERROR: Polymorphic function 'p1' must have an explicit interface whose result is ALLOCATABLE or POINTER
   procedure(cf1) :: p1
   procedure(cf2) :: p2
   procedure(cf3) :: p3
-  !ERROR: CLASS entity 'pp1' must be a dummy argument, allocatable, or object pointer
+  !ERROR: Polymorphic function pointer 'pp1' must have an explicit interface whose result is ALLOCATABLE or POINTER
   procedure(cf1), pointer :: pp1
   procedure(cf2), pointer :: pp2
   procedure(cf3), pointer :: pp3
@@ -29,9 +29,9 @@ class(t) function cf3()
   end
   subroutine test(d1,d2,d3)
     class(t) d1 ! ok
-    !ERROR: CLASS entity 'd2' must be a dummy argument, allocatable, or object pointer
+    !ERROR: Polymorphic function 'd2' must have an explicit interface whose result is ALLOCATABLE or POINTER
     class(t), external :: d2
-    !ERROR: CLASS entity 'd3' must be a dummy argument, allocatable, or object pointer
+    !ERROR: Polymorphic function pointer 'd3' must have an explicit interface whose result is ALLOCATABLE or POINTER
     class(t), external, pointer :: d3
   end
   function cf4()