From 1ebffee76f33dea38a5cec77d90ceb60c4f6ef70 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Tue, 2 Sep 2025 11:00:52 -0700
Subject: [PATCH] [flang] Fix false errors in function result derived type
 checking

When checking function result types that are implicitly declared at
their pointer of use against the actual definitions of those functions
(when available), be sure to use the type equivalence checker that
allows for USE association and sequence type equivalence.
---
 flang/lib/Semantics/resolve-names.cpp |  9 +++-
 flang/test/Semantics/global03.f90     | 73 +++++++++++++++++++++++++++
 2 files changed, 81 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Semantics/global03.f90

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b6b6fc7642a62..4720932780472 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2695,9 +2695,16 @@ void ArraySpecVisitor::PostAttrSpec() {
 
 FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
 
+// True when either type is absent, or if they are both present and are
+// equivalent for interface compatibility purposes.
 static bool TypesMismatchIfNonNull(
     const DeclTypeSpec *type1, const DeclTypeSpec *type2) {
-  return type1 && type2 && *type1 != *type2;
+  if (auto t1{evaluate::DynamicType::From(type1)}) {
+    if (auto t2{evaluate::DynamicType::From(type2)}) {
+      return !t1->IsEquivalentTo(*t2);
+    }
+  }
+  return false;
 }
 
 void FuncResultStack::CompleteFunctionResultType() {
diff --git a/flang/test/Semantics/global03.f90 b/flang/test/Semantics/global03.f90
new file mode 100644
index 0000000000000..f9da150d59c79
--- /dev/null
+++ b/flang/test/Semantics/global03.f90
@@ -0,0 +1,73 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
+! Catch discrepancies between implicit result types and a global definition,
+! allowing for derived types and type equivalence.
+
+module m
+  type t1
+    integer n
+  end type
+  type t2
+    real a
+  end type
+  type t3
+    sequence
+    integer n
+  end type
+end
+
+function xfunc1()
+  use m
+  type(t1) xfunc1
+  xfunc1%n = 123
+end
+
+function yfunc1()
+  use m
+  type(t1) yfunc1
+  yfunc1%n = 123
+end
+
+function zfunc1()
+  type t3
+    sequence
+    integer n
+  end type
+  type(t3) zfunc1
+  zfunc1%n = 123
+end
+
+program main
+  use m
+  implicit type(t1) (x)
+  implicit type(t2) (y)
+  implicit type(t3) (z)
+  print *, xfunc1() ! ok
+  print *, xfunc2() ! ok
+!ERROR: Implicit declaration of function 'yfunc1' has a different result type than in previous declaration
+  print *, yfunc1()
+  print *, yfunc2()
+  print *, zfunc1() ! ok
+  print *, zfunc2() ! ok
+end
+
+function xfunc2()
+  use m
+  type(t1) xfunc2
+  xfunc2%n = 123
+end
+
+function yfunc2()
+  use m
+!ERROR: Function 'yfunc2' has a result type that differs from the implicit type it obtained in a previous reference
+  type(t1) yfunc2
+  yfunc2%n = 123
+end
+
+function zfunc2()
+  type t3
+    sequence
+    integer n
+  end type
+  type(t3) zfunc2
+  zfunc2%n = 123
+end