[flang-commits] [flang] b85922c - [flang] Include missing internal interfaces in .mod files

[Emil Kieri via flang-commits]

Author: Emil Kieri
Date: 2022-03-16T21:36:02+01:00
New Revision: b85922cde6e34b99fab20e4677d3f370d3f6a72a

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

LOG: [flang] Include missing internal interfaces in .mod files

Interfaces which are internal to a procedure need to be included in
module files if (and only if) they are referenced in the interface of
the procedure. That is, they are needed if they are the interfaces of
dummy or return value procedures.

Fixes #53420

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

Added: 
    flang/test/Semantics/modfile46.f90

Modified: 
    flang/lib/Semantics/mod-file.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 26a2da1c6b930..10d56b2c75eaf 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1057,6 +1057,30 @@ void SubprogramSymbolCollector::Collect() {
       if (needed) {
         need_.push_back(symbol);
       }
+    } else if (symbol.has<SubprogramDetails>()) {
+      // An internal subprogram is needed if it is used as interface
+      // for a dummy or return value procedure.
+      bool needed{false};
+      const auto hasInterface{[&symbol](const Symbol *s) -> bool {
+        // Is 's' a procedure with interface 'symbol'?
+        if (s) {
+          if (const auto *sDetails{s->detailsIf<ProcEntityDetails>()}) {
+            const ProcInterface &sInterface{sDetails->interface()};
+            if (sInterface.symbol() == &symbol) {
+              return true;
+            }
+          }
+        }
+        return false;
+      }};
+      for (const Symbol *dummyArg : details.dummyArgs()) {
+        needed = needed || hasInterface(dummyArg);
+      }
+      needed =
+          needed || (details.isFunction() && hasInterface(&details.result()));
+      if (needed && needSet_.insert(symbol).second) {
+        need_.push_back(symbol);
+      }
     }
   }
 }

diff  --git a/flang/test/Semantics/modfile46.f90 b/flang/test/Semantics/modfile46.f90
new file mode 100644
index 0000000000000..f532884242471
--- /dev/null
+++ b/flang/test/Semantics/modfile46.f90
@@ -0,0 +1,55 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Ensure that interfaces, which are internal to procedures and are used to
+! define the interface of dummy or return value procedures, are included in
+! .mod files.
+module m
+  implicit none
+contains
+  function f(x)
+    real, intent(in) :: x
+    abstract interface
+       subroutine used_int(x, p)
+         implicit none
+         real, intent(out) :: x
+         interface
+            subroutine inner_int(x)
+              implicit none
+              real, intent(out) :: x
+            end subroutine inner_int
+         end interface
+         procedure(inner_int) :: p
+       end subroutine used_int
+
+       pure logical function unused_int(i)
+         implicit none
+         integer, intent(in) :: i
+       end function unused_int
+    end interface
+    procedure(used_int), pointer :: f
+
+    f => null()
+  contains
+    subroutine internal()
+    end subroutine internal
+  end function f
+end module m
+
+!Expect: m.mod
+!module m
+!contains
+!function f(x)
+!real(4),intent(in)::x
+!procedure(used_int),pointer::f
+!abstract interface
+!subroutine used_int(x,p)
+!real(4),intent(out)::x
+!procedure(inner_int)::p
+!interface
+!subroutine inner_int(x)
+!real(4),intent(out)::x
+!end
+!end interface
+!end
+!end interface
+!end
+!end