[Flang] Fix crash when a derived type with private attribute is specified in extends

[ceseo]

While lowering to HLFIR, when a parent type is private, its name is mangled, so we need to get it from the parent symbol.

Fixes #120922

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Carlos Seo (ceseo)

Changes

While lowering to HLFIR, when a parent type is private, its name is mangled, so we need to get it from the parent symbol.

Fixes #120922

---

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

4 Files Affected:

• (modified) flang/include/flang/Lower/ConvertType.h (+3)
• (modified) flang/lib/Lower/ConvertExprToHLFIR.cpp (+9-2)
• (modified) flang/lib/Lower/ConvertType.cpp (+12)
• (added) flang/test/Lower/derived-type-private.f90 (+29)

diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h
index 179a682584046..3c726595c0f76 100644
--- a/flang/include/flang/Lower/ConvertType.h
+++ b/flang/include/flang/Lower/ConvertType.h
@@ -118,6 +118,9 @@ class ComponentReverseIterator {
   /// Advance iterator to the last components of the current type parent.
   const Fortran::semantics::DerivedTypeSpec &advanceToParentType();
 
+  /// Get the parent component symbol for the current type.
+  const Fortran::semantics::Symbol *getParentComponent() const;
+
 private:
   void setCurrentType(const Fortran::semantics::DerivedTypeSpec &derived);
   const Fortran::semantics::DerivedTypeSpec *currentParentType = nullptr;
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 46be111242bf7..13cf4e2a5a19f 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1848,8 +1848,15 @@ class HlfirBuilder {
       for (Fortran::lower::ComponentReverseIterator compIterator(
                ctor.result().derivedTypeSpec());
            !compIterator.lookup(compSym.name());) {
-        const auto &parentType = compIterator.advanceToParentType();
-        llvm::StringRef parentName = toStringRef(parentType.name());
+        // Private parent components have mangled names. Get the name from the
+        // parent symbol.
+        const Fortran::semantics::Symbol *parentCompSym =
+            compIterator.getParentComponent();
+        assert(parentCompSym && "failed to get parent component symbol");
+        std::string parentName =
+            converter.getRecordTypeFieldName(*parentCompSym);
+        // Advance the iterator, but don't use its return value.
+        compIterator.advanceToParentType();
         auto baseRecTy = mlir::cast<fir::RecordType>(
             hlfir::getFortranElementType(currentParent.getType()));
         auto parentCompType = baseRecTy.getType(parentName);
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 7a2e8e5095186..0fde61465fb85 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -669,6 +669,18 @@ Fortran::lower::ComponentReverseIterator::advanceToParentType() {
   return *currentParentType;
 }
 
+const Fortran::semantics::Symbol *
+Fortran::lower::ComponentReverseIterator::getParentComponent() const {
+  if (!currentTypeDetails->GetParentComponentName())
+    return nullptr;
+  const Fortran::semantics::Scope *scope = currentParentType->GetScope();
+  auto parentComp =
+      DEREF(scope).find(currentTypeDetails->GetParentComponentName().value());
+  if (parentComp == scope->cend())
+    return nullptr;
+  return &*parentComp->second;
+}
+
 void Fortran::lower::ComponentReverseIterator::setCurrentType(
     const Fortran::semantics::DerivedTypeSpec &derived) {
   currentParentType = &derived;
diff --git a/flang/test/Lower/derived-type-private.f90 b/flang/test/Lower/derived-type-private.f90
new file mode 100644
index 0000000000000..8edcdeedad8b2
--- /dev/null
+++ b/flang/test/Lower/derived-type-private.f90
@@ -0,0 +1,29 @@
+! Test lowering of derived type with private attribute
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+program main
+  call test02()
+  print *,"pass"
+end program main
+
+module mod2
+  type,private:: tt
+     integer :: ip = 1
+  end type tt
+  type,extends(tt):: ty1
+  ! CHECK: fir.global @_QMmod2Estr : !fir.type<_QMmod2Tty1{_QMmod2Tty1.tt:!fir.type<_QMmod2Ttt{ip:i32}>,i1:i32,i1p:!fir.type<_QMmod2Ttt{ip:i32}>,i1a:!fir.box<!fir.heap<!fir.array<?xi32>>>}>
+     integer :: i1 = 1
+     type(tt) :: i1p = tt(2)
+     integer,allocatable :: i1a(:)
+  end type ty1
+  type(ty1) :: str
+end module mod2
+
+subroutine test02()
+  use mod2
+  integer,allocatable :: ia(:)
+  allocate(ia(10))
+  ia=2
+  str=ty1(i1a=ia)
+  if (str%i1.ne.1) print *,'ng'
+end subroutine test02

[tblah]

Thank you for the fix!

[tblah]

/cherry-pick 9bb31e8

[llvmbot]

Failed to cherry-pick: 9bb31e8

https://github.com/llvm/llvm-project/actions/runs/16727640016

Please manually backport the fix and push it to your github fork. Once this is done, please create a pull request

[tru]

Can some one create a pull request for this if it's something we still want to backport?

[tblah]

I've removed the milestone. It would have been nice to get this fix in but it isn't critical, and the failure to cherry-pick might mean this is higher risk than I anticipated.

This turns out it wasn't a real merge conflict - just an ambiguous git ref. I will try again.

[tblah]

/cherry-pick 9bb31e8

[llvmbot]

/pull-request #152687