[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 #108827.

Author: klausler

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);

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};
@@ -328,8 +330,9 @@ class DerivedTypeSpec {
   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 &);

flang/lib/Evaluate/characteristics.cpp

@@ -66,8 +66,9 @@ bool ShapesAreCompatible(const std::optional<Shape> &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) {

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) {

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<GenericDetails>()};
   if (localSymbol->has<UnknownDetails>()) {
-    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<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);
@@ -7120,12 +7129,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});
       }
     }
   }

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;
@@ -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<Scope &>(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 << '(';

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

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

flang/test/Semantics/modproc01.f90

@@ -144,8 +144,12 @@ program test
 !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