From 9bb31e8f88ab49c3f983067540e553dd13fd3b42 Mon Sep 17 00:00:00 2001
From: Carlos Seo <carlos.seo@linaro.org>
Date: Mon, 4 Aug 2025 10:38:15 -0300
Subject: [PATCH] [Flang] Fix crash when a derived type with private attribute
 is specified in extends (#151051)

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
---
 flang/include/flang/Lower/ConvertType.h   |  3 +++
 flang/lib/Lower/ConvertExprToHLFIR.cpp    | 11 +++++++--
 flang/lib/Lower/ConvertType.cpp           | 12 ++++++++++
 flang/test/Lower/derived-type-private.f90 | 29 +++++++++++++++++++++++
 4 files changed, 53 insertions(+), 2 deletions(-)
 create mode 100644 flang/test/Lower/derived-type-private.f90

diff --git a/flang/include/flang/Lower/ConvertType.h b/flang/include/flang/Lower/ConvertType.h
index 179a68258404..3c726595c0f7 100644
--- a/flang/include/flang/Lower/ConvertType.h
+++ b/flang/include/flang/Lower/ConvertType.h
@@ -118,6 +118,9 @@ public:
   /// 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 46be111242bf..13cf4e2a5a19 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1848,8 +1848,15 @@ private:
       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 7a2e8e509518..0fde61465fb8 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 000000000000..8edcdeedad8b
--- /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