[flang-commits] [flang] [flang] Fix subtle type naming bug in module file output (PR #108892)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Sep 16 15:11:06 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/108892
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 https://github.com/llvm/llvm-project/issues/108827.
>From 04e02d981c42fcf4f311d39fba2feae77f97a808 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 16 Sep 2024 15:04:27 -0700
Subject: [PATCH] [flang] Fix subtle type naming bug in module file output
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 https://github.com/llvm/llvm-project/issues/108827.
---
flang/include/flang/Evaluate/traverse.h | 2 +-
flang/include/flang/Semantics/type.h | 4 ++-
flang/lib/Semantics/resolve-names.cpp | 14 +++------
flang/lib/Semantics/type.cpp | 7 +++--
flang/test/Semantics/modfile68.f90 | 42 +++++++++++++++++++++++++
5 files changed, 55 insertions(+), 14 deletions(-)
create mode 100644 flang/test/Semantics/modfile68.f90
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
More information about the flang-commits
mailing list