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

[klausler]

Summary

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.

[jeanPerier]

Looks good

flang/include/flang/Semantics/symbol.h

public:
   // with the same name as this generic. Only one of them may be set.
   Symbol *specific() { return specific_; }
   const Symbol *specific() const { return specific_; }
   void set_specific(Symbol &specific);
   void clear_specific();
   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
   void CopyFrom(const GenericDetails &);
 
   // Check that specific is one of the specificProcs. If not, return the
   // specific as a raw pointer.
   const Symbol *CheckSpecific() const;

flang/lib/Semantics/resolve-names.cpp

if (symbol->has<SubprogramNameDetails>()) {
       if (inInterfaceBlock()) {
         // Subtle: clear any MODULE flag so that the new interface
         // symbol doesn't inherit it and ruin the ability to check it.
         symbol->attrs().reset(Attr::MODULE);
       }
     } else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
       // found generic, want specific procedure
       auto *specific{details->specific()};
-      if (specific && inInterfaceBlock() &&
-          specific->has<SubprogramNameDetails>() &&
+      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.
-        details->clear_specific();
             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 =
             &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
         if (details->derivedType()) {
           // A specific procedure with the same name as a derived type
           SayAlreadyDeclared(name, *details->derivedType());
         } else {

flang/lib/Semantics/symbol.cpp

void GenericDetails::set_specific(Symbol &specific) {
   specific_ = &specific;
 }
 void GenericDetails::clear_specific() { specific_ = nullptr; }
 void GenericDetails::set_derivedType(Symbol &derivedType) {
   CHECK(!specific_);
   CHECK(!derivedType_);
   derivedType_ = &derivedType;
 }
+void GenericDetails::clear_derivedType() { derivedType_ = nullptr; }
 void GenericDetails::AddUse(const Symbol &use) {
   CHECK(use.has<UseDetails>());
   uses_.push_back(use);
 }
 
 const Symbol *GenericDetails::CheckSpecific() const {
   return const_cast<GenericDetails *>(this)->CheckSpecific();
 }

flang/test/Semantics/resolve115.f90

+! 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