[flang] Clarify cases where name resolution of generic shadowing can be overridden

Fortran famously allows a generic interface definition to share a
scope with a procedure or derived type of the same name.  When that
shadowed name is accessed via host or USE association, but is also
defined by an interface in the generic, then name resolution needs
to fix up the representation of the shadowing so that the new interface
definition is seen as the shadowed symbol -- the host or USE associated
name is not material to the situation.  See the new test case for
particular examples.

Differential Revision: https://reviews.llvm.org/D136891

flang/include/flang/Semantics/symbol.h

@@ -480,6 +480,7 @@ public:
   Symbol *derivedType() { return derivedType_; }
   const Symbol *derivedType() const { return derivedType_; }
   void set_derivedType(Symbol &derivedType);
+  void clear_derivedType();
   void AddUse(const Symbol &);
 
   // Copy in specificProcs, specific, and derivedType from another generic

flang/lib/Semantics/resolve-names.cpp

@@ -3888,14 +3888,32 @@ Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
     } else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
       // found generic, want specific procedure
       auto *specific{details->specific()};
-      if (specific && inInterfaceBlock() &&
-          specific->has<SubprogramNameDetails>() &&
-          specific->attrs().test(Attr::MODULE)) {
-        // The shadowed procedure is a separate module procedure that is
-        // actually defined later in this (sub)module.
-        // Define its interface now as a new symbol.
-        details->clear_specific();
-        specific = nullptr;
+      if (inInterfaceBlock()) {
+        if (specific) {
+          // Defining an interface in a generic of the same name which is
+          // already shadowing another procedure.  In some cases, the shadowed
+          // procedure is about to be replaced.
+          if (specific->has<SubprogramNameDetails>() &&
+              specific->attrs().test(Attr::MODULE)) {
+            // The shadowed procedure is a separate module procedure that is
+            // actually defined later in this (sub)module.
+            // Define its interface now as a new symbol.
+            specific = nullptr;
+          } else if (&specific->owner() != &symbol->owner()) {
+            // The shadowed procedure was from an enclosing scope and will be
+            // overridden by this interface definition.
+            specific = nullptr;
+          }
+          if (!specific) {
+            details->clear_specific();
+          }
+        } else if (const auto *dType{details->derivedType()}) {
+          if (&dType->owner() != &symbol->owner()) {
+            // The shadowed derived type was from an enclosing scope and
+            // will be overridden by this interface definition.
+            details->clear_derivedType();
+          }
+        }
       }
       if (!specific) {
         specific =

flang/lib/Semantics/symbol.cpp

@@ -180,6 +180,7 @@ void GenericDetails::set_derivedType(Symbol &derivedType) {
   CHECK(!derivedType_);
   derivedType_ = &derivedType;
 }
+void GenericDetails::clear_derivedType() { derivedType_ = nullptr; }
 void GenericDetails::AddUse(const Symbol &use) {
   CHECK(use.has<UseDetails>());
   uses_.push_back(use);

flang/test/Semantics/resolve115.f90

@@ -0,0 +1,79 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Ensures that a generic's shadowed procedure or derived type
+! can be overridden by a valid interior interface definition
+! in some cases.
+
+module m1
+ contains
+  subroutine foo
+  end subroutine
+  subroutine test
+    interface foo
+      subroutine foo(n)
+        integer, intent(in) :: n
+      end subroutine
+    end interface
+    call foo(1)
+  end subroutine
+end module
+
+module m2
+ contains
+  subroutine test
+    interface foo
+      subroutine foo(n)
+        integer, intent(in) :: n
+      end subroutine
+    end interface
+    call foo(1)
+  end subroutine
+  subroutine foo
+  end subroutine
+end module
+
+module m3
+  interface
+    subroutine foo
+    end subroutine
+  end interface
+ contains
+  subroutine test
+    interface foo
+      subroutine foo(n)
+        integer, intent(in) :: n
+      end subroutine
+    end interface
+    call foo(1)
+  end subroutine
+end module
+
+module m4a
+ contains
+  subroutine foo
+  end subroutine
+end module
+module m4b
+  use m4a
+ contains
+  subroutine test
+    interface foo
+      subroutine foo(n)
+        integer, intent(in) :: n
+      end subroutine
+    end interface
+    call foo(1)
+  end subroutine
+end module
+
+module m5
+  type bar
+  end type
+ contains
+  subroutine test
+    interface bar
+      real function bar()
+      end function
+    end interface
+    print *, bar()
+  end subroutine
+end module