[flang] Lower basic derived types

[clementval]

Summary

This patch lowers basic derived type to FIR.

This patch is part of the upstreaming effort from fir-dev branch.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Lower/AbstractConverter.h

public:
   /// Record a binding for the ssa-value of the host assoications tuple for this
   /// function.
   virtual void bindHostAssocTuple(mlir::Value val) = 0;
 
   //===--------------------------------------------------------------------===//
   // Types
   //===--------------------------------------------------------------------===//
 
-  /// Generate the type of a DataRef
-  virtual mlir::Type genType(const Fortran::evaluate::DataRef &) = 0;
   /// Generate the type of an Expr
   virtual mlir::Type genType(const SomeExpr &) = 0;
   /// Generate the type of a Symbol
   virtual mlir::Type genType(SymbolRef) = 0;
   /// Generate the type from a category
   virtual mlir::Type genType(Fortran::common::TypeCategory tc) = 0;
   /// Generate the type from a category and kind and length parameters.
   virtual mlir::Type
   genType(Fortran::common::TypeCategory tc, int kind,
           llvm::ArrayRef<std::int64_t> lenParameters = llvm::None) = 0;
+  /// Generate the type from a DerivedTypeSpec.
+  virtual mlir::Type genType(const Fortran::semantics::DerivedTypeSpec &) = 0;
   /// Generate the type from a Variable
   virtual mlir::Type genType(const pft::Variable &) = 0;
 
   //===--------------------------------------------------------------------===//
   // Locations
   //===--------------------------------------------------------------------===//
 
   /// Get the converter's current location

flang/include/flang/Lower/ConvertType.h

 namespace evaluate {
 template <typename>
 class Expr;
 struct SomeType;
 } // namespace evaluate
 
 namespace semantics {
 class Symbol;
+class DerivedTypeSpec;
 } // namespace semantics
 
 namespace lower {
 class AbstractConverter;
 namespace pft {
 struct Variable;
 }
 
 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 using SymbolRef = common::Reference<const semantics::Symbol>;
 
 // Type for compile time constant length type parameters.
 using LenParameterTy = std::int64_t;
 
 /// Get a FIR type based on a category and kind.
 mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc,
                       int kind, llvm::ArrayRef<LenParameterTy>);
 
+/// Get a FIR type for a derived type
+mlir::Type
+translateDerivedTypeToFIRType(Fortran::lower::AbstractConverter &,
+                              const Fortran::semantics::DerivedTypeSpec &);
+
 /// Translate a SomeExpr to an mlir::Type.
 mlir::Type translateSomeExprToFIRType(Fortran::lower::AbstractConverter &,
                                       const SomeExpr &expr);
 
 /// Translate a Fortran::semantics::Symbol to an mlir::Type.
 mlir::Type translateSymbolToFIRType(Fortran::lower::AbstractConverter &,
                                     const SymbolRef symbol);
 

flang/lib/Lower/Bridge.cpp

fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
     return fir::BoxValue(
         builder->createBox(loc, genExprAddr(expr, context, &loc)));
   }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
   }
 
-  mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
-    TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
-               "expression lowering");
-  }
   mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
     return Fortran::lower::translateSomeExprToFIRType(*this, expr);
   }
   mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
     return Fortran::lower::translateSymbolToFIRType(*this, sym);
   }
-  mlir::Type genType(Fortran::common::TypeCategory tc) override final {
-    TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
-               "expression lowering");
-  }
   mlir::Type
   genType(Fortran::common::TypeCategory tc, int kind,
           llvm::ArrayRef<std::int64_t> lenParameters) override final {
     return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind,
                                       lenParameters);
   }
+  mlir::Type
+  genType(const Fortran::semantics::DerivedTypeSpec &tySpec) override final {
+    return Fortran::lower::translateDerivedTypeToFIRType(*this, tySpec);
+  }
+  mlir::Type genType(Fortran::common::TypeCategory tc) override final {
+    TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
+               "expression lowering");
+  }
   mlir::Type genType(const Fortran::lower::pft::Variable &var) override final {
     return Fortran::lower::translateVariableToFIRType(*this, var);
   }
 
   void setCurrentPosition(const Fortran::parser::CharBlock &position) {
     if (position != Fortran::parser::CharBlock{})
       currentPosition = position;
   }

flang/lib/Lower/CallInterface.cpp

