[flang-commits] [flang] [flang] Refine IMPORT processing in module file generation (PR #77133)

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Fri Jan 5 12:04:03 PST 2024


https://github.com/klausler created https://github.com/llvm/llvm-project/pull/77133

Procedure interfaces emitted to module files are including IMPORT statements for some symbols that don't need to be imported (base types and procedure interfaces for components of imported derived types) and omitting others (procedure interfaces for bindings in locally-defined derived types that are material to the interface).

>From db2da5c402ed078c97224abfe867d38d2d824efd Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 5 Jan 2024 11:59:49 -0800
Subject: [PATCH] [flang] Refine IMPORT processing in module file generation

Procedure interfaces emitted to module files are including
IMPORT statements for some symbols that don't need to be
imported (base types and procedure interfaces for components
of imported derived types) and omitting others (procedure interfaces
for bindings in locally-defined derived types that are material
to the interface).
---
 flang/lib/Semantics/mod-file.cpp   |  25 ++++--
 flang/test/Semantics/modfile61.f90 | 130 +++++++++++++++++++++++++++++
 2 files changed, 146 insertions(+), 9 deletions(-)
 create mode 100644 flang/test/Semantics/modfile61.f90

diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 70b6bbf8b557ac..5fc6188a1f0284 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1444,6 +1444,9 @@ void SubprogramSymbolCollector::DoSymbol(
                         DoType(details.type());
                       }
                     },
+                    [this](const ProcBindingDetails &details) {
+                      DoSymbol(details.symbol());
+                    },
                     [](const auto &) {},
                 },
       symbol.details());
@@ -1469,17 +1472,21 @@ void SubprogramSymbolCollector::DoType(const DeclTypeSpec *type) {
   default:
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       const auto &typeSymbol{derived->typeSymbol()};
-      if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
-        DoSymbol(extends->name(), extends->typeSymbol());
-      }
       for (const auto &pair : derived->parameters()) {
         DoParamValue(pair.second);
       }
-      for (const auto &pair : *typeSymbol.scope()) {
-        const Symbol &comp{*pair.second};
-        DoSymbol(comp);
+      // The components of the type (including its parent component, if
+      // any) matter to IMPORT symbol collection only for derived types
+      // defined in the subprogram.
+      if (typeSymbol.owner() == scope_) {
+        if (const DerivedTypeSpec * extends{typeSymbol.GetParentTypeSpec()}) {
+          DoSymbol(extends->name(), extends->typeSymbol());
+        }
+        for (const auto &pair : *typeSymbol.scope()) {
+          DoSymbol(*pair.second);
+        }
       }
-      DoSymbol(derived->name(), derived->typeSymbol());
+      DoSymbol(derived->name(), typeSymbol);
     }
   }
 }
@@ -1511,8 +1518,8 @@ bool SubprogramSymbolCollector::NeedImport(
     // detect import from ancestor of use-associated symbol
     return found->has<UseDetails>() && found->owner() != scope_;
   } else {
-    // "found" can be null in the case of a use-associated derived type's parent
-    // type
+    // "found" can be null in the case of a use-associated derived type's
+    // parent type
     CHECK(symbol.has<DerivedTypeDetails>());
     return false;
   }
diff --git a/flang/test/Semantics/modfile61.f90 b/flang/test/Semantics/modfile61.f90
new file mode 100644
index 00000000000000..b6bc9492d495ee
--- /dev/null
+++ b/flang/test/Semantics/modfile61.f90
@@ -0,0 +1,130 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+module m
+  type t1
+    procedure(p1), pointer, nopass :: p
+  end type
+  type t2
+    procedure(p2), pointer, nopass :: p
+  end type
+  type t3
+    procedure(p4), pointer, nopass :: p
+  end type
+  type t4
+    procedure(p6), pointer, nopass :: p
+  end type
+  type t5
+    procedure(p7), pointer, nopass :: p
+  end type
+  interface
+    subroutine p1
+    end
+    subroutine p2
+    end
+    subroutine p3
+    end
+    subroutine p4
+    end
+    subroutine p5(c)
+      import
+      type(t3), intent(in) :: c
+    end
+    subroutine p6(d)
+      import
+      type(t5), intent(in) :: d
+    end
+    subroutine p7
+    end
+    subroutine p8
+    end
+    function f(a,b,dp)
+      import
+      type(t1), intent(in) :: a
+      type, extends(t2) :: localt1
+        procedure(p3), pointer, nopass :: p
+      end type
+      type, extends(localt1) :: localt2
+       contains
+        procedure, nopass :: p8
+      end type
+      type(localt2), intent(in) :: b
+      procedure(p5) dp
+      type(t4), pointer :: f
+    end
+  end interface
+end
+
+!Expect: m.mod
+!module m
+!type::t1
+!procedure(p1),nopass,pointer::p
+!end type
+!type::t2
+!procedure(p2),nopass,pointer::p
+!end type
+!type::t3
+!procedure(p4),nopass,pointer::p
+!end type
+!type::t4
+!procedure(p6),nopass,pointer::p
+!end type
+!type::t5
+!procedure(p7),nopass,pointer::p
+!end type
+!interface
+!subroutine p1()
+!end
+!end interface
+!interface
+!subroutine p2()
+!end
+!end interface
+!interface
+!subroutine p3()
+!end
+!end interface
+!interface
+!subroutine p4()
+!end
+!end interface
+!interface
+!subroutine p5(c)
+!import::t3
+!type(t3),intent(in)::c
+!end
+!end interface
+!interface
+!subroutine p6(d)
+!import::t5
+!type(t5),intent(in)::d
+!end
+!end interface
+!interface
+!subroutine p7()
+!end
+!end interface
+!interface
+!subroutine p8()
+!end
+!end interface
+!interface
+!function f(a,b,dp)
+!import::p3
+!import::p5
+!import::p8
+!import::t1
+!import::t2
+!import::t4
+!type(t1),intent(in)::a
+!type,extends(t2)::localt1
+!procedure(p3),nopass,pointer::p
+!end type
+!type,extends(localt1)::localt2
+!contains
+!procedure,nopass::p8
+!end type
+!type(localt2),intent(in)::b
+!procedure(p5)::dp
+!type(t4),pointer::f
+!end
+!end interface
+!end



More information about the flang-commits mailing list