From b0bdc7fcc995fe6cf6ca9a184fc6ed211fc7b608 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Wed, 18 Sep 2024 12:18:50 -0700 Subject: [PATCH] [flang] Fix subtle type naming bug in module file output (#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. --- flang/include/flang/Evaluate/traverse.h | 2 +- flang/include/flang/Semantics/type.h | 9 +++-- flang/lib/Evaluate/characteristics.cpp | 5 +-- flang/lib/Semantics/check-declarations.cpp | 2 +- flang/lib/Semantics/resolve-names.cpp | 39 +++++++++++--------- flang/lib/Semantics/type.cpp | 11 +++--- flang/test/Semantics/get_team.f90 | 2 +- flang/test/Semantics/modfile68.f90 | 42 ++++++++++++++++++++++ flang/test/Semantics/modproc01.f90 | 8 +++-- 9 files changed, 88 insertions(+), 32 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 7f4a67d97e64..90b93f6afd35 100644 --- a/flang/include/flang/Evaluate/traverse.h +++ b/flang/include/flang/Evaluate/traverse.h @@ -217,7 +217,7 @@ public: 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 e2d47d38f927..e2131e7e160c 100644 --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -259,6 +259,7 @@ public: 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 @@ public: 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}; @@ -328,8 +330,9 @@ private: ParameterMapType parameters_; Category category_{Category::DerivedType}; bool RawEquals(const DerivedTypeSpec &that) const { - return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ && - rawParameters_ == that.rawParameters_; + return &typeSymbol_ == &that.typeSymbol_ && + &originalTypeSymbol_ == &that.originalTypeSymbol_ && + cooked_ == that.cooked_ && rawParameters_ == that.rawParameters_; } friend llvm::raw_ostream &operator<<( llvm::raw_ostream &, const DerivedTypeSpec &); diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 70e24d6e82eb..2496e4427fe7 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -66,8 +66,9 @@ bool ShapesAreCompatible(const std::optional &x, } bool TypeAndShape::operator==(const TypeAndShape &that) const { - return type_ == that.type_ && ShapesAreCompatible(shape_, that.shape_) && - attrs_ == that.attrs_ && corank_ == that.corank_; + return type_.IsEquivalentTo(that.type_) && + ShapesAreCompatible(shape_, that.shape_) && attrs_ == that.attrs_ && + corank_ == that.corank_; } TypeAndShape &TypeAndShape::Rewrite(FoldingContext &context) { diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index b852fbf12a6e..dfd49db74eea 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -2519,7 +2519,7 @@ void CheckHelper::CheckProcBinding( ? "A NOPASS type-bound procedure may not override a passed-argument procedure"_err_en_US : "A passed-argument type-bound procedure may not override a NOPASS procedure"_err_en_US); } else { - const auto *bindingChars{Characterize(binding.symbol())}; + const auto *bindingChars{Characterize(symbol)}; const auto *overriddenChars{Characterize(*overridden)}; if (bindingChars && overriddenChars) { if (isNopass) { diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 7c692440d247..0ff2795cc984 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3053,11 +3053,16 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, const Symbol &useUltimate{useSymbol.GetUltimate()}; const auto *useGeneric{useUltimate.detailsIf()}; if (localSymbol->has()) { - if (useGeneric && useGeneric->specific() && - IsProcedurePointer(*useGeneric->specific())) { - // We are use-associating a generic that shadows a procedure pointer. - // Local references that might be made to that procedure pointer should - // use a UseDetails symbol for proper data addressing. So create an + if (useGeneric && + ((useGeneric->specific() && + IsProcedurePointer(*useGeneric->specific())) || + (useGeneric->derivedType() && + useUltimate.name() != localSymbol->name()))) { + // We are use-associating a generic that either shadows a procedure + // pointer or shadows a derived type of the same name. + // Local references that might be made to the procedure pointer should + // use a UseDetails symbol for proper data addressing, and a derived + // type needs to be in scope with the renamed name. So create an // empty local generic now into which the use-associated generic may // be copied. localSymbol->set_details(GenericDetails{}); @@ -3153,9 +3158,15 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, if (!useDerivedType) { combinedDerivedType = localDerivedType; } else if (!localDerivedType) { - combinedDerivedType = useDerivedType; + if (useDerivedType->name() == localName) { + combinedDerivedType = useDerivedType; + } else { + Symbol &combined{currScope().MakeSymbol(localName, + useDerivedType->attrs(), UseDetails{localName, *useDerivedType})}; + combinedDerivedType = &combined; + } } else { - const Scope *localScope{localDerivedType->scope()}; + const Scope *localScope{localDerivedType->GetUltimate().scope()}; const Scope *useScope{useDerivedType->GetUltimate().scope()}; if (localScope && useScope && localScope->derivedTypeSpec() && useScope->derivedTypeSpec() && @@ -6776,9 +6787,7 @@ std::optional DeclarationVisitor::ResolveDerivedType( } if (CheckUseError(name)) { return std::nullopt; - } - symbol = &symbol->GetUltimate(); - if (symbol->has()) { + } else if (symbol->GetUltimate().has()) { return DerivedTypeSpec{name.source, *symbol}; } else { Say(name, "'%s' is not a derived type"_err_en_US); @@ -7120,12 +7129,10 @@ bool ConstructVisitor::Pre(const parser::DataStmtValue &x) { auto &mutableData{const_cast(data)}; if (auto *elem{parser::Unwrap(mutableData)}) { if (const auto *name{std::get_if(&elem->base.u)}) { - if (const Symbol * symbol{FindSymbol(*name)}) { - const Symbol &ultimate{symbol->GetUltimate()}; - if (ultimate.has()) { - mutableData.u = elem->ConvertToStructureConstructor( - DerivedTypeSpec{name->source, ultimate}); - } + if (const Symbol * symbol{FindSymbol(*name)}; + symbol && symbol->GetUltimate().has()) { + mutableData.u = elem->ConvertToStructureConstructor( + DerivedTypeSpec{name->source, *symbol}); } } } diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 810b9829b0b8..e867d7ad6e25 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()); + : name_{name}, originalTypeSymbol_{typeSymbol}, + typeSymbol_{typeSymbol.GetUltimate()} { + CHECK(typeSymbol_.has()); } DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default; DerivedTypeSpec::DerivedTypeSpec(DerivedTypeSpec &&that) = default; @@ -340,9 +341,7 @@ void DerivedTypeSpec::Instantiate(Scope &containingScope) { const Scope &typeScope{DEREF(typeSymbol_.scope())}; if (!MightBeParameterized()) { scope_ = &typeScope; - if (typeScope.derivedTypeSpec()) { - CHECK(*this == *typeScope.derivedTypeSpec()); - } else { + if (!typeScope.derivedTypeSpec() || *this != *typeScope.derivedTypeSpec()) { Scope &mutableTypeScope{const_cast(typeScope)}; mutableTypeScope.set_derivedTypeSpec(*this); InstantiateNonPDTScope(mutableTypeScope, containingScope); @@ -664,7 +663,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/get_team.f90 b/flang/test/Semantics/get_team.f90 index a28b0d72f23f..7e4886703d17 100644 --- a/flang/test/Semantics/get_team.f90 +++ b/flang/test/Semantics/get_team.f90 @@ -49,7 +49,7 @@ program get_team_test !ERROR: repeated keyword argument to intrinsic 'get_team' result_team = get_team(level=initial_team, level=parent_team) - !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types LOGICAL(4) and TYPE(__builtin_team_type) + !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types LOGICAL(4) and TYPE(team_type) wrong_result_type = get_team() end program get_team_test diff --git a/flang/test/Semantics/modfile68.f90 b/flang/test/Semantics/modfile68.f90 new file mode 100644 index 000000000000..550560303f08 --- /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 diff --git a/flang/test/Semantics/modproc01.f90 b/flang/test/Semantics/modproc01.f90 index 5652e15750c7..5f45362e9509 100644 --- a/flang/test/Semantics/modproc01.f90 +++ b/flang/test/Semantics/modproc01.f90 @@ -144,8 +144,12 @@ end program !CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=3_4)) !CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4 !CHECK: l1: TypeParam type:INTEGER(4) Len init:3_4 -!CHECK: DerivedType scope: size=1 alignment=1 instantiation of pdt2(k2=1_4,l2=3_4) -!CHECK: a2: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=3_4)) shape: 1_8:1_8 +!CHECK: DerivedType scope: size=48 alignment=8 instantiation of pdt2(k2=1_4,l2=3_4) sourceRange=0 bytes +!CHECK: a2 size=40 offset=8: ObjectEntity type: TYPE(pdt1(k1=1_4,l1=3_4)) shape: 1_8:1_8 !CHECK: j2 size=1 offset=0: ObjectEntity type: INTEGER(1) !CHECK: k2: TypeParam type:INTEGER(4) Kind init:1_4 !CHECK: l2: TypeParam type:INTEGER(4) Len init:3_4 +!CHECK: DerivedType scope: size=40 alignment=8 instantiation of pdt1(k1=1_4,l1=3_4) sourceRange=0 bytes +!CHECK: a1, ALLOCATABLE size=40 offset=0: ObjectEntity type: TYPE(pdt2(k2=1_4,l2=3_4)) +!CHECK: k1: TypeParam type:INTEGER(4) Kind init:1_4 +!CHECK: l1: TypeParam type:INTEGER(4) Len init:3_4