void Fortran::lower::CallerInterface::walkResultLengths(
   assert(typeAndShape && "no result type");
   Fortran::evaluate::DynamicType dynamicType = typeAndShape->type();
   // Visit result length specification expressions that are explicit.
   if (dynamicType.category() == Fortran::common::TypeCategory::Character) {
     if (std::optional<Fortran::evaluate::ExtentExpr> length =
             dynamicType.GetCharLength())
       visitor(toEvExpr(*length));
   } else if (dynamicType.category() == common::TypeCategory::Derived) {
-    TODO(converter.getCurrentLocation(), "walkResultLengths derived type");
+    const Fortran::semantics::DerivedTypeSpec &derivedTypeSpec =
+        dynamicType.GetDerivedTypeSpec();
+    if (Fortran::semantics::CountLenParameters(derivedTypeSpec) > 0)
+      TODO(converter.getCurrentLocation(),
+           "function result with derived type length parameters");
   }
 }
 
 // Compute extent expr from shapeSpec of an explicit shape.
 // TODO: Allow evaluate shape analysis to work in a mode where it disregards
 // the non-constant aspects when building the shape to avoid having this here.
 static Fortran::evaluate::ExtentExpr
 getExtentExpr(const Fortran::semantics::ShapeSpec &shapeSpec) {
bool dummyRequiresBox(
     return false;
   }
 
   mlir::Type
   translateDynamicType(const Fortran::evaluate::DynamicType &dynamicType) {
     Fortran::common::TypeCategory cat = dynamicType.category();
     // DERIVED
     if (cat == Fortran::common::TypeCategory::Derived) {
+      if (dynamicType.IsPolymorphic())
         TODO(interface.converter.getCurrentLocation(),
-           "[translateDynamicType] Derived types");
+             "[translateDynamicType] polymorphic types");
+      return getConverter().genType(dynamicType.GetDerivedTypeSpec());
     }
     // CHARACTER with compile time constant length.
     if (cat == Fortran::common::TypeCategory::Character)
       if (std::optional<std::int64_t> constantLen =
               toInt64(dynamicType.GetCharLength()))
         return getConverter().genType(cat, dynamicType.kind(), {*constantLen});
     // INTEGER, REAL, LOGICAL, COMPLEX, and CHARACTER with dynamic length.
     return getConverter().genType(cat, dynamicType.kind());

flang/lib/Lower/ConvertExpr.cpp

ExtValue genval(const Fortran::evaluate::Subscript &subs) {
     fir::emitFatalError(getLoc(), "subscript triple notation is not scalar");
   }
 
   ExtValue genSubscript(const Fortran::evaluate::Subscript &subs) {
     return genval(subs);
   }
 
   ExtValue gen(const Fortran::evaluate::DataRef &dref) {
-    TODO(getLoc(), "gen DataRef");
+    return std::visit([&](const auto &x) { return gen(x); }, dref.u);
   }
   ExtValue genval(const Fortran::evaluate::DataRef &dref) {
-    TODO(getLoc(), "genval DataRef");
+    return std::visit([&](const auto &x) { return genval(x); }, dref.u);
   }
 
   // Helper function to turn the Component structure into a list of nested
   // components, ordered from largest/leftmost to smallest/rightmost:
   //  - where only the smallest/rightmost item may be allocatable or a pointer
   //    (nested allocatable/pointer components require nested coordinate_of ops)
   //  - that does not contain any parent components
   //    (the front end places parent components directly in the object)
ExtValue genComponent(const Fortran::evaluate::Component &cmpt) {
     ty = builder.getRefType(ty);
     return fir::factory::componentToExtendedValue(
         builder, loc,
         builder.create<fir::CoordinateOp>(loc, ty, fir::getBase(obj),
                                           coorArgs));
   }
 
   ExtValue gen(const Fortran::evaluate::Component &cmpt) {
-    TODO(getLoc(), "gen Component");
+    // Components may be pointer or allocatable. In the gen() path, the mutable
+    // aspect is lost to simplify handling on the client side. To retain the
+    // mutable aspect, genMutableBoxValue should be used.
+    return genComponent(cmpt).match(
+        [&](const fir::MutableBoxValue &mutableBox) {
+          return fir::factory::genMutableBoxRead(builder, getLoc(), mutableBox);
+        },
+        [](auto &box) -> ExtValue { return box; });
   }
+
   ExtValue genval(const Fortran::evaluate::Component &cmpt) {
-    TODO(getLoc(), "genval Component");
+    return genLoad(gen(cmpt));
   }
 
   ExtValue genval(const Fortran::semantics::Bound &bound) {
     TODO(getLoc(), "genval Bound");
   }
 
   /// Return lower bounds of \p box in dimension \p dim. The returned value
   /// has type \ty.
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
   template <typename A>
   ExtValue genval(const Fortran::evaluate::Designator<A> &des) {
     return std::visit([&](const auto &x) { return genval(x); }, des.u);
   }
 
   mlir::Type genType(const Fortran::evaluate::DynamicType &dt) {
     if (dt.category() != Fortran::common::TypeCategory::Derived)
       return converter.genType(dt.category(), dt.kind());
-    TODO(getLoc(), "genType Derived Type");
+    return converter.genType(dt.GetDerivedTypeSpec());
   }
 
   /// Lower a function reference
   template <typename A>
   ExtValue genFunctionRef(const Fortran::evaluate::FunctionRef<A> &funcRef) {
     if (!funcRef.GetType().has_value())
       fir::emitFatalError(getLoc(), "internal: a function must have a type");
     mlir::Type resTy = genType(*funcRef.GetType());

flang/lib/Lower/ConvertType.cpp

 //===-- ConvertType.cpp ---------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Support/Utils.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include "mlir/IR/Builders.h"
 #include "mlir/IR/BuiltinTypes.h"
+#include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-type"
 
 //===--------------------------------------------------------------------===//
 // Intrinsic type translation helpers
 //===--------------------------------------------------------------------===//
 
 static mlir::Type genRealType(mlir::MLIRContext *context, int kind) {
public:
   mlir::Type genExprType(const Fortran::lower::SomeExpr &expr) {
     std::optional<Fortran::evaluate::DynamicType> dynamicType = expr.GetType();
     if (!dynamicType)
       return genTypelessExprType(expr);
     Fortran::common::TypeCategory category = dynamicType->category();
 
     mlir::Type baseType;
     if (category == Fortran::common::TypeCategory::Derived) {
-      TODO(converter.getCurrentLocation(), "genExprType derived");
+      baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
     } else {
       // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
       llvm::SmallVector<Fortran::lower::LenParameterTy> params;
       translateLenParameters(params, category, expr);
       baseType = genFIRType(context, category, dynamicType->kind(), params);
     }
     std::optional<Fortran::evaluate::Shape> shapeExpr =
         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
         llvm::SmallVector<Fortran::lower::LenParameterTy> params;
         translateLenParameters(params, tySpec->category(), ultimate);
         ty = genFIRType(context, tySpec->category(), kind, params);
       } else if (type->IsPolymorphic()) {
         TODO(loc, "genSymbolType polymorphic types");
-      } else if (type->AsDerived()) {
-        TODO(loc, "genSymbolType derived type");
+      } else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
+                     type->AsDerived()) {
+        ty = genDerivedType(*tySpec);
       } else {
         fir::emitFatalError(loc, "symbol's type must have a type spec");
       }
     } else {
       fir::emitFatalError(loc, "symbol must have a type");
     }
     if (ultimate.IsObjectArray()) {
       auto shapeExpr = Fortran::evaluate::GetShapeHelper{
mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
     // or pointer semantics, so do not use box for them.
     if (isPtr)
       return fir::PointerType::get(ty);
     if (isAlloc)
       return fir::HeapType::get(ty);
     return ty;
   }
 
+  /// Does \p component has non deferred lower bounds that are not compile time
+  /// constant 1.
+  static bool componentHasNonDefaultLowerBounds(
+      const Fortran::semantics::Symbol &component) {
+    if (const auto *objDetails =
+            component.detailsIf<Fortran::semantics::ObjectEntityDetails>())
+      for (const Fortran::semantics::ShapeSpec &bounds : objDetails->shape())
+        if (auto lb = bounds.lbound().GetExplicit())
+          if (auto constant = Fortran::evaluate::ToInt64(*lb))
+            if (!constant || *constant != 1)
+              return true;
+    return false;
+  }
+
+  mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) {
+    std::vector<std::pair<std::string, mlir::Type>> ps;
+    std::vector<std::pair<std::string, mlir::Type>> cs;
+    const Fortran::semantics::Symbol &typeSymbol = tySpec.typeSymbol();
+    if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol))
+      return ty;
+    auto rec = fir::RecordType::get(context,
+                                    Fortran::lower::mangle::mangleName(tySpec));
+    // Maintain the stack of types for recursive references.
+    derivedTypeInConstruction.emplace_back(typeSymbol, rec);
+
+    // Gather the record type fields.
+    // (1) The data components.
+    for (const auto &field :
+         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 (componentHasNonDefaultLowerBounds(field))
+        TODO(converter.genLocation(field.name()),
+             "lowering derived type components with non default lower bounds");
+      if (IsProcName(field))
+        TODO(converter.genLocation(field.name()), "procedure components");
+      mlir::Type ty = genSymbolType(field);
+      // 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))
+        continue;
+      cs.emplace_back(field.name().ToString(), ty);
+    }
+
+    // (2) The LEN type parameters.
+    for (const auto &param :
+         Fortran::semantics::OrderParameterDeclarations(typeSymbol))
+      if (param->get<Fortran::semantics::TypeParamDetails>().attr() ==
+          Fortran::common::TypeParamAttr::Len)
+        ps.emplace_back(param->name().ToString(), genSymbolType(*param));
+
+    rec.finalize(ps, cs);
+    popDerivedTypeInConstruction();
+
+    if (!ps.empty()) {
+      // This type is a PDT (parametric derived type). Create the functions to
+      // use for allocation, dereferencing, and address arithmetic here.
+      TODO(converter.genLocation(typeSymbol.name()),
+           "parametrized derived types lowering");
+    }
+    LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
+    return rec;
+  }
+
   // To get the character length from a symbol, make an fold a designator for
   // the symbol to cover the case where the symbol is an assumed length named
   // constant and its length comes from its init expression length.
   template <int Kind>
   fir::SequenceType::Extent
   getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
     using TC =
         Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
