[flang] Fix subtle type naming bug in module file output

[klausler]

A derived type specification in semantics holds both its source name (for location purposes) and its ultimate derived type symbol. But for correct module file generation of a structure constructor using that derived type spec, the original symbol may be needed so that USE association can be exposed.

Save both the original symbol and its ultimate symbol in the DerivedTypeSpec, and collect the right one when traversing expressions (specifically for handling initialization in module files).

Fixes #108827.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

A derived type specification in semantics holds both its source name (for location purposes) and its ultimate derived type symbol. But for correct module file generation of a structure constructor using that derived type spec, the original symbol may be needed so that USE association can be exposed.

Save both the original symbol and its ultimate symbol in the DerivedTypeSpec, and collect the right one when traversing expressions (specifically for handling initialization in module files).

Fixes #108827.

---

Full diff: https://github.com/llvm/llvm-project/pull/108892.diff

5 Files Affected:

• (modified) flang/include/flang/Evaluate/traverse.h (+1-1)
• (modified) flang/include/flang/Semantics/type.h (+3-1)
• (modified) flang/lib/Semantics/resolve-names.cpp (+5-9)
• (modified) flang/lib/Semantics/type.cpp (+4-3)
• (added) flang/test/Semantics/modfile68.f90 (+42)

diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index 7f4a67d97e64e7..90b93f6afd3515 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -217,7 +217,7 @@ class Traverse {
     return CombineContents(x);
   }
   Result operator()(const semantics::DerivedTypeSpec &x) const {
-    return Combine(x.typeSymbol(), x.parameters());
+    return Combine(x.originalTypeSymbol(), x.parameters());
   }
   Result operator()(const StructureConstructorValues::value_type &x) const {
     return visitor_(x.second);
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index e2d47d38f927f7..d94b403e74a121 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -259,6 +259,7 @@ class DerivedTypeSpec {
   DerivedTypeSpec(DerivedTypeSpec &&);
 
   const SourceName &name() const { return name_; }
+  const Symbol &originalTypeSymbol() const { return originalTypeSymbol_; }
   const Symbol &typeSymbol() const { return typeSymbol_; }
   const Scope *scope() const { return scope_; }
   // Return scope_ if it is set, or the typeSymbol_ scope otherwise.
@@ -319,7 +320,8 @@ class DerivedTypeSpec {
 
 private:
   SourceName name_;
-  const Symbol &typeSymbol_;
+  const Symbol &originalTypeSymbol_;
+  const Symbol &typeSymbol_; // == originalTypeSymbol_.GetUltimate()
   const Scope *scope_{nullptr}; // same as typeSymbol_.scope() unless PDT
   bool cooked_{false};
   bool evaluated_{false};
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index d8f601212d8d01..2885b6f4f70d7b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6766,9 +6766,7 @@ std::optional<DerivedTypeSpec> DeclarationVisitor::ResolveDerivedType(
   }
   if (CheckUseError(name)) {
     return std::nullopt;
-  }
-  symbol = &symbol->GetUltimate();
-  if (symbol->has<DerivedTypeDetails>()) {
+  } else if (symbol->GetUltimate().has<DerivedTypeDetails>()) {
     return DerivedTypeSpec{name.source, *symbol};
   } else {
     Say(name, "'%s' is not a derived type"_err_en_US);
@@ -7110,12 +7108,10 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) {
   auto &mutableData{const_cast<parser::DataStmtConstant &>(data)};
   if (auto *elem{parser::Unwrap<parser::ArrayElement>(mutableData)}) {
     if (const auto *name{std::get_if<parser::Name>(&elem->base.u)}) {
-      if (const Symbol * symbol{FindSymbol(*name)}) {
-        const Symbol &ultimate{symbol->GetUltimate()};
-        if (ultimate.has<DerivedTypeDetails>()) {
-          mutableData.u = elem->ConvertToStructureConstructor(
-              DerivedTypeSpec{name->source, ultimate});
-        }
+      if (const Symbol * symbol{FindSymbol(*name)};
+          symbol && symbol->GetUltimate().has<DerivedTypeDetails>()) {
+        mutableData.u = elem->ConvertToStructureConstructor(
+            DerivedTypeSpec{name->source, *symbol});
       }
     }
   }
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index aa6e8973ebd304..4cf80f36128a4e 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -22,8 +22,9 @@
 namespace Fortran::semantics {
 
 DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol)
-    : name_{name}, typeSymbol_{typeSymbol} {
-  CHECK(typeSymbol.has<DerivedTypeDetails>());
+    : name_{name}, originalTypeSymbol_{typeSymbol},
+      typeSymbol_{typeSymbol.GetUltimate()} {
+  CHECK(typeSymbol_.has<DerivedTypeDetails>());
 }
 DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default;
 DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default;
@@ -664,7 +665,7 @@ std::string DerivedTypeSpec::VectorTypeAsFortran() const {
 std::string DerivedTypeSpec::AsFortran() const {
   std::string buf;
   llvm::raw_string_ostream ss{buf};
-  ss << name_;
+  ss << originalTypeSymbol_.name();
   if (!rawParameters_.empty()) {
     CHECK(parameters_.empty());
     ss << '(';
diff --git a/flang/test/Semantics/modfile68.f90 b/flang/test/Semantics/modfile68.f90
new file mode 100644
index 00000000000000..550560303f082d
--- /dev/null
+++ b/flang/test/Semantics/modfile68.f90
@@ -0,0 +1,42 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+module m1
+  use iso_c_binding, only : c_ptr, c_null_ptr
+  private
+  public :: t1
+  type :: t1
+    type(c_ptr) :: c_ptr = c_null_ptr
+  end type
+end
+
+!Expect: m1.mod
+!module m1
+!use,intrinsic::__fortran_builtins,only:__builtin_c_ptr
+!use,intrinsic::iso_c_binding,only:c_ptr
+!use,intrinsic::iso_c_binding,only:c_null_ptr
+!private::__builtin_c_ptr
+!private::c_ptr
+!private::c_null_ptr
+!type::t1
+!type(c_ptr)::c_ptr=__builtin_c_ptr(__address=0_8)
+!end type
+!end
+
+module m2
+  use m1, only : t1
+  private
+  public :: t2
+  type :: t2
+    type(t1) :: x = t1()
+  end type
+end
+
+!Expect: m2.mod
+!module m2
+!use,intrinsic::__fortran_builtins,only:__builtin_c_ptr
+!use m1,only:t1
+!private::__builtin_c_ptr
+!private::t1
+!type::t2
+!type(t1)::x=t1(c_ptr=__builtin_c_ptr(__address=0_8))
+!end type
+!end

[psteinfeld]

All builds and tests correctly and looks good.