[flang] Lower PRIVATE component names safely (llvm#66076)

It is possible for a derived type extending a type with private
components to define components with the same name as the private
components.

This was not properly handled by lowering where several fir.record type
component names could end-up being the same, leading to bad generated
code (only the first component was accessed via fir.field_index, leading
to bad generated code).

This patch handles the situation by adding the derived type mangled name
to private component.

Author: jeanPerier

flang/include/flang/Lower/AbstractConverter.h

@@ -250,6 +250,11 @@ class AbstractConverter {
   mangleName(const Fortran::semantics::DerivedTypeSpec &) = 0;
   /// Unique a compiler generated name (add a containing scope specific prefix)
   virtual std::string mangleName(std::string &) = 0;
+  /// Return the field name for a derived type component inside a fir.record
+  /// type.
+  virtual std::string
+  getRecordTypeFieldName(const Fortran::semantics::Symbol &component) = 0;
+
   /// Get the KindMap.
   virtual const fir::KindMapping &getKindMap() = 0;
 

flang/include/flang/Lower/Mangler.h

@@ -96,6 +96,13 @@ inline std::string mangleArrayLiteral(
 /// Return the compiler-generated name of a static namelist variable descriptor.
 std::string globalNamelistDescriptorName(const Fortran::semantics::Symbol &sym);
 
+/// Return the field name for a derived type component inside a fir.record type.
+/// It is the component name if the component is not private. Otherwise it is
+/// mangled with the component parent type to avoid any name clashes in type
+/// extensions.
+std::string getRecordTypeFieldName(const Fortran::semantics::Symbol &component,
+                                   ScopeBlockIdMap &);
+
 } // namespace lower::mangle
 } // namespace Fortran
 

flang/lib/Lower/Bridge.cpp

@@ -856,6 +856,11 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     return Fortran::lower::mangle::mangleName(name, getCurrentScope(),
                                               scopeBlockIdMap);
   }
+  std::string getRecordTypeFieldName(
+      const Fortran::semantics::Symbol &component) override final {
+    return Fortran::lower::mangle::getRecordTypeFieldName(component,
+                                                          scopeBlockIdMap);
+  }
   const fir::KindMapping &getKindMap() override final {
     return bridge.getKindMap();
   }

flang/lib/Lower/ConvertConstant.cpp

@@ -362,8 +362,9 @@ static mlir::Value genInlinedStructureCtorLitImpl(
     if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))
       TODO(loc, "parent component in structure constructor");
 
-    llvm::StringRef name = toStringRef(sym->name());
+    std::string name = converter.getRecordTypeFieldName(sym);
     mlir::Type componentTy = recTy.getType(name);