if (auto constantLen = toInt64(charExpr.LEN()))
       return *constantLen;
     return fir::SequenceType::getUnknownExtent();
   }
 
   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
   }
 
-private:
+  /// Derived type can be recursive. That is, pointer components of a derived
+  /// type `t` have type `t`. This helper returns `t` if it is already being
+  /// lowered to avoid infinite loops.
+  mlir::Type getTypeIfDerivedAlreadyInConstruction(
+      const Fortran::lower::SymbolRef derivedSym) const {
+    for (const auto &[sym, type] : derivedTypeInConstruction)
+      if (sym == derivedSym)
+        return type;
+    return {};
+  }
+
+  void popDerivedTypeInConstruction() {
+    assert(!derivedTypeInConstruction.empty());
+    derivedTypeInConstruction.pop_back();
+  }
+
+  /// Stack derived type being processed to avoid infinite loops in case of
+  /// recursive derived types. The depth of derived types is expected to be
+  /// shallow (<10), so a SmallVector is sufficient.
+  llvm::SmallVector<std::pair<const Fortran::lower::SymbolRef, mlir::Type>>
+      derivedTypeInConstruction;
   Fortran::lower::AbstractConverter &converter;
   mlir::MLIRContext *context;
 };
 
 } // namespace
 
 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
                                       Fortran::common::TypeCategory tc,
                                       int kind,
                                       llvm::ArrayRef<LenParameterTy> params) {
   return genFIRType(context, tc, kind, params);
 }
 
