[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

diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 829dee0..a81dd66 100644 (file)
--- a/flang/include/flang/Semantics/symbol.h
+++ b/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

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 5b7a863..7cbe271 100644 (file)
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/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 =

diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index f854229..432db34 100644 (file)
--- a/flang/lib/Semantics/symbol.cpp
+++ b/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);

diff --git a/flang/test/Semantics/resolve115.f90 b/flang/test/Semantics/resolve115.f90
new file mode 100644 (file)
index 0000000..7700b59
--- /dev/null
+++ b/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