[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
This commit is contained in:
parent
1c0ac80d4a
commit
9bb31e8f88
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
|
29
flang/test/Lower/derived-type-private.f90
Normal file
29
flang/test/Lower/derived-type-private.f90
Normal file
@ -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
|
Loading…
x
Reference in New Issue
Block a user