+    assert(componentTy && "failed to retrieve component");
     // FIXME: type parameters must come from the derived-type-spec
     auto field = builder.create<fir::FieldIndexOp>(
         loc, fieldTy, name, type,

flang/lib/Lower/ConvertExpr.cpp

@@ -937,7 +937,7 @@ class ScalarExprLowering {
       if (isDerivedTypeWithLenParameters(sym))
         TODO(loc, "component with length parameters in structure constructor");
 
-      llvm::StringRef name = toStringRef(sym.name());
+      std::string name = converter.getRecordTypeFieldName(sym);
       // FIXME: type parameters must come from the derived-type-spec
       mlir::Value field = builder.create<fir::FieldIndexOp>(
           loc, fieldTy, name, ty,
@@ -1476,7 +1476,7 @@ class ScalarExprLowering {
     for (const Fortran::evaluate::Component *field : list) {
       auto recTy = ty.cast<fir::RecordType>();
       const Fortran::semantics::Symbol &sym = getLastSym(*field);
-      llvm::StringRef name = toStringRef(sym.name());
+      std::string name = converter.getRecordTypeFieldName(sym);
       coorArgs.push_back(builder.create<fir::FieldIndexOp>(
           loc, fldTy, name, recTy, fir::getTypeParams(obj)));
       ty = recTy.getType(name);
@@ -6745,7 +6745,8 @@ class ArrayExprLowering {
               },
               [&](const Fortran::evaluate::Component *x) {
                 auto fieldTy = fir::FieldType::get(builder.getContext());
-                llvm::StringRef name = toStringRef(getLastSym(*x).name());
+                std::string name =
+                    converter.getRecordTypeFieldName(getLastSym(*x));
                 if (auto recTy = ty.dyn_cast<fir::RecordType>()) {
                   ty = recTy.getType(name);
                   auto fld = builder.create<fir::FieldIndexOp>(

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -742,7 +742,7 @@ class HlfirDesignatorBuilder {
     assert(
         !componentSym.test(Fortran::semantics::Symbol::Flag::ParentComp) &&
         "parent components are skipped and must not reach visitComponentImpl");
-    partInfo.componentName = componentSym.name().ToString();
+    partInfo.componentName = converter.getRecordTypeFieldName(componentSym);
     auto recordType =
         hlfir::getFortranElementType(baseType).cast<fir::RecordType>();
     if (recordType.isDependentType())
@@ -1721,7 +1721,7 @@ class HlfirBuilder {
     for (const auto &value : ctor.values()) {
       const Fortran::semantics::Symbol &sym = *value.first;
       const Fortran::lower::SomeExpr &expr = value.second.value();
-      llvm::StringRef name = toStringRef(sym.name());
+      std::string name = converter.getRecordTypeFieldName(sym);
       if (sym.test(Fortran::semantics::Symbol::Flag::ParentComp)) {
         const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType();
         assert(declTypeSpec && declTypeSpec->AsDerived() &&

flang/lib/Lower/ConvertType.cpp

@@ -382,23 +382,25 @@ struct TypeBuilderImpl {
 
     // Gather the record type fields.
     // (1) The data components.
-    for (const auto &field :
+    for (const auto &component :
          Fortran::semantics::OrderedComponentIterator(tySpec)) {
       // Lowering is assuming non deferred component lower bounds are always 1.
       // Catch any situations where this is not true for now.
       if (!converter.getLoweringOptions().getLowerToHighLevelFIR() &&
-          componentHasNonDefaultLowerBounds(field))
-        TODO(converter.genLocation(field.name()),
+          componentHasNonDefaultLowerBounds(component))
+        TODO(converter.genLocation(component.name()),
              "derived type components with non default lower bounds");
-      if (IsProcedure(field))
-        TODO(converter.genLocation(field.name()), "procedure components");
-      mlir::Type ty = genSymbolType(field);
+      if (IsProcedure(component))
+        TODO(converter.genLocation(component.name()), "procedure components");
+      mlir::Type ty = genSymbolType(component);
       // Do not add the parent component (component of the parents are
       // added and should be sufficient, the parent component would
-      // duplicate the fields).
-      if (field.test(Fortran::semantics::Symbol::Flag::ParentComp))
+      // duplicate the fields). Note that genSymbolType must be called above on
+      // it so that the dispatch table for the parent type still gets emitted
+      // as needed.
+      if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
         continue;
-      cs.emplace_back(field.name().ToString(), ty);
+      cs.emplace_back(converter.getRecordTypeFieldName(component), ty);
     }
 
     // (2) The LEN type parameters.

flang/lib/Lower/ConvertVariable.cpp

@@ -324,7 +324,7 @@ static mlir::Value genDefaultInitializerValue(
     if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
       continue;
     mlir::Value componentValue;
-    llvm::StringRef name = toStringRef(component.name());
+    std::string name = converter.getRecordTypeFieldName(component);
     mlir::Type componentTy = recTy.getType(name);
     assert(componentTy && "component not found in type");
     if (const auto *object{

flang/lib/Lower/Mangler.cpp

@@ -230,6 +230,25 @@ std::string Fortran::lower::mangle::mangleName(
   return fir::NameUniquer::doType(modules, procs, blockId, symbolName, kinds);
 }
 
+std::string Fortran::lower::mangle::getRecordTypeFieldName(
+    const Fortran::semantics::Symbol &component,
+    ScopeBlockIdMap &scopeBlockIdMap) {
+  if (!component.attrs().test(Fortran::semantics::Attr::PRIVATE))
+    return component.name().ToString();
+  const Fortran::semantics::DerivedTypeSpec *componentParentType =
+      component.owner().derivedTypeSpec();
+  assert(componentParentType &&
+         "failed to retrieve private component parent type");
+  // Do not mangle Iso C C_PTR and C_FUNPTR components. This type cannot be
+  // extended as per Fortran 2018 7.5.7.1, mangling them makes the IR unreadable
+  // when using ISO C modules, and lowering needs to know the component way
+  // without access to semantics::Symbol.
+  if (Fortran::semantics::IsIsoCType(componentParentType))
+    return component.name().ToString();
+  return mangleName(*componentParentType, scopeBlockIdMap) + "." +
+         component.name().ToString();
+}
+
 std::string Fortran::lower::mangle::demangleName(llvm::StringRef name) {
   auto result = fir::NameUniquer::deconstruct(name);
   return result.second.name;

flang/test/Lower/HLFIR/private-components.f90

@@ -0,0 +1,36 @@
+! Test that private component names are mangled inside fir.record
+! in a way that allow components with the same name to be added in
+! type extensions.
+! RUN: bbc -emit-hlfir -o - %s | FileCheck %s
+
+module name_clash
+  type:: t
+    integer, private :: i
+  end type
+  type(t), parameter :: cst = t(42)
+end module
+
+!CHECK-LABEL: func.func @_QPuser_clash(
+!CHECK-SAME: !fir.ref<!fir.type<_QFuser_clashTt2{_QMname_clashTt.i:i32,i:i32}>>
+!CHECK-SAME: !fir.ref<!fir.type<_QMname_clashTt{_QMname_clashTt.i:i32}>>
+subroutine user_clash(a, at)
+  use name_clash
+  type,extends(t) :: t2
+    integer :: i = 2
+  end type
+  type(t2) :: a, b
+  type(t) :: at
+  print *, a%i
+  print *, t2(t=at)
+  a = b
+end subroutine
+
+! CHECK-LABEL: func.func @_QPclash_with_intrinsic_module(
+! CHECK-SAME: !fir.ref<!fir.type<_QFclash_with_intrinsic_moduleTmy_class{_QMieee_arithmeticTieee_class_type.which:i8,which:i8}>>
+subroutine clash_with_intrinsic_module(a)
+ use ieee_arithmetic
+ type, extends(ieee_class_type) :: my_class
+    integer(1) :: which
+ end type
+ type(my_class) :: a
+end subroutine