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

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() &&
@@ -6773,9 +6784,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);
@@ -7117,12 +7126,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