[Flang][Semantics] Treat host/use-associated objects as externally visible. (#192892)

This patch fixes a false semantic error in Flang where function result
variables were incorrectly treated as externally visible in
pure-definability checks.

As a result, valid code assigning a pointer component of a function
result (as in flang/test/Semantics/pure-function-result-pointer.f90) was
rejected with “not definable in a pure subprogram.”

The fix updates _FindExternallyVisibleObject_ to treat function result
symbols as local, which matches Fortran semantics for function result
variables.

flang/lib/Semantics/tools.cpp

@@ -331,7 +331,13 @@ const Symbol *FindExternallyVisibleObject(
   // TODO: Storage association with any object for which this predicate holds,
   // once EQUIVALENCE is supported.
   const Symbol &ultimate{GetAssociationRoot(object)};
-  if (IsDummy(ultimate)) {
+  if (ultimate.owner().IsDerivedType()) {
+    return nullptr;
+  } else if (!IsDummy(ultimate) &&
+      (IsUseAssociated(object, scope) ||
+          IsHostAssociatedIntoSubprogram(object, scope))) {
+    return &object;
+  } else if (IsDummy(ultimate)) {
     if (IsIntentIn(ultimate)) {
       return &ultimate;
     }
@@ -339,12 +345,7 @@ const Symbol *FindExternallyVisibleObject(
         IsPureProcedure(ultimate.owner()) && IsFunction(ultimate.owner())) {
       return &ultimate;
     }
-  } else if (ultimate.owner().IsDerivedType()) {
-    return nullptr;
-  } else if (&GetProgramUnitContaining(ultimate) !=
-      &GetProgramUnitContaining(scope)) {
-    return &object;
-  } else if (const Symbol * block{FindCommonBlockContaining(ultimate)}) {
+  } else if (const Symbol *block{FindCommonBlockContaining(ultimate)}) {
     return block;
   }
   return nullptr;

flang/test/Semantics/pure-function-result-pointer.f90

@@ -0,0 +1,46 @@
+! RUN: %flang_fc1 -fsyntax-only %s
+
+module associated_func_call
+  implicit none
+  private
+  public :: type_t
+  public :: test_function_i
+  abstract interface
+    function test_function_i() result(passes)
+      implicit none
+      logical passes
+    end function
+  end interface
+
+  type type_t
+    private
+    procedure(test_function_i), pointer, nopass :: test_function_ => null()
+  contains
+    generic :: operator(==) => equals
+    procedure, private :: equals
+  end type
+
+  interface type_t
+    module function construct(test_function) result(test_description)
+      implicit none
+      procedure(test_function_i), intent(in), pointer :: test_function
+      type(type_t) test_description
+    end function
+  end interface
+
+  interface
+    elemental module function equals(lhs, rhs) result(lhs_eq_rhs)
+      implicit none
+      class(type_t), intent(in) :: lhs, rhs
+      logical lhs_eq_rhs
+    end function
+  end interface
+  
+contains
+    module procedure construct
+      test_description%test_function_ => test_function
+    end procedure
+    module procedure equals
+      lhs_eq_rhs = associated(lhs%test_function_, rhs%test_function_)
+    end procedure
+end module associated_func_call

flang/test/Semantics/pure-host-associated-result.f90

@@ -0,0 +1,14 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+function test_func(x) result(i)
+  integer, pointer :: i
+  real :: x
+  x = func()
+contains
+  pure real function func()
+    !ERROR: Left-hand side of assignment is not definable
+    !BECAUSE: 'i' is externally visible via 'i' and not definable in a pure subprogram
+    i = 0
+    func = 0.
+  end function
+end function