[flang-commits] [flang] b7a0482 - [flang] Clarify edge case of host association and generic interfaces

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-10-06T13:10:33-07:00
New Revision: b7a0482a0a72438ceab3239ee1e358f953b688c8

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

LOG: [flang] Clarify edge case of host association and generic interfaces

Name resolution was mishandling cases of generic interfaces and specific procedures
(sometimes complicatd by use of the same name for each) when the specific procedure
was accessed by means of host association; only the scope of the generic interface
definition was searched for the specific procedure.  Also search enclosing scopes
in the usual way.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/generic01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index e748e41908e1..5b7a8636e846 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -7233,8 +7233,8 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
   Symbol *existing{nullptr};
   // Check all variants of names, e.g. "operator(.ne.)" for "operator(/=)"
   for (const std::string &n : GetAllNames(context(), symbolName)) {
-    if (auto iter{currScope().find(n)}; iter != currScope().end()) {
-      existing = &*iter->second;
+    existing = currScope().FindSymbol(SourceName{n});
+    if (existing) {
       break;
     }
   }
@@ -7249,24 +7249,28 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
           genericDetails.set_specific(*existingGeneric->specific());
         }
         AddGenericUse(genericDetails, existing->name(), existingUse->symbol());
-      } else if (existing == &ultimate) {
-        // Extending an extant generic in the same scope
-        info.Resolve(existing);
-        return;
-      } else {
-        // Host association of a generic is handled in ResolveGeneric()
-        CHECK(existing->has<HostAssocDetails>());
+      } else if (&existing->owner() == &currScope()) {
+        if (existing == &ultimate) {
+          // Extending an extant generic in the same scope
+          info.Resolve(existing);
+          return;
+        } else {
+          // Host association of a generic is handled elsewhere
+          CHECK(existing->has<HostAssocDetails>());
+        }
       }
     } else if (ultimate.has<SubprogramDetails>() ||
         ultimate.has<SubprogramNameDetails>()) {
       genericDetails.set_specific(*existing);
     } else if (ultimate.has<DerivedTypeDetails>()) {
       genericDetails.set_derivedType(*existing);
-    } else {
+    } else if (&existing->owner() == &currScope()) {
       SayAlreadyDeclared(symbolName, *existing);
       return;
     }
-    EraseSymbol(*existing);
+    if (&existing->owner() == &currScope()) {
+      EraseSymbol(*existing);
+    }
   }
   info.Resolve(&MakeSymbol(symbolName, Attrs{}, std::move(genericDetails)));
 }

diff  --git a/flang/test/Semantics/generic01.f90 b/flang/test/Semantics/generic01.f90
index 21132f92d090..0e79a2f47472 100644
--- a/flang/test/Semantics/generic01.f90
+++ b/flang/test/Semantics/generic01.f90
@@ -61,24 +61,48 @@ subroutine test2
   end subroutine
   subroutine test3
     interface abs
-      module procedure abs_int_redef2 ! override module's use of m1
+      module procedure abs_complex_redef ! extend module's use of m1
     end interface
-    !CHECK: abs_int_redef2(
+    !CHECK: abs_int_redef(
     print *, abs(1)
     !CHECK: 1._4
     print *, abs(1.)
-    !CHECK: 1.41421353816986083984375_4
+    !CHECK: abs_complex_redef(
     print *, abs((1,1))
     !CHECK: abs_noargs(
     print *, abs()
     block
-      use m1, only: abs ! override the override
-      !CHECK: abs_int_redef(
-      print *, abs(1)
+      intrinsic abs ! override the extension
+      !CHECK: 1.41421353816986083984375_4
+      print *, abs((1,1))
     end block
   end subroutine
-  integer function abs_int_redef2(j)
-    integer, intent(in) :: j
-    abs_int_redef2 = j
+  real function abs_complex_redef(z)
+    complex, intent(in) :: z
+    abs_complex_redef = z
   end function
+  subroutine test4
+    !CHECK: abs(
+    print *, abs(1)
+   contains
+    integer function abs(n) ! override module's use of m1
+      integer, intent(in) :: n
+      abs = n
+    end function
+  end subroutine
+end module
+
+module m4
+ contains
+  integer function abs(n)
+    integer, intent(in) :: n
+    abs = n
+  end function
+  subroutine test5
+    interface abs
+      module procedure abs ! same name, host-associated
+    end interface
+    !CHECK: abs(
+    print *, abs(1)
+  end subroutine
 end module