[flang] Lower pointer component in derived type
This patch lowers pointer component part of derived types to FIR. This patch is part of the upstreaming effort from fir-dev branch. Depends on D121383 Reviewed By: PeteSteinfeld, schweitz Differential Revision: https://reviews.llvm.org/D121384 Co-authored-by: V Donaldson <vdonaldson@nvidia.com> Co-authored-by: Jean Perier <jperier@nvidia.com> Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
This commit is contained in:
parent
deb359aab3
commit
72276bdaff
26
flang/include/flang/Lower/BuiltinModules.h
Normal file
26
flang/include/flang/Lower/BuiltinModules.h
Normal file
|
@ -0,0 +1,26 @@
|
|||
//===-- BuiltinModules.h --------------------------------------*- C++ -*-===//
|
||||
//
|
||||
// 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
|
||||
//
|
||||
//===----------------------------------------------------------------------===//
|
||||
//
|
||||
// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
|
||||
//
|
||||
//===----------------------------------------------------------------------===//
|
||||
///
|
||||
/// Define information about builtin derived types from flang/module/xxx.f90
|
||||
/// files so that these types can be manipulated by lowering.
|
||||
///
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
||||
#ifndef FORTRAN_LOWER_BUILTINMODULES_H
|
||||
#define FORTRAN_LOWER_BUILTINMODULES_H
|
||||
|
||||
namespace Fortran::lower::builtin {
|
||||
/// Address field name of __builtin_c_f_pointer and __builtin_c_ptr types.
|
||||
constexpr char cptrFieldName[] = "__address";
|
||||
} // namespace Fortran::lower::builtin
|
||||
|
||||
#endif // FORTRAN_LOWER_BUILTINMODULES_H
|
|
@ -135,6 +135,19 @@ void createSomeArrayAssignment(AbstractConverter &converter,
|
|||
const SomeExpr &lhs, const SomeExpr &rhs,
|
||||
SymMap &symMap, StatementContext &stmtCtx);
|
||||
|
||||
/// Lower an array assignment expression with a pre-evaluated left hand side.
|
||||
///
|
||||
/// 1. Scan the rhs, creating the ArrayLoads and evaluate the scalar subparts to
|
||||
/// be added to the map.
|
||||
/// 2. Create the loop nest and evaluate the elemental expression, threading the
|
||||
/// results.
|
||||
/// 3. Copy the resulting array back with ArrayMergeStore to the lhs as
|
||||
/// determined per step 1.
|
||||
void createSomeArrayAssignment(AbstractConverter &converter,
|
||||
const fir::ExtendedValue &lhs,
|
||||
const SomeExpr &rhs, SymMap &symMap,
|
||||
StatementContext &stmtCtx);
|
||||
|
||||
/// Lower an array assignment expression with pre-evaluated left and right
|
||||
/// hand sides. This implements an array copy taking into account
|
||||
/// non-contiguity and potential overlaps.
|
||||
|
|
|
@ -21,6 +21,10 @@
|
|||
#include "mlir/IR/Value.h"
|
||||
#include "llvm/ADT/DenseMap.h"
|
||||
|
||||
namespace fir {
|
||||
class ExtendedValue;
|
||||
} // namespace fir
|
||||
|
||||
namespace Fortran ::lower {
|
||||
class AbstractConverter;
|
||||
class CallerInterface;
|
||||
|
@ -64,11 +68,22 @@ void mapCallInterfaceSymbols(AbstractConverter &,
|
|||
const Fortran::lower::CallerInterface &caller,
|
||||
SymMap &symMap);
|
||||
|
||||
// TODO: consider saving the initial expression symbol dependence analysis in
|
||||
// in the PFT variable and dealing with the dependent symbols instantiation in
|
||||
// the fir::GlobalOp body at the fir::GlobalOp creation point rather than by
|
||||
// having genExtAddrInInitializer and genInitialDataTarget custom entry points
|
||||
// here to deal with this while lowering the initial expression value.
|
||||
|
||||
/// Create initial-data-target fir.box in a global initializer region.
|
||||
/// This handles the local instantiation of the target variable.
|
||||
mlir::Value genInitialDataTarget(Fortran::lower::AbstractConverter &,
|
||||
mlir::Location, mlir::Type boxType,
|
||||
const SomeExpr &initialTarget);
|
||||
|
||||
/// Generate address \p addr inside an initializer.
|
||||
fir::ExtendedValue
|
||||
genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
|
||||
mlir::Location loc, const SomeExpr &addr);
|
||||
|
||||
} // namespace Fortran::lower
|
||||
#endif // FORTRAN_LOWER_CONVERT_VARIABLE_H
|
||||
|
|
|
@ -16,6 +16,15 @@
|
|||
#ifndef FORTRAN_LOWER_RUNTIME_H
|
||||
#define FORTRAN_LOWER_RUNTIME_H
|
||||
|
||||
namespace mlir {
|
||||
class Location;
|
||||
class Value;
|
||||
} // namespace mlir
|
||||
|
||||
namespace fir {
|
||||
class FirOpBuilder;
|
||||
} // namespace fir
|
||||
|
||||
namespace Fortran {
|
||||
|
||||
namespace parser {
|
||||
|
@ -51,6 +60,9 @@ void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &);
|
|||
void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &);
|
||||
void genPauseStatement(AbstractConverter &, const parser::PauseStmt &);
|
||||
|
||||
mlir::Value genAssociated(fir::FirOpBuilder &, mlir::Location,
|
||||
mlir::Value pointer, mlir::Value target);
|
||||
|
||||
} // namespace lower
|
||||
} // namespace Fortran
|
||||
|
||||
|
|
|
@ -28,10 +28,11 @@ class FirOpBuilder;
|
|||
|
||||
class CharBoxValue;
|
||||
class ArrayBoxValue;
|
||||
class CharArrayBoxValue;
|
||||
class ProcBoxValue;
|
||||
class MutableBoxValue;
|
||||
class BoxValue;
|
||||
class CharBoxValue;
|
||||
class CharArrayBoxValue;
|
||||
class MutableBoxValue;
|
||||
class ProcBoxValue;
|
||||
|
||||
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const CharBoxValue &);
|
||||
llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArrayBoxValue &);
|
||||
|
@ -86,6 +87,7 @@ public:
|
|||
mlir::Value getBuffer() const { return getAddr(); }
|
||||
|
||||
mlir::Value getLen() const { return len; }
|
||||
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &,
|
||||
const CharBoxValue &);
|
||||
LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
|
||||
|
@ -112,7 +114,7 @@ public:
|
|||
}
|
||||
|
||||
// An array expression may have user-defined lower bound values.
|
||||
// If this vector is empty, the default in all dimensions is `1`.
|
||||
// If this vector is empty, the default in all dimensions in `1`.
|
||||
const llvm::SmallVectorImpl<mlir::Value> &getLBounds() const {
|
||||
return lbounds;
|
||||
}
|
||||
|
@ -272,6 +274,11 @@ public:
|
|||
// TODO: check contiguous attribute of addr
|
||||
bool isContiguous() const { return false; }
|
||||
|
||||
// Replace the fir.box, keeping any non-deferred parameters.
|
||||
BoxValue clone(mlir::Value newBox) const {
|
||||
return {newBox, lbounds, explicitParams, extents};
|
||||
}
|
||||
|
||||
friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const BoxValue &);
|
||||
LLVM_DUMP_METHOD void dump() const { llvm::errs() << *this; }
|
||||
|
||||
|
@ -404,6 +411,9 @@ bool isArray(const ExtendedValue &exv);
|
|||
/// Get the type parameters for `exv`.
|
||||
llvm::SmallVector<mlir::Value> getTypeParams(const ExtendedValue &exv);
|
||||
|
||||
// The generalized function to get a vector of extents is
|
||||
// fir::factory::getExtents(). See FIRBuilder.h.
|
||||
|
||||
/// Get exactly one extent for any array-like extended value, \p exv. If \p exv
|
||||
/// is not an array or has rank less then \p dim, the result will be a nullptr.
|
||||
mlir::Value getExtentAtDimension(const ExtendedValue &exv,
|
||||
|
@ -430,10 +440,7 @@ public:
|
|||
auto type = b->getType();
|
||||
if (type.template isa<fir::BoxCharType>())
|
||||
fir::emitFatalError(b->getLoc(), "BoxChar should be unboxed");
|
||||
if (auto refType = type.template dyn_cast<fir::ReferenceType>())
|
||||
type = refType.getEleTy();
|
||||
if (auto seqType = type.template dyn_cast<fir::SequenceType>())
|
||||
type = seqType.getEleTy();
|
||||
type = fir::unwrapSequenceType(fir::unwrapRefType(type));
|
||||
if (fir::isa_char(type))
|
||||
fir::emitFatalError(b->getLoc(),
|
||||
"character buffer should be in CharBoxValue");
|
||||
|
|
|
@ -1720,8 +1720,19 @@ private:
|
|||
Fortran::lower::genDeallocateStmt(*this, stmt, toLocation());
|
||||
}
|
||||
|
||||
/// Nullify pointer object list
|
||||
///
|
||||
/// For each pointer object, reset the pointer to a disassociated status.
|
||||
/// We do this by setting each pointer to null.
|
||||
void genFIR(const Fortran::parser::NullifyStmt &stmt) {
|
||||
TODO(toLocation(), "NullifyStmt lowering");
|
||||
mlir::Location loc = toLocation();
|
||||
for (auto &pointerObject : stmt.v) {
|
||||
const Fortran::lower::SomeExpr *expr =
|
||||
Fortran::semantics::GetExpr(pointerObject);
|
||||
assert(expr);
|
||||
fir::MutableBoxValue box = genExprMutableBox(loc, *expr);
|
||||
fir::factory::disassociateMutableBox(*builder, loc, box);
|
||||
}
|
||||
}
|
||||
|
||||
//===--------------------------------------------------------------------===//
|
||||
|
@ -1868,7 +1879,7 @@ private:
|
|||
}
|
||||
|
||||
void genFIR(const Fortran::parser::PointerAssignmentStmt &stmt) {
|
||||
TODO(toLocation(), "PointerAssignmentStmt lowering");
|
||||
genAssignment(*stmt.typedAssignment->v);
|
||||
}
|
||||
|
||||
void genFIR(const Fortran::parser::AssignmentStmt &stmt) {
|
||||
|
|
|
@ -14,6 +14,8 @@
|
|||
#include "flang/Evaluate/fold.h"
|
||||
#include "flang/Evaluate/traverse.h"
|
||||
#include "flang/Lower/AbstractConverter.h"
|
||||
#include "flang/Lower/Allocatable.h"
|
||||
#include "flang/Lower/BuiltinModules.h"
|
||||
#include "flang/Lower/CallInterface.h"
|
||||
#include "flang/Lower/ComponentPath.h"
|
||||
#include "flang/Lower/ConvertType.h"
|
||||
|
@ -34,6 +36,7 @@
|
|||
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
|
||||
#include "flang/Optimizer/Builder/Runtime/Ragged.h"
|
||||
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
|
||||
#include "flang/Optimizer/Support/Matcher.h"
|
||||
#include "flang/Semantics/expression.h"
|
||||
#include "flang/Semantics/symbol.h"
|
||||
#include "flang/Semantics/tools.h"
|
||||
|
@ -650,8 +653,175 @@ public:
|
|||
TODO(getLoc(), "genval NullPointer");
|
||||
}
|
||||
|
||||
static bool
|
||||
isDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
|
||||
if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
|
||||
if (const Fortran::semantics::DerivedTypeSpec *derived =
|
||||
declTy->AsDerived())
|
||||
return Fortran::semantics::CountLenParameters(*derived) > 0;
|
||||
return false;
|
||||
}
|
||||
|
||||
static bool isBuiltinCPtr(const Fortran::semantics::Symbol &sym) {
|
||||
if (const Fortran::semantics::DeclTypeSpec *declType = sym.GetType())
|
||||
if (const Fortran::semantics::DerivedTypeSpec *derived =
|
||||
declType->AsDerived())
|
||||
return Fortran::semantics::IsIsoCType(derived);
|
||||
return false;
|
||||
}
|
||||
|
||||
/// Lower structure constructor without a temporary. This can be used in
|
||||
/// fir::GloablOp, and assumes that the structure component is a constant.
|
||||
ExtValue genStructComponentInInitializer(
|
||||
const Fortran::evaluate::StructureConstructor &ctor) {
|
||||
mlir::Location loc = getLoc();
|
||||
mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor));
|
||||
auto recTy = ty.cast<fir::RecordType>();
|
||||
auto fieldTy = fir::FieldType::get(ty.getContext());
|
||||
mlir::Value res = builder.create<fir::UndefOp>(loc, recTy);
|
||||
|
||||
for (const auto &[sym, expr] : ctor.values()) {
|
||||
// Parent components need more work because they do not appear in the
|
||||
// fir.rec type.
|
||||
if (sym->test(Fortran::semantics::Symbol::Flag::ParentComp))
|
||||
TODO(loc, "parent component in structure constructor");
|
||||
|
||||
llvm::StringRef name = toStringRef(sym->name());
|
||||
mlir::Type componentTy = recTy.getType(name);
|
||||
// FIXME: type parameters must come from the derived-type-spec
|
||||
auto field = builder.create<fir::FieldIndexOp>(
|
||||
loc, fieldTy, name, ty,
|
||||
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
|
||||
|
||||
if (Fortran::semantics::IsAllocatable(sym))
|
||||
TODO(loc, "allocatable component in structure constructor");
|
||||
|
||||
if (Fortran::semantics::IsPointer(sym)) {
|
||||
mlir::Value initialTarget = Fortran::lower::genInitialDataTarget(
|
||||
converter, loc, componentTy, expr.value());
|
||||
res = builder.create<fir::InsertValueOp>(
|
||||
loc, recTy, res, initialTarget,
|
||||
builder.getArrayAttr(field.getAttributes()));
|
||||
continue;
|
||||
}
|
||||
|
||||
if (isDerivedTypeWithLengthParameters(sym))
|
||||
TODO(loc, "component with length parameters in structure constructor");
|
||||
|
||||
if (isBuiltinCPtr(sym)) {
|
||||
// Builtin c_ptr and c_funptr have special handling because initial
|
||||
// value are handled for them as an extension.
|
||||
mlir::Value addr = fir::getBase(Fortran::lower::genExtAddrInInitializer(
|
||||
converter, loc, expr.value()));
|
||||
if (addr.getType() == componentTy) {
|
||||
// Do nothing. The Ev::Expr was returned as a value that can be
|
||||
// inserted directly to the component without an intermediary.
|
||||
} else {
|
||||
// The Ev::Expr returned is an initializer that is a pointer (e.g.,
|
||||
// null) that must be inserted into an intermediate cptr record
|
||||
// value's address field, which ought to be an intptr_t on the target.
|
||||
assert((fir::isa_ref_type(addr.getType()) ||
|
||||
addr.getType().isa<mlir::FunctionType>()) &&
|
||||
"expect reference type for address field");
|
||||
assert(fir::isa_derived(componentTy) &&
|
||||
"expect C_PTR, C_FUNPTR to be a record");
|
||||
auto cPtrRecTy = componentTy.cast<fir::RecordType>();
|
||||
llvm::StringRef addrFieldName =
|
||||
Fortran::lower::builtin::cptrFieldName;
|
||||
mlir::Type addrFieldTy = cPtrRecTy.getType(addrFieldName);
|
||||
auto addrField = builder.create<fir::FieldIndexOp>(
|
||||
loc, fieldTy, addrFieldName, componentTy,
|
||||
/*typeParams=*/mlir::ValueRange{});
|
||||
mlir::Value castAddr = builder.createConvert(loc, addrFieldTy, addr);
|
||||
auto undef = builder.create<fir::UndefOp>(loc, componentTy);
|
||||
addr = builder.create<fir::InsertValueOp>(
|
||||
loc, componentTy, undef, castAddr,
|
||||
builder.getArrayAttr(addrField.getAttributes()));
|
||||
}
|
||||
res = builder.create<fir::InsertValueOp>(
|
||||
loc, recTy, res, addr, builder.getArrayAttr(field.getAttributes()));
|
||||
continue;
|
||||
}
|
||||
|
||||
mlir::Value val = fir::getBase(genval(expr.value()));
|
||||
assert(!fir::isa_ref_type(val.getType()) && "expecting a constant value");
|
||||
mlir::Value castVal = builder.createConvert(loc, componentTy, val);
|
||||
res = builder.create<fir::InsertValueOp>(
|
||||
loc, recTy, res, castVal,
|
||||
builder.getArrayAttr(field.getAttributes()));
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
/// A structure constructor is lowered two ways. In an initializer context,
|
||||
/// the entire structure must be constant, so the aggregate value is
|
||||
/// constructed inline. This allows it to be the body of a GlobalOp.
|
||||
/// Otherwise, the structure constructor is in an expression. In that case, a
|
||||
/// temporary object is constructed in the stack frame of the procedure.
|
||||
ExtValue genval(const Fortran::evaluate::StructureConstructor &ctor) {
|
||||
TODO(getLoc(), "genval StructureConstructor");
|
||||
if (inInitializer)
|
||||
return genStructComponentInInitializer(ctor);
|
||||
mlir::Location loc = getLoc();
|
||||
mlir::Type ty = translateSomeExprToFIRType(converter, toEvExpr(ctor));
|
||||
auto recTy = ty.cast<fir::RecordType>();
|
||||
auto fieldTy = fir::FieldType::get(ty.getContext());
|
||||
mlir::Value res = builder.createTemporary(loc, recTy);
|
||||
|
||||
for (const auto &value : ctor.values()) {
|
||||
const Fortran::semantics::Symbol &sym = *value.first;
|
||||
const Fortran::lower::SomeExpr &expr = value.second.value();
|
||||
// Parent components need more work because they do not appear in the
|
||||
// fir.rec type.
|
||||
if (sym.test(Fortran::semantics::Symbol::Flag::ParentComp))
|
||||
TODO(loc, "parent component in structure constructor");
|
||||
|
||||
if (isDerivedTypeWithLengthParameters(sym))
|
||||
TODO(loc, "component with length parameters in structure constructor");
|
||||
|
||||
llvm::StringRef name = toStringRef(sym.name());
|
||||
// FIXME: type parameters must come from the derived-type-spec
|
||||
mlir::Value field = builder.create<fir::FieldIndexOp>(
|
||||
loc, fieldTy, name, ty,
|
||||
/*typeParams=*/mlir::ValueRange{} /*TODO*/);
|
||||
mlir::Type coorTy = builder.getRefType(recTy.getType(name));
|
||||
auto coor = builder.create<fir::CoordinateOp>(loc, coorTy,
|
||||
fir::getBase(res), field);
|
||||
ExtValue to = fir::factory::componentToExtendedValue(builder, loc, coor);
|
||||
to.match(
|
||||
[&](const fir::UnboxedValue &toPtr) {
|
||||
ExtValue value = genval(expr);
|
||||
fir::factory::genScalarAssignment(builder, loc, to, value);
|
||||
},
|
||||
[&](const fir::CharBoxValue &) {
|
||||
ExtValue value = genval(expr);
|
||||
fir::factory::genScalarAssignment(builder, loc, to, value);
|
||||
},
|
||||
[&](const fir::ArrayBoxValue &) {
|
||||
Fortran::lower::createSomeArrayAssignment(converter, to, expr,
|
||||
symMap, stmtCtx);
|
||||
},
|
||||
[&](const fir::CharArrayBoxValue &) {
|
||||
Fortran::lower::createSomeArrayAssignment(converter, to, expr,
|
||||
symMap, stmtCtx);
|
||||
},
|
||||
[&](const fir::BoxValue &toBox) {
|
||||
fir::emitFatalError(loc, "derived type components must not be "
|
||||
"represented by fir::BoxValue");
|
||||
},
|
||||
[&](const fir::MutableBoxValue &toBox) {
|
||||
if (toBox.isPointer()) {
|
||||
Fortran::lower::associateMutableBox(
|
||||
converter, loc, toBox, expr, /*lbounds=*/llvm::None, stmtCtx);
|
||||
return;
|
||||
}
|
||||
// For allocatable components, a deep copy is needed.
|
||||
TODO(loc, "allocatable components in derived type assignment");
|
||||
},
|
||||
[&](const fir::ProcBoxValue &toBox) {
|
||||
TODO(loc, "procedure pointer component in derived type assignment");
|
||||
});
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
/// Lowering of an <i>ac-do-variable</i>, which is not a Symbol.
|
||||
|
@ -1124,6 +1294,36 @@ public:
|
|||
}
|
||||
}
|
||||
|
||||
fir::ExtendedValue genArrayLit(
|
||||
const Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived> &con) {
|
||||
mlir::Location loc = getLoc();
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
Fortran::evaluate::ConstantSubscript size =
|
||||
Fortran::evaluate::GetSize(con.shape());
|
||||
fir::SequenceType::Shape shape(con.shape().begin(), con.shape().end());
|
||||
mlir::Type eleTy = converter.genType(con.GetType().GetDerivedTypeSpec());
|
||||
auto arrayTy = fir::SequenceType::get(shape, eleTy);
|
||||
mlir::Value array = builder.create<fir::UndefOp>(loc, arrayTy);
|
||||
llvm::SmallVector<mlir::Value> lbounds;
|
||||
llvm::SmallVector<mlir::Value> extents;
|
||||
for (auto [lb, extent] : llvm::zip(con.lbounds(), con.shape())) {
|
||||
lbounds.push_back(builder.createIntegerConstant(loc, idxTy, lb - 1));
|
||||
extents.push_back(builder.createIntegerConstant(loc, idxTy, extent));
|
||||
}
|
||||
if (size == 0)
|
||||
return fir::ArrayBoxValue{array, extents, lbounds};
|
||||
Fortran::evaluate::ConstantSubscripts subscripts = con.lbounds();
|
||||
do {
|
||||
mlir::Value derivedVal = fir::getBase(genval(con.At(subscripts)));
|
||||
llvm::SmallVector<mlir::Attribute> idx;
|
||||
for (auto [dim, lb] : llvm::zip(subscripts, con.lbounds()))
|
||||
idx.push_back(builder.getIntegerAttr(idxTy, dim - lb));
|
||||
array = builder.create<fir::InsertValueOp>(
|
||||
loc, arrayTy, array, derivedVal, builder.getArrayAttr(idx));
|
||||
} while (con.IncrementSubscripts(subscripts));
|
||||
return fir::ArrayBoxValue{array, extents, lbounds};
|
||||
}
|
||||
|
||||
template <Fortran::common::TypeCategory TC, int KIND>
|
||||
ExtValue
|
||||
genval(const Fortran::evaluate::Constant<Fortran::evaluate::Type<TC, KIND>>
|
||||
|
@ -1142,7 +1342,12 @@ public:
|
|||
|
||||
fir::ExtendedValue genval(
|
||||
const Fortran::evaluate::Constant<Fortran::evaluate::SomeDerived> &con) {
|
||||
TODO(getLoc(), "genval constant derived");
|
||||
if (con.Rank() > 0)
|
||||
return genArrayLit(con);
|
||||
if (auto ctor = con.GetScalarValue())
|
||||
return genval(ctor.value());
|
||||
fir::emitFatalError(getLoc(),
|
||||
"constant of derived type has no constructor");
|
||||
}
|
||||
|
||||
template <typename A>
|
||||
|
@ -5832,6 +6037,15 @@ void Fortran::lower::createSomeArrayAssignment(
|
|||
ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs);
|
||||
}
|
||||
|
||||
void Fortran::lower::createSomeArrayAssignment(
|
||||
Fortran::lower::AbstractConverter &converter, const fir::ExtendedValue &lhs,
|
||||
const Fortran::lower::SomeExpr &rhs, Fortran::lower::SymMap &symMap,
|
||||
Fortran::lower::StatementContext &stmtCtx) {
|
||||
LLVM_DEBUG(llvm::dbgs() << "onto array: " << lhs << '\n';
|
||||
rhs.AsFortran(llvm::dbgs() << "assign expression: ") << '\n';);
|
||||
ArrayExprLowering::lowerArrayAssignment(converter, symMap, stmtCtx, lhs, rhs);
|
||||
}
|
||||
|
||||
void Fortran::lower::createSomeArrayAssignment(
|
||||
Fortran::lower::AbstractConverter &converter, const fir::ExtendedValue &lhs,
|
||||
const fir::ExtendedValue &rhs, Fortran::lower::SymMap &symMap,
|
||||
|
|
|
@ -162,6 +162,27 @@ static mlir::Type unwrapElementType(mlir::Type type) {
|
|||
return type;
|
||||
}
|
||||
|
||||
fir::ExtendedValue Fortran::lower::genExtAddrInInitializer(
|
||||
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
|
||||
const Fortran::lower::SomeExpr &addr) {
|
||||
Fortran::lower::SymMap globalOpSymMap;
|
||||
Fortran::lower::AggregateStoreMap storeMap;
|
||||
Fortran::lower::StatementContext stmtCtx;
|
||||
if (const Fortran::semantics::Symbol *sym =
|
||||
Fortran::evaluate::GetFirstSymbol(addr)) {
|
||||
// Length parameters processing will need care in global initializer
|
||||
// context.
|
||||
if (hasDerivedTypeWithLengthParameters(*sym))
|
||||
TODO(loc, "initial-data-target with derived type length parameters");
|
||||
|
||||
auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
|
||||
Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
|
||||
storeMap);
|
||||
}
|
||||
return Fortran::lower::createInitializerAddress(loc, converter, addr,
|
||||
globalOpSymMap, stmtCtx);
|
||||
}
|
||||
|
||||
/// create initial-data-target fir.box in a global initializer region.
|
||||
mlir::Value Fortran::lower::genInitialDataTarget(
|
||||
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
|
||||
|
|
|
@ -16,6 +16,7 @@
|
|||
#include "flang/Lower/IntrinsicCall.h"
|
||||
#include "flang/Common/static-multimap-view.h"
|
||||
#include "flang/Lower/Mangler.h"
|
||||
#include "flang/Lower/Runtime.h"
|
||||
#include "flang/Lower/StatementContext.h"
|
||||
#include "flang/Lower/SymbolMap.h"
|
||||
#include "flang/Lower/Todo.h"
|
||||
|
@ -26,6 +27,7 @@
|
|||
#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
|
||||
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
|
||||
#include "flang/Optimizer/Builder/Runtime/Reduction.h"
|
||||
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
|
||||
#include "flang/Optimizer/Support/FatalError.h"
|
||||
#include "mlir/Dialect/LLVMIR/LLVMDialect.h"
|
||||
#include "llvm/Support/CommandLine.h"
|
||||
|
@ -232,6 +234,8 @@ struct IntrinsicLibrary {
|
|||
/// if the argument is an integer, into llvm intrinsics if the argument is
|
||||
/// real and to the `hypot` math routine if the argument is of complex type.
|
||||
mlir::Value genAbs(mlir::Type, llvm::ArrayRef<mlir::Value>);
|
||||
fir::ExtendedValue genAssociated(mlir::Type,
|
||||
llvm::ArrayRef<fir::ExtendedValue>);
|
||||
template <Extremum, ExtremumBehavior>
|
||||
mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
|
||||
/// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
|
||||
|
@ -311,6 +315,7 @@ struct IntrinsicHandler {
|
|||
|
||||
constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
|
||||
constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
|
||||
constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
|
||||
using I = IntrinsicLibrary;
|
||||
|
||||
/// Flag to indicate that an intrinsic argument has to be handled as
|
||||
|
@ -327,6 +332,10 @@ static constexpr bool handleDynamicOptional = true;
|
|||
/// should be provided for all the intrinsic arguments for completeness.
|
||||
static constexpr IntrinsicHandler handlers[]{
|
||||
{"abs", &I::genAbs},
|
||||
{"associated",
|
||||
&I::genAssociated,
|
||||
{{{"pointer", asInquired}, {"target", asInquired}}},
|
||||
/*isElemental=*/false},
|
||||
{"iand", &I::genIand},
|
||||
{"sum",
|
||||
&I::genSum,
|
||||
|
@ -1045,6 +1054,44 @@ mlir::Value IntrinsicLibrary::genAbs(mlir::Type resultType,
|
|||
llvm_unreachable("unexpected type in ABS argument");
|
||||
}
|
||||
|
||||
// ASSOCIATED
|
||||
fir::ExtendedValue
|
||||
IntrinsicLibrary::genAssociated(mlir::Type resultType,
|
||||
llvm::ArrayRef<fir::ExtendedValue> args) {
|
||||
assert(args.size() == 2);
|
||||
auto *pointer =
|
||||
args[0].match([&](const fir::MutableBoxValue &x) { return &x; },
|
||||
[&](const auto &) -> const fir::MutableBoxValue * {
|
||||
fir::emitFatalError(loc, "pointer not a MutableBoxValue");
|
||||
});
|
||||
const fir::ExtendedValue &target = args[1];
|
||||
if (isAbsent(target))
|
||||
return fir::factory::genIsAllocatedOrAssociatedTest(builder, loc, *pointer);
|
||||
|
||||
mlir::Value targetBox = builder.createBox(loc, target);
|
||||
if (fir::valueHasFirAttribute(fir::getBase(target),
|
||||
fir::getOptionalAttrName())) {
|
||||
// Subtle: contrary to other intrinsic optional arguments, disassociated
|
||||
// POINTER and unallocated ALLOCATABLE actual argument are not considered
|
||||
// absent here. This is because ASSOCIATED has special requirements for
|
||||
// TARGET actual arguments that are POINTERs. There is no precise
|
||||
// requirements for ALLOCATABLEs, but all existing Fortran compilers treat
|
||||
// them similarly to POINTERs. That is: unallocated TARGETs cause ASSOCIATED
|
||||
// to rerun false. The runtime deals with the disassociated/unallocated
|
||||
// case. Simply ensures that TARGET that are OPTIONAL get conditionally
|
||||
// emboxed here to convey the optional aspect to the runtime.
|
||||
auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
|
||||
fir::getBase(target));
|
||||
auto absentBox = builder.create<fir::AbsentOp>(loc, targetBox.getType());
|
||||
targetBox = builder.create<mlir::arith::SelectOp>(loc, isPresent, targetBox,
|
||||
absentBox);
|
||||
}
|
||||
mlir::Value pointerBoxRef =
|
||||
fir::factory::getMutableIRBox(builder, loc, *pointer);
|
||||
auto pointerBox = builder.create<fir::LoadOp>(loc, pointerBoxRef);
|
||||
return Fortran::lower::genAssociated(builder, loc, pointerBox, targetBox);
|
||||
}
|
||||
|
||||
// IAND
|
||||
mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
|
||||
llvm::ArrayRef<mlir::Value> args) {
|
||||
|
|
|
@ -13,6 +13,7 @@
|
|||
#include "flang/Optimizer/Builder/FIRBuilder.h"
|
||||
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
|
||||
#include "flang/Parser/parse-tree.h"
|
||||
#include "flang/Runtime/pointer.h"
|
||||
#include "flang/Runtime/stop.h"
|
||||
#include "flang/Semantics/tools.h"
|
||||
#include "llvm/Support/Debug.h"
|
||||
|
@ -112,3 +113,15 @@ void Fortran::lower::genPauseStatement(
|
|||
fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);
|
||||
builder.create<fir::CallOp>(loc, callee, llvm::None);
|
||||
}
|
||||
|
||||
mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder,
|
||||
mlir::Location loc,
|
||||
mlir::Value pointer,
|
||||
mlir::Value target) {
|
||||
mlir::FuncOp func =
|
||||
fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
|
||||
builder);
|
||||
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
|
||||
builder, loc, func.getType(), pointer, target);
|
||||
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
|
||||
}
|
||||
|
|
|
@ -39,12 +39,6 @@ fir::ExtendedValue fir::substBase(const fir::ExtendedValue &exv,
|
|||
mlir::Value base) {
|
||||
return exv.match(
|
||||
[=](const fir::UnboxedValue &x) { return fir::ExtendedValue(base); },
|
||||
[=](const fir::BoxValue &) -> fir::ExtendedValue {
|
||||
llvm::report_fatal_error("TODO: substbase of BoxValue");
|
||||
},
|
||||
[=](const fir::MutableBoxValue &) -> fir::ExtendedValue {
|
||||
llvm::report_fatal_error("TODO: substbase of MutableBoxValue");
|
||||
},
|
||||
[=](const auto &x) { return fir::ExtendedValue(x.clone(base)); });
|
||||
}
|
||||
|
||||
|
|
137
flang/test/Lower/Intrinsics/associated.f90
Normal file
137
flang/test/Lower/Intrinsics/associated.f90
Normal file
|
@ -0,0 +1,137 @@
|
|||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
! CHECK-LABEL: associated_test
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine associated_test(scalar, array)
|
||||
real, pointer :: scalar, array(:)
|
||||
real, target :: ziel
|
||||
! CHECK: %[[ziel:.*]] = fir.alloca f32 {bindc_name = "ziel"
|
||||
! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[addr0:.*]] = fir.box_addr %[[scalar]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
|
||||
! CHECK: %[[addrToInt0:.*]] = fir.convert %[[addr0]]
|
||||
! CHECK: cmpi ne, %[[addrToInt0]], %c0{{.*}}
|
||||
print *, associated(scalar)
|
||||
! CHECK: %[[array:.*]] = fir.load %[[arg1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[addr1:.*]] = fir.box_addr %[[array]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[addrToInt1:.*]] = fir.convert %[[addr1]]
|
||||
! CHECK: cmpi ne, %[[addrToInt1]], %c0{{.*}}
|
||||
print *, associated(array)
|
||||
! CHECK: %[[zbox0:.*]] = fir.embox %[[ziel]] : (!fir.ref<f32>) -> !fir.box<f32>
|
||||
! CHECK: %[[scalar:.*]] = fir.load %[[arg0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[sbox:.*]] = fir.convert %[[scalar]] : (!fir.box<!fir.ptr<f32>>) -> !fir.box<none>
|
||||
! CHECK: %[[zbox:.*]] = fir.convert %[[zbox0]] : (!fir.box<f32>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[sbox]], %[[zbox]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
print *, associated(scalar, ziel)
|
||||
end subroutine
|
||||
|
||||
subroutine test_func_results()
|
||||
interface
|
||||
function get_pointer()
|
||||
real, pointer :: get_pointer(:)
|
||||
end function
|
||||
end interface
|
||||
! CHECK: %[[result:.*]] = fir.call @_QPget_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.save_result %[[result]] to %[[box_storage:.*]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[box:.*]] = fir.load %[[box_storage]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.array<?xf32>>) -> i64
|
||||
! CHECK: arith.cmpi ne, %[[addr_cast]], %c0{{.*}} : i64
|
||||
print *, associated(get_pointer())
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_optional_target_1(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.array<10xf32>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) {
|
||||
subroutine test_optional_target_1(p, optionales_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, optional, target :: optionales_ziel(10)
|
||||
print *, associated(p, optionales_ziel)
|
||||
! CHECK: %[[VAL_2:.*]] = arith.constant 10 : index
|
||||
! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_1]](%[[VAL_8]]) : (!fir.ref<!fir.array<10xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xf32>>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.array<10xf32>>) -> i1
|
||||
! CHECK: %[[VAL_11:.*]] = fir.absent !fir.box<!fir.array<10xf32>>
|
||||
! CHECK: %[[VAL_12:.*]] = arith.select %[[VAL_10]], %[[VAL_9]], %[[VAL_11]] : !fir.box<!fir.array<10xf32>>
|
||||
! CHECK: %[[VAL_13:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_12]] : (!fir.box<!fir.array<10xf32>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_14]], %[[VAL_15]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_optional_target_2(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) {
|
||||
subroutine test_optional_target_2(p, optionales_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, optional, target :: optionales_ziel(:)
|
||||
print *, associated(p, optionales_ziel)
|
||||
! CHECK: %[[VAL_7:.*]] = fir.is_present %[[VAL_1]] : (!fir.box<!fir.array<?xf32>>) -> i1
|
||||
! CHECK: %[[VAL_8:.*]] = fir.absent !fir.box<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_9:.*]] = arith.select %[[VAL_7]], %[[VAL_1]], %[[VAL_8]] : !fir.box<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_9]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_11]], %[[VAL_12]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_optional_target_3(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "optionales_ziel", fir.optional}) {
|
||||
subroutine test_optional_target_3(p, optionales_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, optional, pointer :: optionales_ziel(:)
|
||||
print *, associated(p, optionales_ziel)
|
||||
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>) -> i1
|
||||
! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_8]], %[[VAL_7]], %[[VAL_9]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_optional_target_4(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "optionales_ziel", fir.optional, fir.target}) {
|
||||
subroutine test_optional_target_4(p, optionales_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, optional, allocatable, target :: optionales_ziel(:)
|
||||
print *, associated(p, optionales_ziel)
|
||||
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.is_present %[[VAL_1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>) -> i1
|
||||
! CHECK: %[[VAL_9:.*]] = fir.absent !fir.box<!fir.heap<!fir.array<?xf32>>>
|
||||
! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_8]], %[[VAL_7]], %[[VAL_9]] : !fir.box<!fir.heap<!fir.array<?xf32>>>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_10]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_12]], %[[VAL_13]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_pointer_target(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "pointer_ziel"}) {
|
||||
subroutine test_pointer_target(p, pointer_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, pointer :: pointer_ziel(:)
|
||||
print *, associated(p, pointer_ziel)
|
||||
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_9]], %[[VAL_10]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_allocatable_target(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {fir.bindc_name = "p"},
|
||||
! CHECK-SAME: %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>> {fir.bindc_name = "allocatable_ziel", fir.target}) {
|
||||
subroutine test_allocatable_target(p, allocatable_ziel)
|
||||
real, pointer :: p(:)
|
||||
real, allocatable, target :: allocatable_ziel(:)
|
||||
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.heap<!fir.array<?xf32>>>) -> !fir.box<none>
|
||||
! CHECK: fir.call @_FortranAPointerIsAssociatedWith(%[[VAL_9]], %[[VAL_10]]) : (!fir.box<none>, !fir.box<none>) -> i1
|
||||
print *, associated(p, allocatable_ziel)
|
||||
end subroutine
|
675
flang/test/Lower/derived-pointer-components.f90
Normal file
675
flang/test/Lower/derived-pointer-components.f90
Normal file
|
@ -0,0 +1,675 @@
|
|||
! Test lowering of pointer components
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
module pcomp
|
||||
implicit none
|
||||
type t
|
||||
real :: x
|
||||
integer :: i
|
||||
end type
|
||||
interface
|
||||
subroutine takes_real_scalar(x)
|
||||
real :: x
|
||||
end subroutine
|
||||
subroutine takes_char_scalar(x)
|
||||
character(*) :: x
|
||||
end subroutine
|
||||
subroutine takes_derived_scalar(x)
|
||||
import t
|
||||
type(t) :: x
|
||||
end subroutine
|
||||
subroutine takes_real_array(x)
|
||||
real :: x(:)
|
||||
end subroutine
|
||||
subroutine takes_char_array(x)
|
||||
character(*) :: x(:)
|
||||
end subroutine
|
||||
subroutine takes_derived_array(x)
|
||||
import t
|
||||
type(t) :: x(:)
|
||||
end subroutine
|
||||
subroutine takes_real_scalar_pointer(x)
|
||||
real, pointer :: x
|
||||
end subroutine
|
||||
subroutine takes_real_array_pointer(x)
|
||||
real, pointer :: x(:)
|
||||
end subroutine
|
||||
subroutine takes_logical(x)
|
||||
logical :: x
|
||||
end subroutine
|
||||
end interface
|
||||
|
||||
type real_p0
|
||||
real, pointer :: p
|
||||
end type
|
||||
type real_p1
|
||||
real, pointer :: p(:)
|
||||
end type
|
||||
type cst_char_p0
|
||||
character(10), pointer :: p
|
||||
end type
|
||||
type cst_char_p1
|
||||
character(10), pointer :: p(:)
|
||||
end type
|
||||
type def_char_p0
|
||||
character(:), pointer :: p
|
||||
end type
|
||||
type def_char_p1
|
||||
character(:), pointer :: p(:)
|
||||
end type
|
||||
type derived_p0
|
||||
type(t), pointer :: p
|
||||
end type
|
||||
type derived_p1
|
||||
type(t), pointer :: p(:)
|
||||
end type
|
||||
|
||||
real, target :: real_target, real_array_target(100)
|
||||
character(10), target :: char_target, char_array_target(100)
|
||||
|
||||
contains
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test pointer component references
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPref_scalar_real_p(
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>{{.*}}, %[[arg1:.*]]: !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>{{.*}}, %[[arg2:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>{{.*}}, %[[arg3:.*]]: !fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>{{.*}}) {
|
||||
subroutine ref_scalar_real_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg0]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32>
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> ()
|
||||
call takes_real_scalar(p0_0%p)
|
||||
|
||||
! CHECK: %[[p0_1_coor:.*]] = fir.coordinate_of %[[arg2]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p0{p:!fir.box<!fir.ptr<f32>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[load]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<f32>) -> !fir.ref<f32>
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[cast]]) : (!fir.ref<f32>) -> ()
|
||||
call takes_real_scalar(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[arg1]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32>
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> ()
|
||||
call takes_real_scalar(p1_0%p(7))
|
||||
|
||||
! CHECK: %[[p1_1_coor:.*]] = fir.coordinate_of %[[arg3]], %{{.*}} : (!fir.ref<!fir.array<100x!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>, i64) -> !fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p, !fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_1_coor]], %[[fld]] : (!fir.ref<!fir.type<_QMpcompTreal_p1{p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>, !fir.field) -> !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[load:.*]] = fir.load %[[coor]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[load]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]] : i64
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[load]], %[[index]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, i64) -> !fir.ref<f32>
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[coor]]) : (!fir.ref<f32>) -> ()
|
||||
call takes_real_scalar(p1_1(5)%p(7))
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPassign_scalar_real
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine assign_scalar_real_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK: fir.store {{.*}} to %[[addr]]
|
||||
p0_0%p = 1.
|
||||
|
||||
! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK: fir.store {{.*}} to %[[addr]]
|
||||
p0_1(5)%p = 2.
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}}
|
||||
! CHECK: fir.store {{.*}} to %[[addr]]
|
||||
p1_0%p(7) = 3.
|
||||
|
||||
! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], {{.*}}
|
||||
! CHECK: fir.store {{.*}} to %[[addr]]
|
||||
p1_1(5)%p(7) = 4.
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPref_scalar_cst_char_p
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine ref_scalar_cst_char_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(cst_char_p0) :: p0_0, p0_1(100)
|
||||
type(cst_char_p1) :: p1_0, p1_1(100)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p0_1(5)%p)
|
||||
|
||||
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p1_0%p(7))
|
||||
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %c10{{.*}}
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p1_1(5)%p(7))
|
||||
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPref_scalar_def_char_p
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine ref_scalar_def_char_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(def_char_p0) :: p0_0, p0_1(100)
|
||||
type(def_char_p1) :: p1_0, p1_1(100)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
|
||||
! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]]
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
|
||||
! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[box]]
|
||||
! CHECK-DAG: %[[cast:.*]] = fir.convert %[[addr]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[cast]], %[[len]]
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p0_1(5)%p)
|
||||
|
||||
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
|
||||
! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p1_0%p(7))
|
||||
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK-DAG: %[[len:.*]] = fir.box_elesize %[[box]]
|
||||
! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK-DAG: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK-DAG: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK-DAG: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[boxchar:.*]] = fir.emboxchar %[[addr]], %[[len]]
|
||||
! CHECK: fir.call @_QPtakes_char_scalar(%[[boxchar]])
|
||||
call takes_char_scalar(p1_1(5)%p(7))
|
||||
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPref_scalar_derived
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine ref_scalar_derived(p0_0, p1_0, p0_1, p1_1)
|
||||
type(derived_p0) :: p0_0, p0_1(100)
|
||||
type(derived_p1) :: p1_0, p1_1(100)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[fldx:.*]] = fir.field_index x
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
|
||||
call takes_real_scalar(p0_0%p%x)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[fldx:.*]] = fir.field_index x
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[box]], %[[fldx]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
|
||||
call takes_real_scalar(p0_1(5)%p%x)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[fldx:.*]] = fir.field_index x
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
|
||||
call takes_real_scalar(p1_0%p(7)%x)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}}
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[dims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK: %[[elem:.*]] = fir.coordinate_of %[[box]], %[[index]]
|
||||
! CHECK: %[[fldx:.*]] = fir.field_index x
|
||||
! CHECK: %[[addr:.*]] = fir.coordinate_of %[[elem]], %[[fldx]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar(%[[addr]])
|
||||
call takes_real_scalar(p1_1(5)%p(7)%x)
|
||||
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test passing pointer component references as pointers
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPpass_real_p
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine pass_real_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
|
||||
call takes_real_scalar_pointer(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.call @_QPtakes_real_scalar_pointer(%[[coor]])
|
||||
call takes_real_scalar_pointer(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
|
||||
call takes_real_array_pointer(p1_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.call @_QPtakes_real_array_pointer(%[[coor]])
|
||||
call takes_real_array_pointer(p1_1(5)%p)
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test usage in intrinsics where pointer aspect matters
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPassociated_p
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine associated_p(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(def_char_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: fir.box_addr %[[box]]
|
||||
call takes_logical(associated(p0_0%p))
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: fir.box_addr %[[box]]
|
||||
call takes_logical(associated(p0_1(5)%p))
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: fir.box_addr %[[box]]
|
||||
call takes_logical(associated(p1_0%p))
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: %[[box:.*]] = fir.load %[[coor]]
|
||||
! CHECK: fir.box_addr %[[box]]
|
||||
call takes_logical(associated(p1_1(5)%p))
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test pointer assignment of components
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPpassoc_real
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine passoc_real(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p0_0%p => real_target
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p0_1(5)%p => real_target
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p1_0%p => real_array_target
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p1_1(5)%p => real_array_target
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPpassoc_char
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine passoc_char(p0_0, p1_0, p0_1, p1_1)
|
||||
type(cst_char_p0) :: p0_0, p0_1(100)
|
||||
type(def_char_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p0_0%p => char_target
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p0_1(5)%p => char_target
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p1_0%p => char_array_target
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
p1_1(5)%p => char_array_target
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test nullify of components
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPnullify_test
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine nullify_test(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(def_char_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
nullify(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
nullify(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
nullify(p1_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
nullify(p1_1(5)%p)
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test allocation
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPallocate_real
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine allocate_real(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p1_0%p(100))
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p1_1(5)%p(100))
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPallocate_cst_char
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine allocate_cst_char(p0_0, p1_0, p0_1, p1_1)
|
||||
type(cst_char_p0) :: p0_0, p0_1(100)
|
||||
type(cst_char_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p1_0%p(100))
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(p1_1(5)%p(100))
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPallocate_def_char
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine allocate_def_char(p0_0, p1_0, p0_1, p1_1)
|
||||
type(def_char_p0) :: p0_0, p0_1(100)
|
||||
type(def_char_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(character(18)::p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(character(18)::p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(character(18)::p1_0%p(100))
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
allocate(character(18)::p1_1(5)%p(100))
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test deallocation
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPdeallocate_real
|
||||
! CHECK-SAME: (%[[p0_0:.*]]: {{.*}}, %[[p1_0:.*]]: {{.*}}, %[[p0_1:.*]]: {{.*}}, %[[p1_1:.*]]: {{.*}})
|
||||
subroutine deallocate_real(p0_0, p1_0, p0_1, p1_1)
|
||||
type(real_p0) :: p0_0, p0_1(100)
|
||||
type(real_p1) :: p1_0, p1_1(100)
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p0_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
deallocate(p0_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p0_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
deallocate(p0_1(5)%p)
|
||||
|
||||
! CHECK: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[p1_0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
deallocate(p1_0%p)
|
||||
|
||||
! CHECK-DAG: %[[coor0:.*]] = fir.coordinate_of %[[p1_1]], %{{.*}}
|
||||
! CHECK-DAG: %[[fld:.*]] = fir.field_index p
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[coor0]], %[[fld]]
|
||||
! CHECK: fir.store {{.*}} to %[[coor]]
|
||||
deallocate(p1_1(5)%p)
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test a very long component
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMpcompPvery_long
|
||||
! CHECK-SAME: (%[[x:.*]]: {{.*}})
|
||||
subroutine very_long(x)
|
||||
type t0
|
||||
real :: f
|
||||
end type
|
||||
type t1
|
||||
type(t0), allocatable :: e(:)
|
||||
end type
|
||||
type t2
|
||||
type(t1) :: d(10)
|
||||
end type
|
||||
type t3
|
||||
type(t2) :: c
|
||||
end type
|
||||
type t4
|
||||
type(t3), pointer :: b
|
||||
end type
|
||||
type t5
|
||||
type(t4) :: a
|
||||
end type
|
||||
type(t5) :: x(:, :, :, :, :)
|
||||
|
||||
! CHECK: %[[coor0:.*]] = fir.coordinate_of %[[x]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}, %{{.}}
|
||||
! CHECK-DAG: %[[flda:.*]] = fir.field_index a
|
||||
! CHECK-DAG: %[[fldb:.*]] = fir.field_index b
|
||||
! CHECK: %[[coor1:.*]] = fir.coordinate_of %[[coor0]], %[[flda]], %[[fldb]]
|
||||
! CHECK: %[[b_box:.*]] = fir.load %[[coor1]]
|
||||
! CHECK-DAG: %[[fldc:.*]] = fir.field_index c
|
||||
! CHECK-DAG: %[[fldd:.*]] = fir.field_index d
|
||||
! CHECK: %[[coor2:.*]] = fir.coordinate_of %[[b_box]], %[[fldc]], %[[fldd]]
|
||||
! CHECK: %[[index:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
|
||||
! CHECK: %[[coor3:.*]] = fir.coordinate_of %[[coor2]], %[[index]]
|
||||
! CHECK: %[[flde:.*]] = fir.field_index e
|
||||
! CHECK: %[[coor4:.*]] = fir.coordinate_of %[[coor3]], %[[flde]]
|
||||
! CHECK: %[[e_box:.*]] = fir.load %[[coor4]]
|
||||
! CHECK: %[[edims:.*]]:3 = fir.box_dims %[[e_box]], %c0{{.*}}
|
||||
! CHECK: %[[lb:.*]] = fir.convert %[[edims]]#0 : (index) -> i64
|
||||
! CHECK: %[[index2:.*]] = arith.subi %c7{{.*}}, %[[lb]]
|
||||
! CHECK: %[[coor5:.*]] = fir.coordinate_of %[[e_box]], %[[index2]]
|
||||
! CHECK: %[[fldf:.*]] = fir.field_index f
|
||||
! CHECK: %[[coor6:.*]] = fir.coordinate_of %[[coor5]], %[[fldf:.*]]
|
||||
! CHECK: fir.load %[[coor6]] : !fir.ref<f32>
|
||||
print *, x(1,2,3,4,5)%a%b%c%d(6)%e(7)%f
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test a recursive derived type reference
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK: func @_QMpcompPtest_recursive
|
||||
! CHECK-SAME: (%[[x:.*]]: {{.*}})
|
||||
subroutine test_recursive(x)
|
||||
type t
|
||||
integer :: i
|
||||
type(t), pointer :: next
|
||||
end type
|
||||
type(t) :: x
|
||||
|
||||
! CHECK: %[[fldNext1:.*]] = fir.field_index next
|
||||
! CHECK: %[[next1:.*]] = fir.coordinate_of %[[x]], %[[fldNext1]]
|
||||
! CHECK: %[[nextBox1:.*]] = fir.load %[[next1]]
|
||||
! CHECK: %[[fldNext2:.*]] = fir.field_index next
|
||||
! CHECK: %[[next2:.*]] = fir.coordinate_of %[[nextBox1]], %[[fldNext2]]
|
||||
! CHECK: %[[nextBox2:.*]] = fir.load %[[next2]]
|
||||
! CHECK: %[[fldNext3:.*]] = fir.field_index next
|
||||
! CHECK: %[[next3:.*]] = fir.coordinate_of %[[nextBox2]], %[[fldNext3]]
|
||||
! CHECK: %[[nextBox3:.*]] = fir.load %[[next3]]
|
||||
! CHECK: %[[fldi:.*]] = fir.field_index i
|
||||
! CHECK: %[[i:.*]] = fir.coordinate_of %[[nextBox3]], %[[fldi]]
|
||||
! CHECK: %[[nextBox3:.*]] = fir.load %[[i]] : !fir.ref<i32>
|
||||
print *, x%next%next%next%i
|
||||
end subroutine
|
||||
|
||||
end module
|
56
flang/test/Lower/derived-types-kind-params.f90
Normal file
56
flang/test/Lower/derived-types-kind-params.f90
Normal file
|
@ -0,0 +1,56 @@
|
|||
! Test lowering of derived type with kind parameters
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
module m
|
||||
type t(k1, k2)
|
||||
integer(4), kind :: k1 = 7
|
||||
integer(8), kind :: k2
|
||||
character(k1) :: c(k2)
|
||||
end type
|
||||
|
||||
type t2(k1, k2)
|
||||
integer(4), kind :: k1
|
||||
integer(8), kind :: k2
|
||||
type(t(k1+3, k2+4)) :: at
|
||||
end type
|
||||
|
||||
type t3(k)
|
||||
integer, kind :: k
|
||||
type(t3(k)), pointer :: at3
|
||||
end type
|
||||
|
||||
type t4(k)
|
||||
integer, kind :: k
|
||||
real(-k) :: i
|
||||
end type
|
||||
|
||||
contains
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test mangling of derived type with kind parameters
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QMmPfoo
|
||||
! CHECK-SAME: !fir.ref<!fir.type<_QMmTtK7K12{c:!fir.array<12x!fir.char<1,?>>
|
||||
subroutine foo(at)
|
||||
type(t(k2=12)) :: at
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMmPfoo2
|
||||
! CHECK-SAME: !fir.ref<!fir.type<_QMmTt2K12K13{at:!fir.type<_QMmTtK15K17{c:!fir.array<17x!fir.char<1,?>>}>}>>
|
||||
subroutine foo2(at2)
|
||||
type(t2(12, 13)) :: at2
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMmPfoo3
|
||||
! CHECK-SAME: !fir.ref<!fir.type<_QMmTt3K7{at3:!fir.box<!fir.ptr<!fir.type<_QMmTt3K7>>>}>>
|
||||
subroutine foo3(at3)
|
||||
type(t3(7)) :: at3
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QMmPfoo4
|
||||
! CHECK-SAME: !fir.ref<!fir.type<_QMmTt4KN4{i:f32}>>
|
||||
subroutine foo4(at4)
|
||||
type(t4(-4)) :: at4
|
||||
end subroutine
|
||||
end module
|
Loading…
Reference in a new issue