[flang-commits] [flang] 227f30a - [flang] Clarify cases where name resolution of generic shadowing can be overridden

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-10-29T11:27:34-07:00
New Revision: 227f30a515d7aff0f462bed5fffb85b11ec0bb2a

URL: https://github.com/llvm/llvm-project/commit/227f30a515d7aff0f462bed5fffb85b11ec0bb2a
DIFF: https://github.com/llvm/llvm-project/commit/227f30a515d7aff0f462bed5fffb85b11ec0bb2a.diff

LOG: [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

Added: 
    flang/test/Semantics/resolve115.f90

Modified: 
    flang/include/flang/Semantics/symbol.h
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/symbol.cpp

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 829dee00c8241..a81dd66575ebd 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -480,6 +480,7 @@ class GenericDetails {
   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 5b7a8636e8463..7cbe271568958 100644
--- 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 f85422960290e..432db3429ecd9 100644
--- 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
index 0000000000000..7700b5964f0a9
--- /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