+mlir::Type Fortran::lower::translateDerivedTypeToFIRType(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::semantics::DerivedTypeSpec &tySpec) {
+  return TypeBuilder{converter}.genDerivedType(tySpec);
+}
+
 mlir::Type Fortran::lower::translateSomeExprToFIRType(
     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
   return TypeBuilder{converter}.genExprType(expr);
 }
 
 mlir::Type Fortran::lower::translateSymbolToFIRType(
     Fortran::lower::AbstractConverter &converter, const SymbolRef symbol) {
   return TypeBuilder{converter}.genSymbolType(symbol);

flang/test/Lower/derived-types.f90

+! Test basic parts of derived type entities lowering
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Note: only testing non parametrized derived type here.
+
+module d
+    type r
+      real :: x
+    end type
+    type r2
+      real :: x_array(10, 20)
+    end type
+    type c
+      character(10) :: ch
+    end type
+    type c2
+      character(10) :: ch_array(20, 30)
+    end type
+  contains
+  
+  ! -----------------------------------------------------------------------------
+  !            Test simple derived type symbol lowering 
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QMdPderived_dummy(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMdTr{x:f32}>>{{.*}}, %{{.*}}: !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>{{.*}}) {
+  subroutine derived_dummy(some_r, some_c2)
+    type(r) :: some_r
+    type(c2) :: some_c2
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMdPlocal_derived(
+  subroutine local_derived()
+    ! CHECK-DAG: fir.alloca !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
+    ! CHECK-DAG: fir.alloca !fir.type<_QMdTr{x:f32}>
+    type(r) :: some_r
+    type(c2) :: some_c2
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMdPsaved_derived(
+  subroutine saved_derived()
+    ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_c2) : !fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>
+    ! CHECK-DAG: fir.address_of(@_QMdFsaved_derivedEsome_r) : !fir.ref<!fir.type<_QMdTr{x:f32}>>
+    type(r), save :: some_r
+    type(c2), save :: some_c2
+    call use_symbols(some_r, some_c2)
+  end subroutine
+  
+  
+  ! -----------------------------------------------------------------------------
+  !            Test simple derived type references 
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QMdPscalar_numeric_ref(
+  subroutine scalar_numeric_ref()
+    ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
+    type(r) :: some_r
+    ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
+    ! CHECK: fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
+    call real_bar(some_r%x)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QMdPscalar_character_ref(
+  subroutine scalar_character_ref()
+    ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTc{ch:!fir.char<1,10>}>
+    type(c) :: some_c
+    ! CHECK: %[[field:.*]] = fir.field_index ch, !fir.type<_QMdTc{ch:!fir.char<1,10>}>
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>>
+    ! CHECK-DAG: %[[c10:.*]] = arith.constant 10 : index
+    ! CHECK-DAG: %[[conv:.*]] = fir.convert %[[coor]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ref<!fir.char<1,?>>
+    ! CHECK: fir.emboxchar %[[conv]], %c10 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+    call char_bar(some_c%ch)
+  end subroutine
+  
+  ! FIXME: coordinate of generated for derived%array_comp(i) are not zero based as they
+  ! should be.
+  
+  ! CHECK-LABEL: func @_QMdParray_comp_elt_ref(
+  subroutine array_comp_elt_ref()
+    type(r2) :: some_r2
+    ! CHECK: %[[alloc:.*]] = fir.alloca !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>
+    ! CHECK: %[[field:.*]] = fir.field_index x_array, !fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[alloc]], %[[field]] : (!fir.ref<!fir.type<_QMdTr2{x_array:!fir.array<10x20xf32>}>>, !fir.field) -> !fir.ref<!fir.array<10x20xf32>>
+    ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
+    ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
+    ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<10x20xf32>>, i64, i64) -> !fir.ref<f32>
+    call real_bar(some_r2%x_array(5, 6))
+  end subroutine
+  
+  
+  ! CHECK-LABEL: func @_QMdPchar_array_comp_elt_ref(
+  subroutine char_array_comp_elt_ref()
+    type(c2) :: some_c2
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>>, !fir.field) -> !fir.ref<!fir.array<20x30x!fir.char<1,10>>>
+    ! CHECK-DAG: %[[index1:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
+    ! CHECK-DAG: %[[index2:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
+    ! CHECK: fir.coordinate_of %[[coor]], %[[index1]], %[[index2]] : (!fir.ref<!fir.array<20x30x!fir.char<1,10>>>, i64, i64) -> !fir.ref<!fir.char<1,10>>
+    ! CHECK: fir.emboxchar %{{.*}}, %c10 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+    call char_bar(some_c2%ch_array(5, 6))
+  end subroutine
+  
+  ! CHECK: @_QMdParray_elt_comp_ref
+  subroutine array_elt_comp_ref()
+    type(r) :: some_r_array(100)
+    ! CHECK: %[[alloca:.*]] = fir.alloca !fir.array<100x!fir.type<_QMdTr{x:f32}>>
+    ! CHECK: %[[index:.*]] = arith.subi %c5{{.*}}, %c1{{.*}} : i64
+    ! CHECK: %[[elt:.*]] = fir.coordinate_of %[[alloca]], %[[index]] : (!fir.ref<!fir.array<100x!fir.type<_QMdTr{x:f32}>>>, i64) -> !fir.ref<!fir.type<_QMdTr{x:f32}>>
+    ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
+    ! CHECK: fir.coordinate_of %[[elt]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
+    call real_bar(some_r_array(5)%x)
+  end subroutine
+  
+  ! CHECK: @_QMdPchar_array_elt_comp_ref
+  subroutine char_array_elt_comp_ref()
+    type(c) :: some_c_array(100)
+    ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMdTc{ch:!fir.char<1,10>}>>>, i64) -> !fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>
+    ! CHECK: fir.coordinate_of %{{.*}}, %{{.*}} : (!fir.ref<!fir.type<_QMdTc{ch:!fir.char<1,10>}>>, !fir.field) -> !fir.ref<!fir.char<1,10>>
+    ! CHECK: fir.emboxchar %{{.*}}, %c10{{.*}} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+    call char_bar(some_c_array(5)%ch)
+  end subroutine
+  
+  ! -----------------------------------------------------------------------------
+  !            Test loading derived type components
+  ! -----------------------------------------------------------------------------
+  
+  ! Most of the other tests only require lowering code to compute the address of
+  ! components. This one requires loading a component which tests other code paths
+  ! in lowering.
+  
+  ! CHECK-LABEL: func @_QMdPscalar_numeric_load(
+  ! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMdTr{x:f32}>>
+  real function scalar_numeric_load(some_r)
+    type(r) :: some_r
+    ! CHECK: %[[field:.*]] = fir.field_index x, !fir.type<_QMdTr{x:f32}>
+    ! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[field]] : (!fir.ref<!fir.type<_QMdTr{x:f32}>>, !fir.field) -> !fir.ref<f32>
+    ! CHECK: fir.load %[[coor]]
+    scalar_numeric_load = some_r%x
+  end function
+  
+  ! -----------------------------------------------------------------------------
+  !            Test returned derived types (no length parameters)
+  ! -----------------------------------------------------------------------------
+  
+  ! CHECK-LABEL: func @_QMdPbar_return_derived() -> !fir.type<_QMdTr{x:f32}>
+  function bar_return_derived()
+    ! CHECK: %[[res:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
+    type(r) :: bar_return_derived
+    ! CHECK: %[[resLoad:.*]] = fir.load %[[res]] : !fir.ref<!fir.type<_QMdTr{x:f32}>>
+    ! CHECK: return %[[resLoad]] : !fir.type<_QMdTr{x:f32}>
+  end function
+  
+  ! CHECK-LABEL: func @_QMdPcall_bar_return_derived(
+  subroutine call_bar_return_derived()
+    ! CHECK: %[[tmp:.*]] = fir.alloca !fir.type<_QMdTr{x:f32}>
+    ! CHECK: %[[call:.*]] = fir.call @_QMdPbar_return_derived() : () -> !fir.type<_QMdTr{x:f32}>
+    ! CHECK: fir.save_result %[[call]] to %[[tmp]] : !fir.type<_QMdTr{x:f32}>, !fir.ref<!fir.type<_QMdTr{x:f32}>>
+    ! CHECK: fir.call @_QPr_bar(%[[tmp]]) : (!fir.ref<!fir.type<_QMdTr{x:f32}>>) -> ()
+    call r_bar(bar_return_derived())
+  end subroutine
+  
+  end module
+  
+  ! -----------------------------------------------------------------------------
+  !            Test derived type with pointer/allocatable components 
+  ! -----------------------------------------------------------------------------
+  
+  module d2
+    type recursive_t
+      real :: x
+      type(recursive_t), pointer :: ptr
+    end type
+  contains
+  ! CHECK-LABEL: func @_QMd2Ptest_recursive_type(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.type<_QMd2Trecursive_t{x:f32,ptr:!fir.box<!fir.ptr<!fir.type<_QMd2Trecursive_t>>>}>>{{.*}}) {
+  subroutine test_recursive_type(some_recursive)
+    type(recursive_t) :: some_recursive
+  end subroutine
+  end module
+  
+  ! -----------------------------------------------------------------------------
+  !            Test global derived type symbol lowering 
+  ! -----------------------------------------------------------------------------
+  
+  module data_mod
+    use d
+    type(r) :: some_r
+    type(c2) :: some_c2
+  end module
+  
+  ! Test globals
+  
+  ! CHECK-DAG: fir.global @_QMdata_modEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
+  ! CHECK-DAG: fir.global @_QMdata_modEsome_r : !fir.type<_QMdTr{x:f32}>
+  ! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_c2 : !fir.type<_QMdTc2{ch_array:!fir.array<20x30x!fir.char<1,10>>}>
+  ! CHECK-DAG: fir.global internal @_QMdFsaved_derivedEsome_r : !fir.type<_QMdTr{x:f32}>