forked from OSchip/llvm-project
[flang] Lower more pointer assignments/disassociation cases
This patch lowers more cases of pointer assignments and disassociations. This patch is part of the upstreaming effort from fir-dev branch. Reviewed By: PeteSteinfeld, schweitz Differential Revision: https://reviews.llvm.org/D121697 Co-authored-by: V Donaldson <vdonaldson@nvidia.com> Co-authored-by: Jean Perier <jperier@nvidia.com> Co-authored-by: mleair <leairmark@gmail.com> Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
This commit is contained in:
Valentin Clement
parent
a2db7d5e9c
commit
a1425019e7
|
|
@ -79,6 +79,13 @@ public:
|
|||
/// Get the binding of an implied do variable by name.
|
||||
virtual mlir::Value impliedDoBinding(llvm::StringRef name) = 0;
|
||||
|
||||
/// Copy the binding of src to target symbol.
|
||||
virtual void copySymbolBinding(SymbolRef src, SymbolRef target) = 0;
|
||||
|
||||
/// Binds the symbol to an fir extended value. The symbol binding will be
|
||||
/// added or replaced at the inner-most level of the local symbol map.
|
||||
virtual void bindSymbol(SymbolRef sym, const fir::ExtendedValue &exval) = 0;
|
||||
|
||||
/// Get the label set associated with a symbol.
|
||||
virtual bool lookupLabelSet(SymbolRef sym, pft::LabelSet &labelSet) = 0;
|
||||
|
||||
|
|
|
|||
|
|
@ -85,5 +85,11 @@ fir::ExtendedValue
|
|||
genExtAddrInInitializer(Fortran::lower::AbstractConverter &converter,
|
||||
mlir::Location loc, const SomeExpr &addr);
|
||||
|
||||
/// Create global variable from a compiler generated object symbol that
|
||||
/// describes a derived type for the runtime.
|
||||
void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
|
||||
mlir::Location loc,
|
||||
const Fortran::semantics::Symbol &typeInfoSym);
|
||||
|
||||
} // namespace Fortran::lower
|
||||
#endif // FORTRAN_LOWER_CONVERT_VARIABLE_H
|
||||
|
|
|
|||
|
|
@ -295,6 +295,13 @@ public:
|
|||
return lookupSymbol(*sym);
|
||||
}
|
||||
|
||||
/// Find `symbol` and return its value if it appears in the inner-most level
|
||||
/// map.
|
||||
SymbolBox shallowLookupSymbol(semantics::SymbolRef sym);
|
||||
SymbolBox shallowLookupSymbol(const semantics::Symbol *sym) {
|
||||
return shallowLookupSymbol(*sym);
|
||||
}
|
||||
|
||||
/// Add a new binding from the ac-do-variable `var` to `value`.
|
||||
void pushImpliedDoBinding(AcDoVar var, mlir::Value value) {
|
||||
impliedDoStack.emplace_back(var, value);
|
||||
|
|
@ -326,12 +333,13 @@ public:
|
|||
|
||||
private:
|
||||
/// Add `symbol` to the current map and bind a `box`.
|
||||
void makeSym(semantics::SymbolRef sym, const SymbolBox &box,
|
||||
void makeSym(semantics::SymbolRef symRef, const SymbolBox &box,
|
||||
bool force = false) {
|
||||
const auto *sym = &symRef.get().GetUltimate();
|
||||
if (force)
|
||||
symbolMapStack.back().erase(&*sym);
|
||||
symbolMapStack.back().erase(sym);
|
||||
assert(box && "cannot add an undefined symbol box");
|
||||
symbolMapStack.back().try_emplace(&*sym, box);
|
||||
symbolMapStack.back().try_emplace(sym, box);
|
||||
}
|
||||
|
||||
llvm::SmallVector<llvm::DenseMap<const semantics::Symbol *, SymbolBox>>
|
||||
|
|
|
|||
|
|
@ -64,32 +64,30 @@ public:
|
|||
|
||||
/// Convert the PFT to FIR.
|
||||
void run(Fortran::lower::pft::Program &pft) {
|
||||
// Primary translation pass.
|
||||
// Preliminary translation pass.
|
||||
// - Declare all functions that have definitions so that definition
|
||||
// signatures prevail over call site signatures.
|
||||
// - Define module variables and OpenMP/OpenACC declarative construct so
|
||||
// that they are available before lowering any function that may use
|
||||
// them.
|
||||
// - Translate block data programs so that common block definitions with
|
||||
// data initializations take precedence over other definitions.
|
||||
for (Fortran::lower::pft::Program::Units &u : pft.getUnits()) {
|
||||
std::visit(Fortran::common::visitors{
|
||||
[&](Fortran::lower::pft::FunctionLikeUnit &f) {
|
||||
declareFunction(f);
|
||||
},
|
||||
[&](Fortran::lower::pft::ModuleLikeUnit &m) {
|
||||
lowerModuleDeclScope(m);
|
||||
for (Fortran::lower::pft::FunctionLikeUnit &f :
|
||||
m.nestedFunctions)
|
||||
declareFunction(f);
|
||||
},
|
||||
[&](Fortran::lower::pft::BlockDataUnit &b) {},
|
||||
[&](Fortran::lower::pft::CompilerDirectiveUnit &d) {
|
||||
setCurrentPosition(
|
||||
d.get<Fortran::parser::CompilerDirective>().source);
|
||||
mlir::emitWarning(toLocation(),
|
||||
"ignoring all compiler directives");
|
||||
},
|
||||
},
|
||||
u);
|
||||
std::visit(
|
||||
Fortran::common::visitors{
|
||||
[&](Fortran::lower::pft::FunctionLikeUnit &f) {
|
||||
declareFunction(f);
|
||||
},
|
||||
[&](Fortran::lower::pft::ModuleLikeUnit &m) {
|
||||
lowerModuleDeclScope(m);
|
||||
for (Fortran::lower::pft::FunctionLikeUnit &f :
|
||||
m.nestedFunctions)
|
||||
declareFunction(f);
|
||||
},
|
||||
[&](Fortran::lower::pft::BlockDataUnit &b) { lowerBlockData(b); },
|
||||
[&](Fortran::lower::pft::CompilerDirectiveUnit &d) {},
|
||||
},
|
||||
u);
|
||||
}
|
||||
|
||||
// Primary translation pass.
|
||||
|
|
@ -189,6 +187,26 @@ public:
|
|||
return val;
|
||||
}
|
||||
|
||||
void copySymbolBinding(Fortran::lower::SymbolRef src,
|
||||
Fortran::lower::SymbolRef target) override final {
|
||||
localSymbols.addSymbol(target, lookupSymbol(src).toExtendedValue());
|
||||
}
|
||||
|
||||
/// Add the symbol binding to the inner-most level of the symbol map and
|
||||
/// return true if it is not already present. Otherwise, return false.
|
||||
bool bindIfNewSymbol(Fortran::lower::SymbolRef sym,
|
||||
const fir::ExtendedValue &exval) {
|
||||
if (shallowLookupSymbol(sym))
|
||||
return false;
|
||||
bindSymbol(sym, exval);
|
||||
return true;
|
||||
}
|
||||
|
||||
void bindSymbol(Fortran::lower::SymbolRef sym,
|
||||
const fir::ExtendedValue &exval) override final {
|
||||
localSymbols.addSymbol(sym, exval, /*forced=*/true);
|
||||
}
|
||||
|
||||
bool lookupLabelSet(Fortran::lower::SymbolRef sym,
|
||||
Fortran::lower::pft::LabelSet &labelSet) override final {
|
||||
Fortran::lower::pft::FunctionLikeUnit &owningProc =
|
||||
|
|
@ -381,6 +399,42 @@ public:
|
|||
localSymbols.clear();
|
||||
}
|
||||
|
||||
/// Helper to generate GlobalOps when the builder is not positioned in any
|
||||
/// region block. This is required because the FirOpBuilder assumes it is
|
||||
/// always positioned inside a region block when creating globals, the easiest
|
||||
/// way comply is to create a dummy function and to throw it afterwards.
|
||||
void createGlobalOutsideOfFunctionLowering(
|
||||
const std::function<void()> &createGlobals) {
|
||||
// FIXME: get rid of the bogus function context and instantiate the
|
||||
// globals directly into the module.
|
||||
MLIRContext *context = &getMLIRContext();
|
||||
mlir::FuncOp func = fir::FirOpBuilder::createFunction(
|
||||
mlir::UnknownLoc::get(context), getModuleOp(),
|
||||
fir::NameUniquer::doGenerated("Sham"),
|
||||
mlir::FunctionType::get(context, llvm::None, llvm::None));
|
||||
func.addEntryBlock();
|
||||
builder = new fir::FirOpBuilder(func, bridge.getKindMap());
|
||||
createGlobals();
|
||||
if (mlir::Region *region = func.getCallableRegion())
|
||||
region->dropAllReferences();
|
||||
func.erase();
|
||||
delete builder;
|
||||
builder = nullptr;
|
||||
localSymbols.clear();
|
||||
}
|
||||
/// Instantiate the data from a BLOCK DATA unit.
|
||||
void lowerBlockData(Fortran::lower::pft::BlockDataUnit &bdunit) {
|
||||
createGlobalOutsideOfFunctionLowering([&]() {
|
||||
Fortran::lower::AggregateStoreMap fakeMap;
|
||||
for (const auto &[_, sym] : bdunit.symTab) {
|
||||
if (sym->has<Fortran::semantics::ObjectEntityDetails>()) {
|
||||
Fortran::lower::pft::Variable var(*sym, true);
|
||||
instantiateVar(var, fakeMap);
|
||||
}
|
||||
}
|
||||
});
|
||||
}
|
||||
|
||||
/// Map mlir function block arguments to the corresponding Fortran dummy
|
||||
/// variables. When the result is passed as a hidden argument, the Fortran
|
||||
/// result is also mapped. The symbol map is used to hold this mapping.
|
||||
|
|
@ -611,30 +665,18 @@ public:
|
|||
/// Lower module variable definitions to fir::globalOp and OpenMP/OpenACC
|
||||
/// declarative construct.
|
||||
void lowerModuleDeclScope(Fortran::lower::pft::ModuleLikeUnit &mod) {
|
||||
// FIXME: get rid of the bogus function context and instantiate the
|
||||
// globals directly into the module.
|
||||
MLIRContext *context = &getMLIRContext();
|
||||
setCurrentPosition(mod.getStartingSourceLoc());
|
||||
mlir::FuncOp func = fir::FirOpBuilder::createFunction(
|
||||
mlir::UnknownLoc::get(context), getModuleOp(),
|
||||
fir::NameUniquer::doGenerated("ModuleSham"),
|
||||
mlir::FunctionType::get(context, llvm::None, llvm::None));
|
||||
func.addEntryBlock();
|
||||
builder = new fir::FirOpBuilder(func, bridge.getKindMap());
|
||||
for (const Fortran::lower::pft::Variable &var :
|
||||
mod.getOrderedSymbolTable()) {
|
||||
// Only define the variables owned by this module.
|
||||
const Fortran::semantics::Scope *owningScope = var.getOwningScope();
|
||||
if (!owningScope || mod.getScope() == *owningScope)
|
||||
Fortran::lower::defineModuleVariable(*this, var);
|
||||
}
|
||||
for (auto &eval : mod.evaluationList)
|
||||
genFIR(eval);
|
||||
if (mlir::Region *region = func.getCallableRegion())
|
||||
region->dropAllReferences();
|
||||
func.erase();
|
||||
delete builder;
|
||||
builder = nullptr;
|
||||
createGlobalOutsideOfFunctionLowering([&]() {
|
||||
for (const Fortran::lower::pft::Variable &var :
|
||||
mod.getOrderedSymbolTable()) {
|
||||
// Only define the variables owned by this module.
|
||||
const Fortran::semantics::Scope *owningScope = var.getOwningScope();
|
||||
if (!owningScope || mod.getScope() == *owningScope)
|
||||
Fortran::lower::defineModuleVariable(*this, var);
|
||||
}
|
||||
for (auto &eval : mod.evaluationList)
|
||||
genFIR(eval);
|
||||
});
|
||||
}
|
||||
|
||||
/// Lower functions contained in a module.
|
||||
|
|
@ -674,6 +716,14 @@ private:
|
|||
return {};
|
||||
}
|
||||
|
||||
/// Find the symbol in the inner-most level of the local map or return null.
|
||||
Fortran::lower::SymbolBox
|
||||
shallowLookupSymbol(const Fortran::semantics::Symbol &sym) {
|
||||
if (Fortran::lower::SymbolBox v = localSymbols.shallowLookupSymbol(sym))
|
||||
return v;
|
||||
return {};
|
||||
}
|
||||
|
||||
/// Add the symbol to the local map and return `true`. If the symbol is
|
||||
/// already in the map and \p forced is `false`, the map is not updated.
|
||||
/// Instead the value `false` is returned.
|
||||
|
|
|
|||
|
|
@ -58,6 +58,11 @@
|
|||
// to the correct FIR representation in SSA form.
|
||||
//===----------------------------------------------------------------------===//
|
||||
|
||||
static llvm::cl::opt<bool> generateArrayCoordinate(
|
||||
"gen-array-coor",
|
||||
llvm::cl::desc("in lowering create ArrayCoorOp instead of CoordinateOp"),
|
||||
llvm::cl::init(false));
|
||||
|
||||
// The default attempts to balance a modest allocation size with expected user
|
||||
// input to minimize bounds checks and reallocations during dynamic array
|
||||
// construction. Some user codes may have very large array constructors for
|
||||
|
|
@ -300,6 +305,12 @@ createInMemoryScalarCopy(fir::FirOpBuilder &builder, mlir::Location loc,
|
|||
return temp;
|
||||
}
|
||||
|
||||
// An expression with non-zero rank is an array expression.
|
||||
template <typename A>
|
||||
static bool isArray(const A &x) {
|
||||
return x.Rank() != 0;
|
||||
}
|
||||
|
||||
/// Is this a variable wrapped in parentheses?
|
||||
template <typename A>
|
||||
static bool isParenthesizedVariable(const A &) {
|
||||
|
|
@ -482,6 +493,21 @@ createBoxProcCharTuple(Fortran::lower::AbstractConverter &converter,
|
|||
boxProc, charLen);
|
||||
}
|
||||
|
||||
// Helper to get the ultimate first symbol. This works around the fact that
|
||||
// symbol resolution in the front end doesn't always resolve a symbol to its
|
||||
// ultimate symbol but may leave placeholder indirections for use and host
|
||||
// associations.
|
||||
template <typename A>
|
||||
const Fortran::semantics::Symbol &getFirstSym(const A &obj) {
|
||||
return obj.GetFirstSymbol().GetUltimate();
|
||||
}
|
||||
|
||||
// Helper to get the ultimate last symbol.
|
||||
template <typename A>
|
||||
const Fortran::semantics::Symbol &getLastSym(const A &obj) {
|
||||
return obj.GetLastSymbol().GetUltimate();
|
||||
}
|
||||
|
||||
namespace {
|
||||
|
||||
/// Lowering of Fortran::evaluate::Expr<T> expressions
|
||||
|
|
@ -643,7 +669,6 @@ public:
|
|||
[&val](auto &) { return val.toExtendedValue(); });
|
||||
LLVM_DEBUG(llvm::dbgs()
|
||||
<< "unknown symbol: " << sym << "\nmap: " << symMap << '\n');
|
||||
llvm::errs() << "SYM: " << sym << "\n";
|
||||
fir::emitFatalError(getLoc(), "symbol is not mapped to any IR value");
|
||||
}
|
||||
|
||||
|
|
@ -652,10 +677,23 @@ public:
|
|||
}
|
||||
|
||||
ExtValue genval(Fortran::semantics::SymbolRef sym) {
|
||||
mlir::Location loc = getLoc();
|
||||
ExtValue var = gen(sym);
|
||||
if (const fir::UnboxedValue *s = var.getUnboxed())
|
||||
if (fir::isReferenceLike(s->getType()))
|
||||
return genLoad(*s);
|
||||
if (fir::isReferenceLike(s->getType())) {
|
||||
// A function with multiple entry points returning different types
|
||||
// tags all result variables with one of the largest types to allow
|
||||
// them to share the same storage. A reference to a result variable
|
||||
// of one of the other types requires conversion to the actual type.
|
||||
fir::UnboxedValue addr = *s;
|
||||
if (Fortran::semantics::IsFunctionResult(sym)) {
|
||||
mlir::Type resultType = converter.genType(*sym);
|
||||
if (addr.getType() != resultType)
|
||||
addr = builder.createConvert(loc, builder.getRefType(resultType),
|
||||
addr);
|
||||
}
|
||||
return genLoad(addr);
|
||||
}
|
||||
return var;
|
||||
}
|
||||
|
||||
|
|
@ -851,7 +889,7 @@ public:
|
|||
}
|
||||
|
||||
ExtValue genval(const Fortran::evaluate::DescriptorInquiry &desc) {
|
||||
ExtValue exv = desc.base().IsSymbol() ? gen(desc.base().GetLastSymbol())
|
||||
ExtValue exv = desc.base().IsSymbol() ? gen(getLastSym(desc.base()))
|
||||
: gen(desc.base().GetComponent());
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
mlir::Location loc = getLoc();
|
||||
|
|
@ -990,6 +1028,30 @@ public:
|
|||
TODO(getLoc(), "genval Extremum<TC, KIND>");
|
||||
}
|
||||
|
||||
// Change the dynamic length information without actually changing the
|
||||
// underlying character storage.
|
||||
fir::ExtendedValue
|
||||
replaceScalarCharacterLength(const fir::ExtendedValue &scalarChar,
|
||||
mlir::Value newLenValue) {
|
||||
mlir::Location loc = getLoc();
|
||||
const fir::CharBoxValue *charBox = scalarChar.getCharBox();
|
||||
if (!charBox)
|
||||
fir::emitFatalError(loc, "expected scalar character");
|
||||
mlir::Value charAddr = charBox->getAddr();
|
||||
auto charType =
|
||||
fir::unwrapPassByRefType(charAddr.getType()).cast<fir::CharacterType>();
|
||||
if (charType.hasConstantLen()) {
|
||||
// Erase previous constant length from the base type.
|
||||
fir::CharacterType::LenType newLen = fir::CharacterType::unknownLen();
|
||||
mlir::Type newCharTy = fir::CharacterType::get(
|
||||
builder.getContext(), charType.getFKind(), newLen);
|
||||
mlir::Type newType = fir::ReferenceType::get(newCharTy);
|
||||
charAddr = builder.createConvert(loc, newType, charAddr);
|
||||
return fir::CharBoxValue{charAddr, newLenValue};
|
||||
}
|
||||
return fir::CharBoxValue{charAddr, newLenValue};
|
||||
}
|
||||
|
||||
template <int KIND>
|
||||
ExtValue genval(const Fortran::evaluate::SetLength<KIND> &x) {
|
||||
TODO(getLoc(), "genval SetLength<KIND>");
|
||||
|
|
@ -1151,23 +1213,7 @@ public:
|
|||
inInitializer->rawVals.push_back(val);
|
||||
}
|
||||
|
||||
/// Convert a ascii scalar literal CHARACTER to IR. (specialization)
|
||||
ExtValue
|
||||
genAsciiScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
|
||||
Fortran::common::TypeCategory::Character, 1>> &value,
|
||||
int64_t len) {
|
||||
assert(value.size() == static_cast<std::uint64_t>(len));
|
||||
// Outline character constant in ro data if it is not in an initializer.
|
||||
if (!inInitializer)
|
||||
return fir::factory::createStringLiteral(builder, getLoc(), value);
|
||||
// When in an initializer context, construct the literal op itself and do
|
||||
// not construct another constant object in rodata.
|
||||
fir::StringLitOp stringLit = builder.createStringLitOp(getLoc(), value);
|
||||
mlir::Value lenp = builder.createIntegerConstant(
|
||||
getLoc(), builder.getCharacterLengthType(), len);
|
||||
return fir::CharBoxValue{stringLit.getResult(), lenp};
|
||||
}
|
||||
/// Convert a non ascii scalar literal CHARACTER to IR. (specialization)
|
||||
/// Convert a scalar literal CHARACTER to IR.
|
||||
template <int KIND>
|
||||
ExtValue
|
||||
genScalarLit(const Fortran::evaluate::Scalar<Fortran::evaluate::Type<
|
||||
|
|
@ -1175,20 +1221,29 @@ public:
|
|||
int64_t len) {
|
||||
using ET = typename std::decay_t<decltype(value)>::value_type;
|
||||
if constexpr (KIND == 1) {
|
||||
return genAsciiScalarLit(value, len);
|
||||
assert(value.size() == static_cast<std::uint64_t>(len));
|
||||
// Outline character constant in ro data if it is not in an initializer.
|
||||
if (!inInitializer)
|
||||
return fir::factory::createStringLiteral(builder, getLoc(), value);
|
||||
// When in an initializer context, construct the literal op itself and do
|
||||
// not construct another constant object in rodata.
|
||||
fir::StringLitOp stringLit = builder.createStringLitOp(getLoc(), value);
|
||||
mlir::Value lenp = builder.createIntegerConstant(
|
||||
getLoc(), builder.getCharacterLengthType(), len);
|
||||
return fir::CharBoxValue{stringLit.getResult(), lenp};
|
||||
}
|
||||
fir::CharacterType type =
|
||||
fir::CharacterType::get(builder.getContext(), KIND, len);
|
||||
auto consLit = [&]() -> fir::StringLitOp {
|
||||
mlir::MLIRContext *context = builder.getContext();
|
||||
std::int64_t size = static_cast<std::int64_t>(value.size());
|
||||
mlir::ShapedType shape = mlir::VectorType::get(
|
||||
mlir::ShapedType shape = mlir::RankedTensorType::get(
|
||||
llvm::ArrayRef<std::int64_t>{size},
|
||||
mlir::IntegerType::get(builder.getContext(), sizeof(ET) * 8));
|
||||
auto strAttr = mlir::DenseElementsAttr::get(
|
||||
auto denseAttr = mlir::DenseElementsAttr::get(
|
||||
shape, llvm::ArrayRef<ET>{value.data(), value.size()});
|
||||
auto valTag = mlir::StringAttr::get(context, fir::StringLitOp::value());
|
||||
mlir::NamedAttribute dataAttr(valTag, strAttr);
|
||||
auto denseTag = mlir::StringAttr::get(context, fir::StringLitOp::xlist());
|
||||
mlir::NamedAttribute dataAttr(denseTag, denseAttr);
|
||||
auto sizeTag = mlir::StringAttr::get(context, fir::StringLitOp::size());
|
||||
mlir::NamedAttribute sizeAttr(sizeTag, builder.getI64IntegerAttr(len));
|
||||
llvm::SmallVector<mlir::NamedAttribute> attrs = {dataAttr, sizeAttr};
|
||||
|
|
@ -1206,9 +1261,6 @@ public:
|
|||
// Otherwise, the string is in a plain old expression so "outline" the value
|
||||
// by hashconsing it to a constant literal object.
|
||||
|
||||
// FIXME: For wider char types, lowering ought to use an array of i16 or
|
||||
// i32. But for now, lowering just fakes that the string value is a range of
|
||||
// i8 to get it past the C++ compiler.
|
||||
std::string globalName =
|
||||
fir::factory::uniqueCGIdent("cl", (const char *)value.c_str());
|
||||
fir::GlobalOp global = builder.getNamedGlobal(globalName);
|
||||
|
|
@ -1390,11 +1442,52 @@ public:
|
|||
TODO(getLoc(), "genval ComplexPart");
|
||||
}
|
||||
|
||||
/// Reference to a substring.
|
||||
ExtValue gen(const Fortran::evaluate::Substring &s) {
|
||||
TODO(getLoc(), "gen Substring");
|
||||
// Get base string
|
||||
auto baseString = std::visit(
|
||||
Fortran::common::visitors{
|
||||
[&](const Fortran::evaluate::DataRef &x) { return gen(x); },
|
||||
[&](const Fortran::evaluate::StaticDataObject::Pointer &p)
|
||||
-> ExtValue {
|
||||
if (std::optional<std::string> str = p->AsString())
|
||||
return fir::factory::createStringLiteral(builder, getLoc(),
|
||||
*str);
|
||||
// TODO: convert StaticDataObject to Constant<T> and use normal
|
||||
// constant path. Beware that StaticDataObject data() takes into
|
||||
// account build machine endianness.
|
||||
TODO(getLoc(),
|
||||
"StaticDataObject::Pointer substring with kind > 1");
|
||||
},
|
||||
},
|
||||
s.parent());
|
||||
llvm::SmallVector<mlir::Value> bounds;
|
||||
mlir::Value lower = genunbox(s.lower());
|
||||
bounds.push_back(lower);
|
||||
if (Fortran::evaluate::MaybeExtentExpr upperBound = s.upper()) {
|
||||
mlir::Value upper = genunbox(*upperBound);
|
||||
bounds.push_back(upper);
|
||||
}
|
||||
fir::factory::CharacterExprHelper charHelper{builder, getLoc()};
|
||||
return baseString.match(
|
||||
[&](const fir::CharBoxValue &x) -> ExtValue {
|
||||
return charHelper.createSubstring(x, bounds);
|
||||
},
|
||||
[&](const fir::CharArrayBoxValue &) -> ExtValue {
|
||||
fir::emitFatalError(
|
||||
getLoc(),
|
||||
"array substring should be handled in array expression");
|
||||
},
|
||||
[&](const auto &) -> ExtValue {
|
||||
fir::emitFatalError(getLoc(), "substring base is not a CharBox");
|
||||
});
|
||||
}
|
||||
|
||||
/// The value of a substring.
|
||||
ExtValue genval(const Fortran::evaluate::Substring &ss) {
|
||||
TODO(getLoc(), "genval Substring");
|
||||
// FIXME: why is the value of a substring being lowered the same as the
|
||||
// address of a substring?
|
||||
return gen(ss);
|
||||
}
|
||||
|
||||
ExtValue genval(const Fortran::evaluate::Subscript &subs) {
|
||||
|
|
@ -1628,11 +1721,43 @@ public:
|
|||
});
|
||||
}
|
||||
|
||||
/// Lower an ArrayRef to a fir.array_coor.
|
||||
ExtValue genArrayCoorOp(const ExtValue &exv,
|
||||
const Fortran::evaluate::ArrayRef &aref) {
|
||||
mlir::Location loc = getLoc();
|
||||
mlir::Value addr = fir::getBase(exv);
|
||||
mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(addr.getType());
|
||||
mlir::Type eleTy = arrTy.cast<fir::SequenceType>().getEleTy();
|
||||
mlir::Type refTy = builder.getRefType(eleTy);
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
llvm::SmallVector<mlir::Value> arrayCoorArgs;
|
||||
// The ArrayRef is expected to be scalar here, arrays are handled in array
|
||||
// expression lowering. So no vector subscript or triplet is expected here.
|
||||
for (const auto &sub : aref.subscript()) {
|
||||
ExtValue subVal = genSubscript(sub);
|
||||
assert(fir::isUnboxedValue(subVal));
|
||||
arrayCoorArgs.push_back(
|
||||
builder.createConvert(loc, idxTy, fir::getBase(subVal)));
|
||||
}
|
||||
mlir::Value shape = builder.createShape(loc, exv);
|
||||
mlir::Value elementAddr = builder.create<fir::ArrayCoorOp>(
|
||||
loc, refTy, addr, shape, /*slice=*/mlir::Value{}, arrayCoorArgs,
|
||||
fir::getTypeParams(exv));
|
||||
return fir::factory::arrayElementToExtendedValue(builder, loc, exv,
|
||||
elementAddr);
|
||||
}
|
||||
|
||||
/// Return the coordinate of the array reference.
|
||||
ExtValue gen(const Fortran::evaluate::ArrayRef &aref) {
|
||||
ExtValue base = aref.base().IsSymbol() ? gen(aref.base().GetFirstSymbol())
|
||||
ExtValue base = aref.base().IsSymbol() ? gen(getFirstSym(aref.base()))
|
||||
: gen(aref.base().GetComponent());
|
||||
// Check for command-line override to use array_coor op.
|
||||
if (generateArrayCoordinate)
|
||||
return genArrayCoorOp(base, aref);
|
||||
// Otherwise, use coordinate_of op.
|
||||
return genCoordinateOp(base, aref);
|
||||
}
|
||||
|
||||
ExtValue genval(const Fortran::evaluate::ArrayRef &aref) {
|
||||
return genLoad(gen(aref));
|
||||
}
|
||||
|
|
@ -1690,6 +1815,59 @@ public:
|
|||
return details->stmtFunction().has_value();
|
||||
return false;
|
||||
}
|
||||
/// Generate Statement function calls
|
||||
ExtValue genStmtFunctionRef(const Fortran::evaluate::ProcedureRef &procRef) {
|
||||
const Fortran::semantics::Symbol *symbol = procRef.proc().GetSymbol();
|
||||
assert(symbol && "expected symbol in ProcedureRef of statement functions");
|
||||
const auto &details = symbol->get<Fortran::semantics::SubprogramDetails>();
|
||||
|
||||
// Statement functions have their own scope, we just need to associate
|
||||
// the dummy symbols to argument expressions. They are no
|
||||
// optional/alternate return arguments. Statement functions cannot be
|
||||
// recursive (directly or indirectly) so it is safe to add dummy symbols to
|
||||
// the local map here.
|
||||
symMap.pushScope();
|
||||
for (auto [arg, bind] :
|
||||
llvm::zip(details.dummyArgs(), procRef.arguments())) {
|
||||
assert(arg && "alternate return in statement function");
|
||||
assert(bind && "optional argument in statement function");
|
||||
const auto *expr = bind->UnwrapExpr();
|
||||
// TODO: assumed type in statement function, that surprisingly seems
|
||||
// allowed, probably because nobody thought of restricting this usage.
|
||||
// gfortran/ifort compiles this.
|
||||
assert(expr && "assumed type used as statement function argument");
|
||||
// As per Fortran 2018 C1580, statement function arguments can only be
|
||||
// scalars, so just pass the box with the address. The only care is to
|
||||
// to use the dummy character explicit length if any instead of the
|
||||
// actual argument length (that can be bigger).
|
||||
if (const Fortran::semantics::DeclTypeSpec *type = arg->GetType())
|
||||
if (type->category() == Fortran::semantics::DeclTypeSpec::Character)
|
||||
if (const Fortran::semantics::MaybeIntExpr &lenExpr =
|
||||
type->characterTypeSpec().length().GetExplicit()) {
|
||||
mlir::Value len = fir::getBase(genval(*lenExpr));
|
||||
// F2018 7.4.4.2 point 5.
|
||||
len = Fortran::lower::genMaxWithZero(builder, getLoc(), len);
|
||||
symMap.addSymbol(*arg,
|
||||
replaceScalarCharacterLength(gen(*expr), len));
|
||||
continue;
|
||||
}
|
||||
symMap.addSymbol(*arg, gen(*expr));
|
||||
}
|
||||
|
||||
// Explicitly map statement function host associated symbols to their
|
||||
// parent scope lowered symbol box.
|
||||
for (const Fortran::semantics::SymbolRef &sym :
|
||||
Fortran::evaluate::CollectSymbols(*details.stmtFunction()))
|
||||
if (const auto *details =
|
||||
sym->detailsIf<Fortran::semantics::HostAssocDetails>())
|
||||
if (!symMap.lookupSymbol(*sym))
|
||||
symMap.addSymbol(*sym, gen(details->symbol()));
|
||||
|
||||
ExtValue result = genval(details.stmtFunction().value());
|
||||
LLVM_DEBUG(llvm::dbgs() << "stmt-function: " << result << '\n');
|
||||
symMap.popScope();
|
||||
return result;
|
||||
}
|
||||
|
||||
/// Helper to package a Value and its properties into an ExtendedValue.
|
||||
static ExtValue toExtendedValue(mlir::Location loc, mlir::Value base,
|
||||
|
|
@ -2152,6 +2330,25 @@ public:
|
|||
return temp;
|
||||
}
|
||||
|
||||
/// Generate copy-out if needed and free the temporary for an argument that
|
||||
/// has been copied-in into a contiguous temp.
|
||||
void genCopyOut(const CopyOutPair ©OutPair) {
|
||||
mlir::Location loc = getLoc();
|
||||
if (!copyOutPair.restrictCopyAndFreeAtRuntime) {
|
||||
if (copyOutPair.argMayBeModifiedByCall)
|
||||
genArrayCopy(copyOutPair.var, copyOutPair.temp);
|
||||
builder.create<fir::FreeMemOp>(loc, fir::getBase(copyOutPair.temp));
|
||||
return;
|
||||
}
|
||||
builder.genIfThen(loc, *copyOutPair.restrictCopyAndFreeAtRuntime)
|
||||
.genThen([&]() {
|
||||
if (copyOutPair.argMayBeModifiedByCall)
|
||||
genArrayCopy(copyOutPair.var, copyOutPair.temp);
|
||||
builder.create<fir::FreeMemOp>(loc, fir::getBase(copyOutPair.temp));
|
||||
})
|
||||
.end();
|
||||
}
|
||||
|
||||
/// Lower a non-elemental procedure reference.
|
||||
ExtValue genRawProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
|
||||
llvm::Optional<mlir::Type> resultType) {
|
||||
|
|
@ -2164,7 +2361,7 @@ public:
|
|||
return genIntrinsicRef(procRef, *intrinsic, resultType);
|
||||
|
||||
if (isStatementFunctionCall(procRef))
|
||||
TODO(loc, "Lower statement function call");
|
||||
return genStmtFunctionRef(procRef);
|
||||
|
||||
Fortran::lower::CallerInterface caller(procRef, converter);
|
||||
using PassBy = Fortran::lower::CallerInterface::PassEntityBy;
|
||||
|
|
@ -2229,6 +2426,28 @@ public:
|
|||
continue;
|
||||
}
|
||||
const bool actualArgIsVariable = Fortran::evaluate::IsVariable(*expr);
|
||||
if (arg.passBy == PassBy::BaseAddressValueAttribute) {
|
||||
mlir::Value temp;
|
||||
if (isArray(*expr)) {
|
||||
auto val = genBoxArg(*expr);
|
||||
if (!actualArgIsVariable)
|
||||
temp = getBase(val);
|
||||
else {
|
||||
ExtValue copy = genArrayTempFromMold(val, ".copy");
|
||||
genArrayCopy(copy, val);
|
||||
temp = fir::getBase(copy);
|
||||
}
|
||||
} else {
|
||||
mlir::Value val = fir::getBase(genval(*expr));
|
||||
temp = builder.createTemporary(
|
||||
loc, val.getType(),
|
||||
llvm::ArrayRef<mlir::NamedAttribute>{
|
||||
Fortran::lower::getAdaptToByRefAttr(builder)});
|
||||
builder.create<fir::StoreOp>(loc, val, temp);
|
||||
}
|
||||
caller.placeInput(arg, temp);
|
||||
continue;
|
||||
}
|
||||
if (arg.passBy == PassBy::BaseAddress || arg.passBy == PassBy::BoxChar) {
|
||||
const bool actualIsSimplyContiguous =
|
||||
!actualArgIsVariable || Fortran::evaluate::IsSimplyContiguous(
|
||||
|
|
@ -2238,13 +2457,50 @@ public:
|
|||
if (actualArgIsVariable && arg.isOptional()) {
|
||||
if (Fortran::evaluate::IsAllocatableOrPointerObject(
|
||||
*expr, converter.getFoldingContext())) {
|
||||
TODO(loc, "Allocatable or pointer argument");
|
||||
// Fortran 2018 15.5.2.12 point 1: If unallocated/disassociated,
|
||||
// it is as if the argument was absent. The main care here is to
|
||||
// not do a copy-in/copy-out because the temp address, even though
|
||||
// pointing to a null size storage, would not be a nullptr and
|
||||
// therefore the argument would not be considered absent on the
|
||||
// callee side. Note: if wholeSymbol is optional, it cannot be
|
||||
// absent as per 15.5.2.12 point 7. and 8. We rely on this to
|
||||
// un-conditionally read the allocatable/pointer descriptor here.
|
||||
if (actualIsSimplyContiguous)
|
||||
return genBoxArg(*expr);
|
||||
fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
|
||||
mlir::Value isAssociated =
|
||||
fir::factory::genIsAllocatedOrAssociatedTest(builder, loc,
|
||||
mutableBox);
|
||||
fir::ExtendedValue actualExv =
|
||||
fir::factory::genMutableBoxRead(builder, loc, mutableBox);
|
||||
return genCopyIn(actualExv, arg, copyOutPairs, isAssociated);
|
||||
}
|
||||
if (const Fortran::semantics::Symbol *wholeSymbol =
|
||||
Fortran::evaluate::UnwrapWholeSymbolOrComponentDataRef(
|
||||
*expr))
|
||||
if (Fortran::semantics::IsOptional(*wholeSymbol)) {
|
||||
TODO(loc, "procedureref optional arg");
|
||||
ExtValue actualArg = gen(*expr);
|
||||
mlir::Value actualArgBase = fir::getBase(actualArg);
|
||||
if (!actualArgBase.getType().isa<fir::BoxType>())
|
||||
return actualArg;
|
||||
// Do not read wholeSymbol descriptor that may be a nullptr in
|
||||
// case wholeSymbol is absent.
|
||||
// Absent descriptor cannot be read. To avoid any issue in
|
||||
// copy-in/copy-out, and when retrieving the address/length
|
||||
// create an descriptor pointing to a null address here if the
|
||||
// fir.box is absent.
|
||||
mlir::Value isPresent = builder.create<fir::IsPresentOp>(
|
||||
loc, builder.getI1Type(), actualArgBase);
|
||||
mlir::Type boxType = actualArgBase.getType();
|
||||
mlir::Value emptyBox = fir::factory::createUnallocatedBox(
|
||||
builder, loc, boxType, llvm::None);
|
||||
auto safeToReadBox = builder.create<mlir::arith::SelectOp>(
|
||||
loc, isPresent, actualArgBase, emptyBox);
|
||||
fir::ExtendedValue safeToReadExv =
|
||||
fir::substBase(actualArg, safeToReadBox);
|
||||
if (actualIsSimplyContiguous)
|
||||
return safeToReadExv;
|
||||
return genCopyIn(safeToReadExv, arg, copyOutPairs, isPresent);
|
||||
}
|
||||
// Fall through: The actual argument can safely be
|
||||
// copied-in/copied-out without any care if needed.
|
||||
|
|
@ -2309,7 +2565,25 @@ public:
|
|||
// (Fortran 2018 15.5.2.12 point 1).
|
||||
if (arg.isOptional() && Fortran::evaluate::IsAllocatableOrPointerObject(
|
||||
*expr, converter.getFoldingContext())) {
|
||||
TODO(loc, "optional allocatable or pointer argument");
|
||||
// Note that passing an absent allocatable to a non-allocatable
|
||||
// optional dummy argument is illegal (15.5.2.12 point 3 (8)). So
|
||||
// nothing has to be done to generate an absent argument in this case,
|
||||
// and it is OK to unconditionally read the mutable box here.
|
||||
fir::MutableBoxValue mutableBox = genMutableBoxValue(*expr);
|
||||
mlir::Value isAllocated =
|
||||
fir::factory::genIsAllocatedOrAssociatedTest(builder, loc,
|
||||
mutableBox);
|
||||
auto absent = builder.create<fir::AbsentOp>(loc, argTy);
|
||||
/// For now, assume it is not OK to pass the allocatable/pointer
|
||||
/// descriptor to a non pointer/allocatable dummy. That is a strict
|
||||
/// interpretation of 18.3.6 point 4 that stipulates the descriptor
|
||||
/// has the dummy attributes in BIND(C) contexts.
|
||||
mlir::Value box = builder.createBox(
|
||||
loc, fir::factory::genMutableBoxRead(builder, loc, mutableBox));
|
||||
// Need the box types to be exactly similar for the selectOp.
|
||||
mlir::Value convertedBox = builder.createConvert(loc, argTy, box);
|
||||
caller.placeInput(arg, builder.create<mlir::arith::SelectOp>(
|
||||
loc, isAllocated, convertedBox, absent));
|
||||
} else {
|
||||
// Make sure a variable address is only passed if the expression is
|
||||
// actually a variable.
|
||||
|
|
@ -2324,7 +2598,10 @@ public:
|
|||
caller.placeAddressAndLengthInput(arg, fir::getBase(argRef),
|
||||
fir::getLen(argRef));
|
||||
} else if (arg.passBy == PassBy::CharProcTuple) {
|
||||
TODO(loc, "procedureref CharProcTuple");
|
||||
ExtValue argRef = genExtAddr(*expr);
|
||||
mlir::Value tuple = createBoxProcCharTuple(
|
||||
converter, argTy, fir::getBase(argRef), fir::getLen(argRef));
|
||||
caller.placeInput(arg, tuple);
|
||||
} else {
|
||||
TODO(loc, "pass by value in non elemental function call");
|
||||
}
|
||||
|
|
@ -2332,11 +2609,16 @@ public:
|
|||
|
||||
ExtValue result = genCallOpAndResult(caller, callSiteType, resultType);
|
||||
|
||||
// // Copy-out temps that were created for non contiguous variable arguments
|
||||
// if
|
||||
// // needed.
|
||||
// for (const auto ©OutPair : copyOutPairs)
|
||||
// genCopyOut(copyOutPair);
|
||||
// Sync pointers and allocatables that may have been modified during the
|
||||
// call.
|
||||
for (const auto &mutableBox : mutableModifiedByCall)
|
||||
fir::factory::syncMutableBoxFromIRBox(builder, loc, mutableBox);
|
||||
// Handle case where result was passed as argument
|
||||
|
||||
// Copy-out temps that were created for non contiguous variable arguments if
|
||||
// needed.
|
||||
for (const auto ©OutPair : copyOutPairs)
|
||||
genCopyOut(copyOutPair);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -2453,11 +2735,8 @@ public:
|
|||
}
|
||||
|
||||
template <typename A>
|
||||
ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
|
||||
if (isScalar(x) || Fortran::evaluate::UnwrapWholeSymbolDataRef(x) ||
|
||||
inInitializer)
|
||||
return std::visit([&](const auto &e) { return genval(e); }, x.u);
|
||||
return asArray(x);
|
||||
bool isScalar(const A &x) {
|
||||
return x.Rank() == 0;
|
||||
}
|
||||
|
||||
/// Helper to detect Transformational function reference.
|
||||
|
|
@ -2519,10 +2798,12 @@ public:
|
|||
return asArrayArg(x);
|
||||
return asArray(x);
|
||||
}
|
||||
|
||||
template <typename A>
|
||||
bool isScalar(const A &x) {
|
||||
return x.Rank() == 0;
|
||||
ExtValue genval(const Fortran::evaluate::Expr<A> &x) {
|
||||
if (isScalar(x) || Fortran::evaluate::UnwrapWholeSymbolDataRef(x) ||
|
||||
inInitializer)
|
||||
return std::visit([&](const auto &e) { return genval(e); }, x.u);
|
||||
return asArray(x);
|
||||
}
|
||||
|
||||
template <int KIND>
|
||||
|
|
@ -2545,6 +2826,10 @@ public:
|
|||
}
|
||||
template <typename A>
|
||||
ExtValue genref(const A &a) {
|
||||
if (inInitializer) {
|
||||
// Initialization expressions can never allocate memory.
|
||||
return genval(a);
|
||||
}
|
||||
mlir::Type storageType = converter.genType(toEvExpr(a));
|
||||
return placeScalarValueInMemory(builder, getLoc(), genval(a), storageType);
|
||||
}
|
||||
|
|
@ -5171,7 +5456,7 @@ public:
|
|||
},
|
||||
[&](const Fortran::evaluate::Component *x) {
|
||||
auto fieldTy = fir::FieldType::get(builder.getContext());
|
||||
llvm::StringRef name = toStringRef(x->GetLastSymbol().name());
|
||||
llvm::StringRef name = toStringRef(getLastSym(*x).name());
|
||||
auto recTy = ty.cast<fir::RecordType>();
|
||||
ty = recTy.getType(name);
|
||||
auto fld = builder.create<fir::FieldIndexOp>(
|
||||
|
|
@ -5298,7 +5583,7 @@ public:
|
|||
CC genImplicitArrayAccess(const A &x, ComponentPath &components) {
|
||||
components.reversePath.push_back(ImplicitSubscripts{});
|
||||
ExtValue exv = asScalarRef(x);
|
||||
// lowerPath(exv, components);
|
||||
lowerPath(exv, components);
|
||||
auto lambda = genarr(exv, components);
|
||||
return [=](IterSpace iters) { return lambda(components.pc(iters)); };
|
||||
}
|
||||
|
|
@ -5805,8 +6090,8 @@ private:
|
|||
void determineShapeOfDest(const Fortran::lower::SomeExpr &lhs) {
|
||||
if (!destShape.empty())
|
||||
return;
|
||||
// if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
|
||||
// return;
|
||||
if (explicitSpaceIsActive() && determineShapeWithSlice(lhs))
|
||||
return;
|
||||
mlir::Type idxTy = builder.getIndexType();
|
||||
mlir::Location loc = getLoc();
|
||||
if (std::optional<Fortran::evaluate::ConstantSubscripts> constantShape =
|
||||
|
|
@ -5816,6 +6101,79 @@ private:
|
|||
destShape.push_back(builder.createIntegerConstant(loc, idxTy, extent));
|
||||
}
|
||||
|
||||
bool genShapeFromDataRef(const Fortran::semantics::Symbol &x) {
|
||||
return false;
|
||||
}
|
||||
bool genShapeFromDataRef(const Fortran::evaluate::CoarrayRef &) {
|
||||
TODO(getLoc(), "coarray ref");
|
||||
return false;
|
||||
}
|
||||
bool genShapeFromDataRef(const Fortran::evaluate::Component &x) {
|
||||
return x.base().Rank() > 0 ? genShapeFromDataRef(x.base()) : false;
|
||||
}
|
||||
bool genShapeFromDataRef(const Fortran::evaluate::ArrayRef &x) {
|
||||
if (x.Rank() == 0)
|
||||
return false;
|
||||
if (x.base().Rank() > 0)
|
||||
if (genShapeFromDataRef(x.base()))
|
||||
return true;
|
||||
// x has rank and x.base did not produce a shape.
|
||||
ExtValue exv = x.base().IsSymbol() ? asScalarRef(getFirstSym(x.base()))
|
||||
: asScalarRef(x.base().GetComponent());
|
||||
mlir::Location loc = getLoc();
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
llvm::SmallVector<mlir::Value> definedShape =
|
||||
fir::factory::getExtents(builder, loc, exv);
|
||||
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
|
||||
for (auto ss : llvm::enumerate(x.subscript())) {
|
||||
std::visit(Fortran::common::visitors{
|
||||
[&](const Fortran::evaluate::Triplet &trip) {
|
||||
// For a subscript of triple notation, we compute the
|
||||
// range of this dimension of the iteration space.
|
||||
auto lo = [&]() {
|
||||
if (auto optLo = trip.lower())
|
||||
return fir::getBase(asScalar(*optLo));
|
||||
return getLBound(exv, ss.index(), one);
|
||||
}();
|
||||
auto hi = [&]() {
|
||||
if (auto optHi = trip.upper())
|
||||
return fir::getBase(asScalar(*optHi));
|
||||
return getUBound(exv, ss.index(), one);
|
||||
}();
|
||||
auto step = builder.createConvert(
|
||||
loc, idxTy, fir::getBase(asScalar(trip.stride())));
|
||||
auto extent = builder.genExtentFromTriplet(loc, lo, hi,
|
||||
step, idxTy);
|
||||
destShape.push_back(extent);
|
||||
},
|
||||
[&](auto) {}},
|
||||
ss.value().u);
|
||||
}
|
||||
return true;
|
||||
}
|
||||
bool genShapeFromDataRef(const Fortran::evaluate::NamedEntity &x) {
|
||||
if (x.IsSymbol())
|
||||
return genShapeFromDataRef(getFirstSym(x));
|
||||
return genShapeFromDataRef(x.GetComponent());
|
||||
}
|
||||
bool genShapeFromDataRef(const Fortran::evaluate::DataRef &x) {
|
||||
return std::visit([&](const auto &v) { return genShapeFromDataRef(v); },
|
||||
x.u);
|
||||
}
|
||||
|
||||
/// When in an explicit space, the ranked component must be evaluated to
|
||||
/// determine the actual number of iterations when slicing triples are
|
||||
/// present. Lower these expressions here.
|
||||
bool determineShapeWithSlice(const Fortran::lower::SomeExpr &lhs) {
|
||||
LLVM_DEBUG(Fortran::lower::DumpEvaluateExpr::dump(
|
||||
llvm::dbgs() << "determine shape of:\n", lhs));
|
||||
// FIXME: We may not want to use ExtractDataRef here since it doesn't deal
|
||||
// with substrings, etc.
|
||||
std::optional<Fortran::evaluate::DataRef> dref =
|
||||
Fortran::evaluate::ExtractDataRef(lhs);
|
||||
return dref.has_value() ? genShapeFromDataRef(*dref) : false;
|
||||
}
|
||||
|
||||
ExtValue lowerArrayExpression(const Fortran::lower::SomeExpr &exp) {
|
||||
mlir::Type resTy = converter.genType(exp);
|
||||
return std::visit(
|
||||
|
|
@ -5908,11 +6266,33 @@ private:
|
|||
return abstractArrayExtValue(iterSpace.outerResult());
|
||||
}
|
||||
|
||||
/// Compute the shape of a slice.
|
||||
llvm::SmallVector<mlir::Value> computeSliceShape(mlir::Value slice) {
|
||||
llvm::SmallVector<mlir::Value> slicedShape;
|
||||
auto slOp = mlir::cast<fir::SliceOp>(slice.getDefiningOp());
|
||||
mlir::Operation::operand_range triples = slOp.getTriples();
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
mlir::Location loc = getLoc();
|
||||
for (unsigned i = 0, end = triples.size(); i < end; i += 3) {
|
||||
if (!mlir::isa_and_nonnull<fir::UndefOp>(
|
||||
triples[i + 1].getDefiningOp())) {
|
||||
// (..., lb:ub:step, ...) case: extent = max((ub-lb+step)/step, 0)
|
||||
// See Fortran 2018 9.5.3.3.2 section for more details.
|
||||
mlir::Value res = builder.genExtentFromTriplet(
|
||||
loc, triples[i], triples[i + 1], triples[i + 2], idxTy);
|
||||
slicedShape.emplace_back(res);
|
||||
} else {
|
||||
// do nothing. `..., i, ...` case, so dimension is dropped.
|
||||
}
|
||||
}
|
||||
return slicedShape;
|
||||
}
|
||||
|
||||
/// Get the shape from an ArrayOperand. The shape of the array is adjusted if
|
||||
/// the array was sliced.
|
||||
llvm::SmallVector<mlir::Value> getShape(ArrayOperand array) {
|
||||
// if (array.slice)
|
||||
// return computeSliceShape(array.slice);
|
||||
if (array.slice)
|
||||
return computeSliceShape(array.slice);
|
||||
if (array.memref.getType().isa<fir::BoxType>())
|
||||
return fir::factory::readExtents(builder, getLoc(),
|
||||
fir::BoxValue{array.memref});
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
#include "flang/Lower/BoxAnalyzer.h"
|
||||
#include "flang/Lower/CallInterface.h"
|
||||
#include "flang/Lower/ConvertExpr.h"
|
||||
#include "flang/Lower/IntrinsicCall.h"
|
||||
#include "flang/Lower/Mangler.h"
|
||||
#include "flang/Lower/PFTBuilder.h"
|
||||
#include "flang/Lower/StatementContext.h"
|
||||
|
|
@ -30,50 +31,12 @@
|
|||
#include "flang/Optimizer/Dialect/FIROps.h"
|
||||
#include "flang/Optimizer/Support/FIRContext.h"
|
||||
#include "flang/Optimizer/Support/FatalError.h"
|
||||
#include "flang/Semantics/runtime-type-info.h"
|
||||
#include "flang/Semantics/tools.h"
|
||||
#include "llvm/Support/Debug.h"
|
||||
|
||||
#define DEBUG_TYPE "flang-lower-variable"
|
||||
|
||||
/// Helper to retrieve a copy of a character literal string from a SomeExpr.
|
||||
/// Required to build character global initializers.
|
||||
template <int KIND>
|
||||
static llvm::Optional<std::tuple<std::string, std::size_t>>
|
||||
getCharacterLiteralCopy(
|
||||
const Fortran::evaluate::Expr<
|
||||
Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>
|
||||
&x) {
|
||||
if (const auto *con =
|
||||
Fortran::evaluate::UnwrapConstantValue<Fortran::evaluate::Type<
|
||||
Fortran::common::TypeCategory::Character, KIND>>(x))
|
||||
if (auto val = con->GetScalarValue())
|
||||
return std::tuple<std::string, std::size_t>{
|
||||
std::string{(const char *)val->c_str(),
|
||||
KIND * (std::size_t)con->LEN()},
|
||||
(std::size_t)con->LEN()};
|
||||
return llvm::None;
|
||||
}
|
||||
static llvm::Optional<std::tuple<std::string, std::size_t>>
|
||||
getCharacterLiteralCopy(
|
||||
const Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter> &x) {
|
||||
return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); },
|
||||
x.u);
|
||||
}
|
||||
static llvm::Optional<std::tuple<std::string, std::size_t>>
|
||||
getCharacterLiteralCopy(const Fortran::lower::SomeExpr &x) {
|
||||
if (const auto *e = Fortran::evaluate::UnwrapExpr<
|
||||
Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(x))
|
||||
return getCharacterLiteralCopy(*e);
|
||||
return llvm::None;
|
||||
}
|
||||
template <typename A>
|
||||
static llvm::Optional<std::tuple<std::string, std::size_t>>
|
||||
getCharacterLiteralCopy(const std::optional<A> &x) {
|
||||
if (x)
|
||||
return getCharacterLiteralCopy(*x);
|
||||
return llvm::None;
|
||||
}
|
||||
|
||||
/// Helper to lower a scalar expression using a specific symbol mapping.
|
||||
static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
|
||||
mlir::Location loc,
|
||||
|
|
@ -123,6 +86,23 @@ static bool isConstant(const Fortran::semantics::Symbol &sym) {
|
|||
sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
|
||||
}
|
||||
|
||||
/// Is this a compiler generated symbol to describe derived types ?
|
||||
static bool isRuntimeTypeInfoData(const Fortran::semantics::Symbol &sym) {
|
||||
// So far, use flags to detect if this symbol were generated during
|
||||
// semantics::BuildRuntimeDerivedTypeTables(). Scope cannot be used since the
|
||||
// symbols are injected in the user scopes defining the described derived
|
||||
// types. A robustness improvement for this test could be to get hands on the
|
||||
// semantics::RuntimeDerivedTypeTables and to check if the symbol names
|
||||
// belongs to this structure.
|
||||
return sym.test(Fortran::semantics::Symbol::Flag::CompilerCreated) &&
|
||||
sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
|
||||
}
|
||||
|
||||
static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
llvm::StringRef globalName,
|
||||
mlir::StringAttr linkage);
|
||||
|
||||
/// Create the global op declaration without any initializer
|
||||
static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
|
|
@ -131,6 +111,11 @@ static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
|
|||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
|
||||
return global;
|
||||
// Always define linkonce data since it may be optimized out from the module
|
||||
// that actually owns the variable if it does not refers to it.
|
||||
if (linkage == builder.createLinkOnceODRLinkage() ||
|
||||
linkage == builder.createLinkOnceLinkage())
|
||||
return defineGlobal(converter, var, globalName, linkage);
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
mlir::Location loc = converter.genLocation(sym.name());
|
||||
// Resolve potential host and module association before checking that this
|
||||
|
|
@ -444,27 +429,16 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
|
|||
} else if (const auto *details =
|
||||
sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
|
||||
if (details->init()) {
|
||||
if (fir::isa_char(symTy)) {
|
||||
// CHARACTER literal
|
||||
if (auto chLit = getCharacterLiteralCopy(details->init().value())) {
|
||||
mlir::StringAttr init =
|
||||
builder.getStringAttr(std::get<std::string>(*chLit));
|
||||
global->setAttr(global.getInitValAttrName(), init);
|
||||
} else {
|
||||
fir::emitFatalError(loc, "CHARACTER has unexpected initial value");
|
||||
}
|
||||
} else {
|
||||
createGlobalInitialization(
|
||||
builder, global, [&](fir::FirOpBuilder &builder) {
|
||||
Fortran::lower::StatementContext stmtCtx(
|
||||
/*cleanupProhibited=*/true);
|
||||
fir::ExtendedValue initVal = genInitializerExprValue(
|
||||
converter, loc, details->init().value(), stmtCtx);
|
||||
mlir::Value castTo =
|
||||
builder.createConvert(loc, symTy, fir::getBase(initVal));
|
||||
builder.create<fir::HasValueOp>(loc, castTo);
|
||||
});
|
||||
}
|
||||
createGlobalInitialization(
|
||||
builder, global, [&](fir::FirOpBuilder &builder) {
|
||||
Fortran::lower::StatementContext stmtCtx(
|
||||
/*cleanupProhibited=*/true);
|
||||
fir::ExtendedValue initVal = genInitializerExprValue(
|
||||
converter, loc, details->init().value(), stmtCtx);
|
||||
mlir::Value castTo =
|
||||
builder.createConvert(loc, symTy, fir::getBase(initVal));
|
||||
builder.create<fir::HasValueOp>(loc, castTo);
|
||||
});
|
||||
} else if (hasDefaultInitialization(sym)) {
|
||||
createGlobalInitialization(
|
||||
builder, global, [&](fir::FirOpBuilder &builder) {
|
||||
|
|
@ -498,6 +472,12 @@ static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
|
|||
static mlir::StringAttr
|
||||
getLinkageAttribute(fir::FirOpBuilder &builder,
|
||||
const Fortran::lower::pft::Variable &var) {
|
||||
// Runtime type info for a same derived type is identical in each compilation
|
||||
// unit. It desired to avoid having to link against module that only define a
|
||||
// type. Therefore the runtime type info is generated everywhere it is needed
|
||||
// with `linkonce_odr` LLVM linkage.
|
||||
if (var.hasSymbol() && isRuntimeTypeInfoData(var.getSymbol()))
|
||||
return builder.createLinkOnceODRLinkage();
|
||||
if (var.isModuleVariable())
|
||||
return {}; // external linkage
|
||||
// Otherwise, the variable is owned by a procedure and must not be visible in
|
||||
|
|
@ -557,6 +537,49 @@ static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
|
|||
return builder.allocateLocal(loc, ty, nm, symNm, shape, lenParams, isTarg);
|
||||
}
|
||||
|
||||
/// Must \p var be default initialized at runtime when entering its scope.
|
||||
static bool
|
||||
mustBeDefaultInitializedAtRuntime(const Fortran::lower::pft::Variable &var) {
|
||||
if (!var.hasSymbol())
|
||||
return false;
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
if (var.isGlobal())
|
||||
// Global variables are statically initialized.
|
||||
return false;
|
||||
if (Fortran::semantics::IsDummy(sym) && !Fortran::semantics::IsIntentOut(sym))
|
||||
return false;
|
||||
// Local variables (including function results), and intent(out) dummies must
|
||||
// be default initialized at runtime if their type has default initialization.
|
||||
return hasDefaultInitialization(sym);
|
||||
}
|
||||
|
||||
/// Call default initialization runtime routine to initialize \p var.
|
||||
static void
|
||||
defaultInitializeAtRuntime(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
Fortran::lower::SymMap &symMap) {
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
mlir::Location loc = converter.getCurrentLocation();
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
fir::ExtendedValue exv = symMap.lookupSymbol(sym).toExtendedValue();
|
||||
if (Fortran::semantics::IsOptional(sym)) {
|
||||
// 15.5.2.12 point 3, absent optional dummies are not initialized.
|
||||
// Creating descriptor/passing null descriptor to the runtime would
|
||||
// create runtime crashes.
|
||||
auto isPresent = builder.create<fir::IsPresentOp>(loc, builder.getI1Type(),
|
||||
fir::getBase(exv));
|
||||
builder.genIfThen(loc, isPresent)
|
||||
.genThen([&]() {
|
||||
auto box = builder.createBox(loc, exv);
|
||||
fir::runtime::genDerivedTypeInitialize(builder, loc, box);
|
||||
})
|
||||
.end();
|
||||
} else {
|
||||
mlir::Value box = builder.createBox(loc, exv);
|
||||
fir::runtime::genDerivedTypeInitialize(builder, loc, box);
|
||||
}
|
||||
}
|
||||
|
||||
/// Instantiate a local variable. Precondition: Each variable will be visited
|
||||
/// such that if its properties depend on other variables, the variables upon
|
||||
/// which its properties depend will already have been visited.
|
||||
|
|
@ -566,6 +589,161 @@ static void instantiateLocal(Fortran::lower::AbstractConverter &converter,
|
|||
assert(!var.isAlias());
|
||||
Fortran::lower::StatementContext stmtCtx;
|
||||
mapSymbolAttributes(converter, var, symMap, stmtCtx);
|
||||
if (mustBeDefaultInitializedAtRuntime(var))
|
||||
defaultInitializeAtRuntime(converter, var, symMap);
|
||||
}
|
||||
|
||||
//===----------------------------------------------------------------===//
|
||||
// Aliased (EQUIVALENCE) variables instantiation
|
||||
//===----------------------------------------------------------------===//
|
||||
|
||||
/// Insert \p aggregateStore instance into an AggregateStoreMap.
|
||||
static void insertAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
mlir::Value aggregateStore) {
|
||||
std::size_t off = var.getAggregateStore().getOffset();
|
||||
Fortran::lower::AggregateStoreKey key = {var.getOwningScope(), off};
|
||||
storeMap[key] = aggregateStore;
|
||||
}
|
||||
|
||||
/// Retrieve the aggregate store instance of \p alias from an
|
||||
/// AggregateStoreMap.
|
||||
static mlir::Value
|
||||
getAggregateStore(Fortran::lower::AggregateStoreMap &storeMap,
|
||||
const Fortran::lower::pft::Variable &alias) {
|
||||
Fortran::lower::AggregateStoreKey key = {alias.getOwningScope(),
|
||||
alias.getAlias()};
|
||||
auto iter = storeMap.find(key);
|
||||
assert(iter != storeMap.end());
|
||||
return iter->second;
|
||||
}
|
||||
|
||||
/// Build the name for the storage of a global equivalence.
|
||||
static std::string mangleGlobalAggregateStore(
|
||||
const Fortran::lower::pft::Variable::AggregateStore &st) {
|
||||
return Fortran::lower::mangle::mangleName(st.getNamingSymbol());
|
||||
}
|
||||
|
||||
/// Build the type for the storage of an equivalence.
|
||||
static mlir::Type
|
||||
getAggregateType(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable::AggregateStore &st) {
|
||||
if (const Fortran::semantics::Symbol *initSym = st.getInitialValueSymbol())
|
||||
return converter.genType(*initSym);
|
||||
mlir::IntegerType byteTy = converter.getFirOpBuilder().getIntegerType(8);
|
||||
return fir::SequenceType::get(std::get<1>(st.interval), byteTy);
|
||||
}
|
||||
|
||||
/// Define a GlobalOp for the storage of a global equivalence described
|
||||
/// by \p aggregate. The global is named \p aggName and is created with
|
||||
/// the provided \p linkage.
|
||||
/// If any of the equivalence members are initialized, an initializer is
|
||||
/// created for the equivalence.
|
||||
/// This is to be used when lowering the scope that owns the equivalence
|
||||
/// (as opposed to simply using it through host or use association).
|
||||
/// This is not to be used for equivalence of common block members (they
|
||||
/// already have the common block GlobalOp for them, see defineCommonBlock).
|
||||
static fir::GlobalOp defineGlobalAggregateStore(
|
||||
Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable::AggregateStore &aggregate,
|
||||
llvm::StringRef aggName, mlir::StringAttr linkage) {
|
||||
assert(aggregate.isGlobal() && "not a global interval");
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
fir::GlobalOp global = builder.getNamedGlobal(aggName);
|
||||
if (global && globalIsInitialized(global))
|
||||
return global;
|
||||
mlir::Location loc = converter.getCurrentLocation();
|
||||
mlir::Type aggTy = getAggregateType(converter, aggregate);
|
||||
if (!global)
|
||||
global = builder.createGlobal(loc, aggTy, aggName, linkage);
|
||||
|
||||
if (const Fortran::semantics::Symbol *initSym =
|
||||
aggregate.getInitialValueSymbol())
|
||||
if (const auto *objectDetails =
|
||||
initSym->detailsIf<Fortran::semantics::ObjectEntityDetails>())
|
||||
if (objectDetails->init()) {
|
||||
createGlobalInitialization(
|
||||
builder, global, [&](fir::FirOpBuilder &builder) {
|
||||
Fortran::lower::StatementContext stmtCtx;
|
||||
mlir::Value initVal = fir::getBase(genInitializerExprValue(
|
||||
converter, loc, objectDetails->init().value(), stmtCtx));
|
||||
builder.create<fir::HasValueOp>(loc, initVal);
|
||||
});
|
||||
return global;
|
||||
}
|
||||
// Equivalence has no Fortran initial value. Create an undefined FIR initial
|
||||
// value to ensure this is consider an object definition in the IR regardless
|
||||
// of the linkage.
|
||||
createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &builder) {
|
||||
Fortran::lower::StatementContext stmtCtx;
|
||||
mlir::Value initVal = builder.create<fir::UndefOp>(loc, aggTy);
|
||||
builder.create<fir::HasValueOp>(loc, initVal);
|
||||
});
|
||||
return global;
|
||||
}
|
||||
|
||||
/// Declare a GlobalOp for the storage of a global equivalence described
|
||||
/// by \p aggregate. The global is named \p aggName and is created with
|
||||
/// the provided \p linkage.
|
||||
/// No initializer is built for the created GlobalOp.
|
||||
/// This is to be used when lowering the scope that uses members of an
|
||||
/// equivalence it through host or use association.
|
||||
/// This is not to be used for equivalence of common block members (they
|
||||
/// already have the common block GlobalOp for them, see defineCommonBlock).
|
||||
static fir::GlobalOp declareGlobalAggregateStore(
|
||||
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
|
||||
const Fortran::lower::pft::Variable::AggregateStore &aggregate,
|
||||
llvm::StringRef aggName, mlir::StringAttr linkage) {
|
||||
assert(aggregate.isGlobal() && "not a global interval");
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
if (fir::GlobalOp global = builder.getNamedGlobal(aggName))
|
||||
return global;
|
||||
mlir::Type aggTy = getAggregateType(converter, aggregate);
|
||||
return builder.createGlobal(loc, aggTy, aggName, linkage);
|
||||
}
|
||||
|
||||
/// This is an aggregate store for a set of EQUIVALENCED variables. Create the
|
||||
/// storage on the stack or global memory and add it to the map.
|
||||
static void
|
||||
instantiateAggregateStore(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
Fortran::lower::AggregateStoreMap &storeMap) {
|
||||
assert(var.isAggregateStore() && "not an interval");
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
mlir::IntegerType i8Ty = builder.getIntegerType(8);
|
||||
mlir::Location loc = converter.getCurrentLocation();
|
||||
std::string aggName = mangleGlobalAggregateStore(var.getAggregateStore());
|
||||
if (var.isGlobal()) {
|
||||
fir::GlobalOp global;
|
||||
auto &aggregate = var.getAggregateStore();
|
||||
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
|
||||
if (var.isModuleVariable()) {
|
||||
// A module global was or will be defined when lowering the module. Emit
|
||||
// only a declaration if the global does not exist at that point.
|
||||
global = declareGlobalAggregateStore(converter, loc, aggregate, aggName,
|
||||
linkage);
|
||||
} else {
|
||||
global =
|
||||
defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
|
||||
}
|
||||
auto addr = builder.create<fir::AddrOfOp>(loc, global.resultType(),
|
||||
global.getSymbol());
|
||||
auto size = std::get<1>(var.getInterval());
|
||||
fir::SequenceType::Shape shape(1, size);
|
||||
auto seqTy = fir::SequenceType::get(shape, i8Ty);
|
||||
mlir::Type refTy = builder.getRefType(seqTy);
|
||||
mlir::Value aggregateStore = builder.createConvert(loc, refTy, addr);
|
||||
insertAggregateStore(storeMap, var, aggregateStore);
|
||||
return;
|
||||
}
|
||||
// This is a local aggregate, allocate an anonymous block of memory.
|
||||
auto size = std::get<1>(var.getInterval());
|
||||
fir::SequenceType::Shape shape(1, size);
|
||||
auto seqTy = fir::SequenceType::get(shape, i8Ty);
|
||||
mlir::Value local =
|
||||
builder.allocateLocal(loc, seqTy, aggName, "", llvm::None, llvm::None,
|
||||
/*target=*/false);
|
||||
insertAggregateStore(storeMap, var, local);
|
||||
}
|
||||
|
||||
/// Cast an alias address (variable part of an equivalence) to fir.ptr so that
|
||||
|
|
@ -580,6 +758,40 @@ static mlir::Value castAliasToPointer(fir::FirOpBuilder &builder,
|
|||
aliasAddr);
|
||||
}
|
||||
|
||||
/// Instantiate a member of an equivalence. Compute its address in its
|
||||
/// aggregate storage and lower its attributes.
|
||||
static void instantiateAlias(Fortran::lower::AbstractConverter &converter,
|
||||
const Fortran::lower::pft::Variable &var,
|
||||
Fortran::lower::SymMap &symMap,
|
||||
Fortran::lower::AggregateStoreMap &storeMap) {
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
assert(var.isAlias());
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
const mlir::Location loc = converter.genLocation(sym.name());
|
||||
mlir::IndexType idxTy = builder.getIndexType();
|
||||
std::size_t aliasOffset = var.getAlias();
|
||||
mlir::Value store = getAggregateStore(storeMap, var);
|
||||
mlir::IntegerType i8Ty = builder.getIntegerType(8);
|
||||
mlir::Type i8Ptr = builder.getRefType(i8Ty);
|
||||
mlir::Value offset = builder.createIntegerConstant(
|
||||
loc, idxTy, sym.GetUltimate().offset() - aliasOffset);
|
||||
auto ptr = builder.create<fir::CoordinateOp>(loc, i8Ptr, store,
|
||||
mlir::ValueRange{offset});
|
||||
mlir::Value preAlloc =
|
||||
castAliasToPointer(builder, loc, converter.genType(sym), ptr);
|
||||
Fortran::lower::StatementContext stmtCtx;
|
||||
mapSymbolAttributes(converter, var, symMap, stmtCtx, preAlloc);
|
||||
// Default initialization is possible for equivalence members: see
|
||||
// F2018 19.5.3.4. Note that if several equivalenced entities have
|
||||
// default initialization, they must have the same type, and the standard
|
||||
// allows the storage to be default initialized several times (this has
|
||||
// no consequences other than wasting some execution time). For now,
|
||||
// do not try optimizing this to single default initializations of
|
||||
// the equivalenced storages. Keep lowering simple.
|
||||
if (mustBeDefaultInitializedAtRuntime(var))
|
||||
defaultInitializeAtRuntime(converter, var, symMap);
|
||||
}
|
||||
|
||||
//===--------------------------------------------------------------===//
|
||||
// COMMON blocks instantiation
|
||||
//===--------------------------------------------------------------===//
|
||||
|
|
@ -1392,13 +1604,131 @@ void Fortran::lower::mapSymbolAttributes(
|
|||
//===--------------------------------------------------------------===//
|
||||
|
||||
[&](const Fortran::lower::details::DynamicArrayStaticChar &x) {
|
||||
TODO(loc, "DynamicArrayStaticChar variable lowering");
|
||||
mlir::Value addr;
|
||||
mlir::Value len;
|
||||
mlir::Value argBox;
|
||||
auto charLen = x.charLen();
|
||||
// if element type is a CHARACTER, determine the LEN value
|
||||
if (isDummy) {
|
||||
mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
|
||||
if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
|
||||
argBox = actualArg;
|
||||
mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
|
||||
addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
|
||||
} else {
|
||||
addr = charHelp.createUnboxChar(actualArg).first;
|
||||
}
|
||||
// Set/override LEN with a constant
|
||||
len = builder.createIntegerConstant(loc, idxTy, charLen);
|
||||
} else {
|
||||
// local CHARACTER variable
|
||||
len = builder.createIntegerConstant(loc, idxTy, charLen);
|
||||
}
|
||||
|
||||
// cast to the known constant parts from the declaration
|
||||
mlir::Type castTy = builder.getRefType(converter.genType(var));
|
||||
if (addr)
|
||||
addr = builder.createConvert(loc, castTy, addr);
|
||||
if (x.lboundAllOnes()) {
|
||||
// if lower bounds are all ones, build simple shaped object
|
||||
llvm::SmallVector<mlir::Value> shape;
|
||||
populateShape(shape, x.bounds, argBox);
|
||||
if (isDummy) {
|
||||
symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
|
||||
return;
|
||||
}
|
||||
// local CHARACTER array
|
||||
mlir::Value local =
|
||||
createNewLocal(converter, loc, var, preAlloc, shape);
|
||||
symMap.addCharSymbolWithShape(sym, local, len, shape);
|
||||
return;
|
||||
}
|
||||
// if object is an array process the lower bound and extent values
|
||||
llvm::SmallVector<mlir::Value> extents;
|
||||
llvm::SmallVector<mlir::Value> lbounds;
|
||||
populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
|
||||
if (isDummy) {
|
||||
symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
|
||||
true);
|
||||
return;
|
||||
}
|
||||
// local CHARACTER array with computed bounds
|
||||
assert(Fortran::lower::isExplicitShape(sym));
|
||||
mlir::Value local =
|
||||
createNewLocal(converter, loc, var, preAlloc, extents);
|
||||
symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
|
||||
},
|
||||
|
||||
//===--------------------------------------------------------------===//
|
||||
|
||||
[&](const Fortran::lower::details::DynamicArrayDynamicChar &x) {
|
||||
TODO(loc, "DynamicArrayDynamicChar variable lowering");
|
||||
mlir::Value addr;
|
||||
mlir::Value len;
|
||||
mlir::Value argBox;
|
||||
auto charLen = x.charLen();
|
||||
// if element type is a CHARACTER, determine the LEN value
|
||||
if (isDummy) {
|
||||
mlir::Value actualArg = symMap.lookupSymbol(sym).getAddr();
|
||||
if (auto boxTy = actualArg.getType().dyn_cast<fir::BoxType>()) {
|
||||
argBox = actualArg;
|
||||
mlir::Type refTy = builder.getRefType(boxTy.getEleTy());
|
||||
addr = builder.create<fir::BoxAddrOp>(loc, refTy, argBox);
|
||||
if (charLen)
|
||||
// Set/override LEN with an expression.
|
||||
len = genExplicitCharLen(charLen);
|
||||
else
|
||||
// Get the length from the actual arguments.
|
||||
len = charHelp.readLengthFromBox(argBox);
|
||||
} else {
|
||||
std::pair<mlir::Value, mlir::Value> unboxchar =
|
||||
charHelp.createUnboxChar(actualArg);
|
||||
addr = unboxchar.first;
|
||||
if (charLen) {
|
||||
// Set/override LEN with an expression
|
||||
len = genExplicitCharLen(charLen);
|
||||
} else {
|
||||
// Get the length from the actual arguments.
|
||||
len = unboxchar.second;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
// local CHARACTER variable
|
||||
len = genExplicitCharLen(charLen);
|
||||
}
|
||||
llvm::SmallVector<mlir::Value> lengths = {len};
|
||||
|
||||
// cast to the known constant parts from the declaration
|
||||
mlir::Type castTy = builder.getRefType(converter.genType(var));
|
||||
if (addr)
|
||||
addr = builder.createConvert(loc, castTy, addr);
|
||||
if (x.lboundAllOnes()) {
|
||||
// if lower bounds are all ones, build simple shaped object
|
||||
llvm::SmallVector<mlir::Value> shape;
|
||||
populateShape(shape, x.bounds, argBox);
|
||||
if (isDummy) {
|
||||
symMap.addCharSymbolWithShape(sym, addr, len, shape, true);
|
||||
return;
|
||||
}
|
||||
// local CHARACTER array
|
||||
mlir::Value local =
|
||||
createNewLocal(converter, loc, var, preAlloc, shape, lengths);
|
||||
symMap.addCharSymbolWithShape(sym, local, len, shape);
|
||||
return;
|
||||
}
|
||||
// Process the lower bound and extent values.
|
||||
llvm::SmallVector<mlir::Value> extents;
|
||||
llvm::SmallVector<mlir::Value> lbounds;
|
||||
populateLBoundsExtents(lbounds, extents, x.bounds, argBox);
|
||||
if (isDummy) {
|
||||
symMap.addCharSymbolWithBounds(sym, addr, len, extents, lbounds,
|
||||
true);
|
||||
return;
|
||||
}
|
||||
// local CHARACTER array with computed bounds
|
||||
assert(Fortran::lower::isExplicitShape(sym));
|
||||
mlir::Value local =
|
||||
createNewLocal(converter, loc, var, preAlloc, extents, lengths);
|
||||
symMap.addCharSymbolWithBounds(sym, local, len, extents, lbounds);
|
||||
},
|
||||
|
||||
//===--------------------------------------------------------------===//
|
||||
|
|
@ -1413,14 +1743,18 @@ void Fortran::lower::defineModuleVariable(
|
|||
AbstractConverter &converter, const Fortran::lower::pft::Variable &var) {
|
||||
// Use empty linkage for module variables, which makes them available
|
||||
// for use in another unit.
|
||||
mlir::StringAttr externalLinkage;
|
||||
mlir::StringAttr linkage =
|
||||
getLinkageAttribute(converter.getFirOpBuilder(), var);
|
||||
if (!var.isGlobal())
|
||||
fir::emitFatalError(converter.getCurrentLocation(),
|
||||
"attempting to lower module variable as local");
|
||||
// Define aggregate storages for equivalenced objects.
|
||||
if (var.isAggregateStore()) {
|
||||
const mlir::Location loc = converter.genLocation(var.getSymbol().name());
|
||||
TODO(loc, "defineModuleVariable aggregateStore");
|
||||
const Fortran::lower::pft::Variable::AggregateStore &aggregate =
|
||||
var.getAggregateStore();
|
||||
std::string aggName = mangleGlobalAggregateStore(aggregate);
|
||||
defineGlobalAggregateStore(converter, aggregate, aggName, linkage);
|
||||
return;
|
||||
}
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
if (const Fortran::semantics::Symbol *common =
|
||||
|
|
@ -1431,24 +1765,22 @@ void Fortran::lower::defineModuleVariable(
|
|||
// Do nothing. Mapping will be done on user side.
|
||||
} else {
|
||||
std::string globalName = Fortran::lower::mangle::mangleName(sym);
|
||||
defineGlobal(converter, var, globalName, externalLinkage);
|
||||
defineGlobal(converter, var, globalName, linkage);
|
||||
}
|
||||
}
|
||||
|
||||
void Fortran::lower::instantiateVariable(AbstractConverter &converter,
|
||||
const pft::Variable &var,
|
||||
SymMap &symMap,
|
||||
Fortran::lower::SymMap &symMap,
|
||||
AggregateStoreMap &storeMap) {
|
||||
const Fortran::semantics::Symbol &sym = var.getSymbol();
|
||||
const mlir::Location loc = converter.genLocation(sym.name());
|
||||
if (var.isAggregateStore()) {
|
||||
TODO(loc, "instantiateVariable AggregateStore");
|
||||
instantiateAggregateStore(converter, var, storeMap);
|
||||
} else if (const Fortran::semantics::Symbol *common =
|
||||
Fortran::semantics::FindCommonBlockContaining(
|
||||
var.getSymbol().GetUltimate())) {
|
||||
instantiateCommon(converter, *common, var, symMap);
|
||||
} else if (var.isAlias()) {
|
||||
TODO(loc, "instantiateVariable Alias");
|
||||
instantiateAlias(converter, var, symMap, storeMap);
|
||||
} else if (var.isGlobal()) {
|
||||
instantiateGlobal(converter, var, symMap);
|
||||
} else {
|
||||
|
|
@ -1503,3 +1835,13 @@ void Fortran::lower::mapCallInterfaceSymbols(
|
|||
}
|
||||
}
|
||||
}
|
||||
|
||||
void Fortran::lower::createRuntimeTypeInfoGlobal(
|
||||
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
|
||||
const Fortran::semantics::Symbol &typeInfoSym) {
|
||||
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
||||
std::string globalName = Fortran::lower::mangle::mangleName(typeInfoSym);
|
||||
auto var = Fortran::lower::pft::Variable(typeInfoSym, /*global=*/true);
|
||||
mlir::StringAttr linkage = getLinkageAttribute(builder, var);
|
||||
defineGlobal(converter, var, globalName, linkage);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -105,6 +105,9 @@ static bool isAbsent(llvm::ArrayRef<fir::ExtendedValue> args, size_t argIndex) {
|
|||
return args.size() <= argIndex || isAbsent(args[argIndex]);
|
||||
}
|
||||
|
||||
/// Test if an ExtendedValue is present.
|
||||
static bool isPresent(const fir::ExtendedValue &exv) { return !isAbsent(exv); }
|
||||
|
||||
/// Process calls to Maxval, Minval, Product, Sum intrinsic functions that
|
||||
/// take a DIM argument.
|
||||
template <typename FD>
|
||||
|
|
@ -277,6 +280,7 @@ struct IntrinsicLibrary {
|
|||
mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
|
||||
mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
|
||||
fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
|
||||
fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
|
||||
fir::ExtendedValue genSize(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
|
||||
fir::ExtendedValue genSum(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
|
||||
fir::ExtendedValue genUbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
|
||||
|
|
@ -390,6 +394,7 @@ static constexpr IntrinsicHandler handlers[]{
|
|||
{"iand", &I::genIand},
|
||||
{"ibits", &I::genIbits},
|
||||
{"min", &I::genExtremum<Extremum::Min, ExtremumBehavior::MinMaxss>},
|
||||
{"null", &I::genNull, {{{"mold", asInquired}}}, /*isElemental=*/false},
|
||||
{"sum",
|
||||
&I::genSum,
|
||||
{{{"array", asBox},
|
||||
|
|
@ -1399,6 +1404,23 @@ mlir::Value IntrinsicLibrary::genExtremum(mlir::Type,
|
|||
return result;
|
||||
}
|
||||
|
||||
// NULL
|
||||
fir::ExtendedValue
|
||||
IntrinsicLibrary::genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue> args) {
|
||||
// NULL() without MOLD must be handled in the contexts where it can appear
|
||||
// (see table 16.5 of Fortran 2018 standard).
|
||||
assert(args.size() == 1 && isPresent(args[0]) &&
|
||||
"MOLD argument required to lower NULL outside of any context");
|
||||
const auto *mold = args[0].getBoxOf<fir::MutableBoxValue>();
|
||||
assert(mold && "MOLD must be a pointer or allocatable");
|
||||
fir::BoxType boxType = mold->getBoxTy();
|
||||
mlir::Value boxStorage = builder.createTemporary(loc, boxType);
|
||||
mlir::Value box = fir::factory::createUnallocatedBox(
|
||||
builder, loc, boxType, mold->nonDeferredLenParams());
|
||||
builder.create<fir::StoreOp>(loc, box, boxStorage);
|
||||
return fir::MutableBoxValue(boxStorage, mold->nonDeferredLenParams(), {});
|
||||
}
|
||||
|
||||
// SUM
|
||||
fir::ExtendedValue
|
||||
IntrinsicLibrary::genSum(mlir::Type resultType,
|
||||
|
|
|
|||
|
|
@ -31,7 +31,8 @@ void Fortran::lower::SymMap::addSymbol(Fortran::semantics::SymbolRef sym,
|
|||
}
|
||||
|
||||
Fortran::lower::SymbolBox
|
||||
Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef sym) {
|
||||
Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef symRef) {
|
||||
Fortran::semantics::SymbolRef sym = symRef.get().GetUltimate();
|
||||
for (auto jmap = symbolMapStack.rbegin(), jend = symbolMapStack.rend();
|
||||
jmap != jend; ++jmap) {
|
||||
auto iter = jmap->find(&*sym);
|
||||
|
|
@ -41,6 +42,15 @@ Fortran::lower::SymMap::lookupSymbol(Fortran::semantics::SymbolRef sym) {
|
|||
return SymbolBox::None{};
|
||||
}
|
||||
|
||||
Fortran::lower::SymbolBox Fortran::lower::SymMap::shallowLookupSymbol(
|
||||
Fortran::semantics::SymbolRef symRef) {
|
||||
auto &map = symbolMapStack.back();
|
||||
auto iter = map.find(&symRef.get().GetUltimate());
|
||||
if (iter != map.end())
|
||||
return iter->second;
|
||||
return SymbolBox::None{};
|
||||
}
|
||||
|
||||
mlir::Value
|
||||
Fortran::lower::SymMap::lookupImpliedDo(Fortran::lower::SymMap::AcDoVar var) {
|
||||
for (auto [marker, binding] : llvm::reverse(impliedDoStack))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,51 @@
|
|||
! Test lowering of nullify-statement
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test NULLIFY(p)
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
|
||||
subroutine test_scalar(p)
|
||||
real, pointer :: p
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
nullify(p)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar_char(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}})
|
||||
subroutine test_scalar_char(p)
|
||||
character(:), pointer :: p
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
nullify(p)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine test_array(p)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
nullify(p)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_list(
|
||||
! CHECK-SAME: %[[p1:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[p2:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine test_list(p1, p2)
|
||||
real, pointer :: p1, p2(:)
|
||||
! CHECK: fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: fir.store %{{.*}} to %[[p1]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
|
||||
! CHECK: fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: fir.store %{{.*}} to %[[p2]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
nullify(p1, p2)
|
||||
end subroutine
|
||||
|
|
@ -0,0 +1,356 @@
|
|||
! Test lowering of pointer assignments
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
|
||||
! Note that p => NULL() are tested in pointer-disassociate.f90
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test simple pointer assignments to contiguous right-hand side
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}}, %[[x:.*]]: !fir.ref<f32> {{{.*}}, fir.target})
|
||||
subroutine test_scalar(p, x)
|
||||
real, target :: x
|
||||
real, pointer :: p
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar_char(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target})
|
||||
subroutine test_scalar_char(p, x)
|
||||
character(*), target :: x
|
||||
character(:), pointer :: p
|
||||
! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[c]]#0 typeparams %[[c]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array(p, x)
|
||||
real, target :: x(100)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_char(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target}) {
|
||||
subroutine test_array_char(p, x)
|
||||
character(*), target :: x(100)
|
||||
character(:), pointer :: p(:)
|
||||
! CHECK: %[[c:.*]]:2 = fir.unboxchar %arg1 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
|
||||
! CHECK: %[[xaddr:.*]] = fir.convert %[[c]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<100x!fir.char<1,?>>>
|
||||
! CHECK-DAG: %[[xaddr2:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<100x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
|
||||
! CHECK-DAG: %[[shape:.*]] = fir.shape %c100{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[xaddr2]](%[[shape]]) typeparams %[[c]]#1
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! Test 10.2.2.3 point 10: lower bounds requirements:
|
||||
! pointer takes lbounds from rhs if no bounds spec.
|
||||
! CHECK-LABEL: func @_QPtest_array_with_lbs(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
subroutine test_array_with_lbs(p, x)
|
||||
real, target :: x(51:150)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %c51{{.*}}, %c100{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test pointer assignments with bound specs to contiguous right-hand side
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! Test 10.2.2.3 point 10: lower bounds requirements:
|
||||
! pointer takes lbounds from bound spec if specified
|
||||
! CHECK-LABEL: func @_QPtest_array_with_new_lbs(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
subroutine test_array_with_new_lbs(p, x)
|
||||
real, target :: x(51:150)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %c4{{.*}}, %c100{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p(4:) => x
|
||||
end subroutine
|
||||
|
||||
! Test F2018 10.2.2.3 point 9: bounds remapping
|
||||
! CHECK-LABEL: func @_QPtest_array_remap(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.ref<!fir.array<100xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array_remap(p, x)
|
||||
real, target :: x(100)
|
||||
real, pointer :: p(:, :)
|
||||
! CHECK-DAG: %[[c2_idx:.*]] = fir.convert %c2{{.*}} : (i64) -> index
|
||||
! CHECK-DAG: %[[c11_idx:.*]] = fir.convert %c11{{.*}} : (i64) -> index
|
||||
! CHECK-DAG: %[[diff0:.*]] = arith.subi %[[c11_idx]], %[[c2_idx]] : index
|
||||
! CHECK-DAG: %[[ext0:.*]] = arith.addi %[[diff0:.*]], %c1{{.*}} : index
|
||||
! CHECK-DAG: %[[c3_idx:.*]] = fir.convert %c3{{.*}} : (i64) -> index
|
||||
! CHECK-DAG: %[[c12_idx:.*]] = fir.convert %c12{{.*}} : (i64) -> index
|
||||
! CHECK-DAG: %[[diff1:.*]] = arith.subi %[[c12_idx]], %[[c3_idx]] : index
|
||||
! CHECK-DAG: %[[ext1:.*]] = arith.addi %[[diff1]], %c1{{.*}} : index
|
||||
! CHECK-DAG: %[[addrCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.array<100xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]]
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[addrCast]](%[[shape]]) : (!fir.ref<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
p(2:11, 3:12) => x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_char_remap(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>{{.*}}, %[[x:.*]]: !fir.boxchar<1> {{{.*}}, fir.target})
|
||||
subroutine test_array_char_remap(p, x)
|
||||
! CHECK: %[[unbox:.*]]:2 = fir.unboxchar %[[x]]
|
||||
character(*), target :: x(100)
|
||||
character(:), pointer :: p(:, :)
|
||||
! CHECK: subi
|
||||
! CHECK: %[[ext0:.*]] = arith.addi
|
||||
! CHECK: subi
|
||||
! CHECK: %[[ext1:.*]] = arith.addi
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %c2{{.*}}, %[[ext0]], %c3{{.*}}, %[[ext1]]
|
||||
! CHECK: %[[box:.*]] = fir.embox %{{.*}}(%[[shape]]) typeparams %[[unbox]]#1 : (!fir.ref<!fir.array<?x?x!fir.char<1,?>>>, !fir.shapeshift<2>, index) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]]
|
||||
p(2:11, 3:12) => x
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test simple pointer assignments to non contiguous right-hand side
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_rhs(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array_non_contig_rhs(p, x)
|
||||
real, target :: x(:)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[rebox:.*]] = fir.rebox %[[x]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! Test 10.2.2.3 point 10: lower bounds requirements:
|
||||
! pointer takes lbounds from rhs if no bounds spec.
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_lbs(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array_non_contig_rhs_lbs(p, x)
|
||||
real, target :: x(7:)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[c7_idx:.*]] = fir.convert %c7{{.*}} : (i64) -> index
|
||||
! CHECK: %[[shift:.*]] = fir.shift %[[c7_idx]] : (index) -> !fir.shift<1>
|
||||
! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
|
||||
! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_rhs2(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<200xf32>> {{{.*}}, fir.target}) {
|
||||
! CHECK: %[[VAL_2:.*]] = arith.constant 200 : index
|
||||
! CHECK: %[[VAL_3:.*]] = arith.constant 10 : i64
|
||||
! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
|
||||
! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64
|
||||
! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
|
||||
! CHECK: %[[VAL_7:.*]] = arith.constant 160 : i64
|
||||
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
|
||||
! CHECK: %[[VAL_9:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.slice %[[VAL_4]], %[[VAL_8]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_1]](%[[VAL_9]]) {{\[}}%[[VAL_10]]] : (!fir.ref<!fir.array<200xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.rebox %[[VAL_11]] : (!fir.box<!fir.array<?xf32>>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_12]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: return
|
||||
! CHECK: }
|
||||
|
||||
subroutine test_array_non_contig_rhs2(p, x)
|
||||
real, target :: x(200)
|
||||
real, pointer :: p(:)
|
||||
p => x(10:160:3)
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test pointer assignments with bound specs to non contiguous right-hand side
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
|
||||
! Test 10.2.2.3 point 10: lower bounds requirements:
|
||||
! pointer takes lbounds from bound spec if specified
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_rhs_new_lbs(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array_non_contig_rhs_new_lbs(p, x)
|
||||
real, target :: x(7:)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[shift:.*]] = fir.shift %c4{{.*}}
|
||||
! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shift]]) : (!fir.box<!fir.array<?xf32>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
|
||||
! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p(4:) => x
|
||||
end subroutine
|
||||
|
||||
! Test F2018 10.2.2.3 point 9: bounds remapping
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_remap(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[x:.*]]: !fir.box<!fir.array<?xf32>> {{{.*}}, fir.target})
|
||||
subroutine test_array_non_contig_remap(p, x)
|
||||
real, target :: x(:)
|
||||
real, pointer :: p(:, :)
|
||||
! CHECK: subi
|
||||
! CHECK: %[[ext0:.*]] = arith.addi
|
||||
! CHECK: subi
|
||||
! CHECK: %[[ext1:.*]] = arith.addi
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %{{.*}}, %[[ext0]], %{{.*}}, %[[ext1]]
|
||||
! CHECK: %[[rebox:.*]] = fir.rebox %[[x]](%[[shape]]) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.store %[[rebox]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
p(2:11, 3:12) => x
|
||||
end subroutine
|
||||
|
||||
! Test remapping a slice
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_non_contig_remap_slice(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<!fir.array<400xf32>> {{{.*}}, fir.target}) {
|
||||
! CHECK: %[[VAL_2:.*]] = arith.constant 400 : index
|
||||
! CHECK: %[[VAL_3:.*]] = arith.constant 2 : i64
|
||||
! CHECK: %[[VAL_4:.*]] = arith.constant 11 : i64
|
||||
! CHECK: %[[VAL_5:.*]] = arith.constant 3 : i64
|
||||
! CHECK: %[[VAL_6:.*]] = arith.constant 12 : i64
|
||||
! CHECK: %[[VAL_7:.*]] = arith.constant 51 : i64
|
||||
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
|
||||
! CHECK: %[[VAL_9:.*]] = arith.constant 3 : i64
|
||||
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
|
||||
! CHECK: %[[VAL_11:.*]] = arith.constant 350 : i64
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
|
||||
! CHECK: %[[VAL_13:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_14:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
|
||||
! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_1]](%[[VAL_13]]) {{\[}}%[[VAL_14]]] : (!fir.ref<!fir.array<400xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_16:.*]] = arith.constant 1 : index
|
||||
! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
|
||||
! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (i64) -> index
|
||||
! CHECK: %[[VAL_19:.*]] = arith.subi %[[VAL_18]], %[[VAL_17]] : index
|
||||
! CHECK: %[[VAL_20:.*]] = arith.addi %[[VAL_19]], %[[VAL_16]] : index
|
||||
! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
|
||||
! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
|
||||
! CHECK: %[[VAL_23:.*]] = arith.subi %[[VAL_22]], %[[VAL_21]] : index
|
||||
! CHECK: %[[VAL_24:.*]] = arith.addi %[[VAL_23]], %[[VAL_16]] : index
|
||||
! CHECK: %[[VAL_25:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
|
||||
! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_5]] : (i64) -> index
|
||||
! CHECK: %[[VAL_27:.*]] = fir.shape_shift %[[VAL_25]], %[[VAL_20]], %[[VAL_26]], %[[VAL_24]] : (index, index, index, index) -> !fir.shapeshift<2>
|
||||
! CHECK: %[[VAL_28:.*]] = fir.rebox %[[VAL_15]](%[[VAL_27]]) : (!fir.box<!fir.array<?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_28]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
! CHECK: return
|
||||
! CHECK: }
|
||||
subroutine test_array_non_contig_remap_slice(p, x)
|
||||
real, target :: x(400)
|
||||
real, pointer :: p(:, :)
|
||||
p(2:11, 3:12) => x(51:350:3)
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test pointer assignments that involves LHS pointers lowered to local variables
|
||||
! instead of a fir.ref<fir.box>, and RHS that are fir.box
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QPissue857(
|
||||
! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>>
|
||||
subroutine issue857(rhs)
|
||||
type t
|
||||
integer :: i
|
||||
end type
|
||||
type(t), pointer :: rhs, lhs
|
||||
! CHECK: %[[lhs:.*]] = fir.alloca !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>
|
||||
! CHECK: %[[box_load:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>>
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box_load]] : (!fir.box<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>) -> !fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>
|
||||
! CHECK: fir.store %[[addr]] to %[[lhs]] : !fir.ref<!fir.ptr<!fir.type<_QFissue857Tt{i:i32}>>>
|
||||
lhs => rhs
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPissue857_array(
|
||||
! CHECK-SAME: %[[rhs:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>>
|
||||
subroutine issue857_array(rhs)
|
||||
type t
|
||||
integer :: i
|
||||
end type
|
||||
type(t), contiguous, pointer :: rhs(:), lhs(:)
|
||||
! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>> {uniq_name = "_QFissue857_arrayElhs.addr"}
|
||||
! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.lb0"}
|
||||
! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_arrayElhs.ext0"}
|
||||
! CHECK: %[[box:.*]] = fir.load %[[rhs]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>>
|
||||
! CHECK: %[[lb:.*]]:3 = fir.box_dims %[[box]], %c{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>
|
||||
! CHECK: %[[ext:.*]]:3 = fir.box_dims %[[box]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>, index) -> (index, index, index)
|
||||
! CHECK-DAG: fir.store %[[addr]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_arrayTt{i:i32}>>>>
|
||||
! CHECK-DAG: fir.store %[[ext]]#1 to %[[lhs_ext]] : !fir.ref<index>
|
||||
! CHECK-DAG: fir.store %[[lb]]#0 to %[[lhs_lb]] : !fir.ref<index>
|
||||
lhs => rhs
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPissue857_array_shift(
|
||||
subroutine issue857_array_shift(rhs)
|
||||
! Test lower bounds is the one from the shift
|
||||
type t
|
||||
integer :: i
|
||||
end type
|
||||
type(t), contiguous, pointer :: rhs(:), lhs(:)
|
||||
! CHECK: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_shiftElhs.lb0"}
|
||||
! CHECK: %[[c42:.*]] = fir.convert %c42{{.*}} : (i64) -> index
|
||||
! CHECK: fir.store %[[c42]] to %[[lhs_lb]] : !fir.ref<index>
|
||||
lhs(42:) => rhs
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPissue857_array_remap
|
||||
subroutine issue857_array_remap(rhs)
|
||||
! Test lower bounds is the one from the shift
|
||||
type t
|
||||
integer :: i
|
||||
end type
|
||||
type(t), contiguous, pointer :: rhs(:, :), lhs(:)
|
||||
! CHECK-DAG: %[[lhs_addr:.*]] = fir.alloca !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>> {uniq_name = "_QFissue857_array_remapElhs.addr"}
|
||||
! CHECK-DAG: %[[lhs_lb:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.lb0"}
|
||||
! CHECK-DAG: %[[lhs_ext:.*]] = fir.alloca index {uniq_name = "_QFissue857_array_remapElhs.ext0"}
|
||||
|
||||
! CHECK: %[[c101:.*]] = fir.convert %c101_i64 : (i64) -> index
|
||||
! CHECK: %[[c200:.*]] = fir.convert %c200_i64 : (i64) -> index
|
||||
! CHECK: %[[sub:.*]] = arith.subi %[[c200]], %[[c101]] : index
|
||||
! CHECK: %[[extent:.*]] = arith.addi %[[sub]], %c1{{.*}} : index
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %{{.*}} : (!fir.box<!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>>) -> !fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>
|
||||
! CHECK: %[[addr_cast:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.array<?x?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>) -> !fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>
|
||||
! CHECK: fir.store %[[addr_cast]] to %[[lhs_addr]] : !fir.ref<!fir.ptr<!fir.array<?x!fir.type<_QFissue857_array_remapTt{i:i32}>>>>
|
||||
! CHECK: fir.store %[[extent]] to %[[lhs_ext]] : !fir.ref<index>
|
||||
! CHECK: %[[c101_2:.*]] = fir.convert %c101{{.*}} : (i64) -> index
|
||||
! CHECK: fir.store %[[c101_2]] to %[[lhs_lb]] : !fir.ref<index>
|
||||
lhs(101:200) => rhs
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPissue857_char
|
||||
subroutine issue857_char(rhs)
|
||||
! Only check that the length is taken from the fir.box created for the slice.
|
||||
! CHECK-DAG: %[[lhs1_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs1.len"}
|
||||
! CHECK-DAG: %[[lhs2_len:.*]] = fir.alloca index {uniq_name = "_QFissue857_charElhs2.len"}
|
||||
character(:), contiguous, pointer :: lhs1(:), lhs2(:, :)
|
||||
character(*), target :: rhs(100)
|
||||
! CHECK: %[[len:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
|
||||
! CHECK: fir.store %[[len]] to %[[lhs1_len]] : !fir.ref<index>
|
||||
lhs1 => rhs(1:50:1)
|
||||
! CHECK: %[[len2:.*]] = fir.box_elesize %{{.*}} : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
|
||||
! CHECK: fir.store %[[len2]] to %[[lhs2_len]] : !fir.ref<index>
|
||||
lhs2(1:2, 1:25) => rhs(1:50:1)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPissue1180(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {{{.*}}, fir.target}) {
|
||||
subroutine issue1180(x)
|
||||
integer, target :: x
|
||||
integer, pointer :: p
|
||||
common /some_common/ p
|
||||
! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QBsome_common) : !fir.ref<!fir.array<24xi8>>
|
||||
! CHECK: %[[VAL_2:.*]] = fir.convert %[[VAL_1]] : (!fir.ref<!fir.array<24xi8>>) -> !fir.ref<!fir.array<?xi8>>
|
||||
! CHECK: %[[VAL_3:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_3]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
|
||||
! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
|
||||
! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
|
||||
! CHECK: fir.store %[[VAL_6]] to %[[VAL_5]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
|
||||
p => x
|
||||
end subroutine
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
! Test lowering of pointer disassociation
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test p => NULL()
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
|
||||
subroutine test_scalar(p)
|
||||
real, pointer :: p
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
p => NULL()
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar_char(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{.*}})
|
||||
subroutine test_scalar_char(p)
|
||||
character(:), pointer :: p
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
p => NULL()
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine test_array(p)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => NULL()
|
||||
end subroutine
|
||||
|
||||
! Test p(lb, ub) => NULL() which is none sens but is not illegal.
|
||||
! CHECK-LABEL: func @_QPtest_array_remap(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine test_array_remap(p)
|
||||
real, pointer :: p(:)
|
||||
! CHECK: %[[null:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}}
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[null]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[box]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p(10:20) => NULL()
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test p => NULL(MOLD)
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar_mold(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{[^,]*}},
|
||||
subroutine test_scalar_mold(p, x)
|
||||
real, pointer :: p, x
|
||||
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
|
||||
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[VAL_5]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
p => NULL(x)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_scalar_char_mold(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>{{[^,]*}},
|
||||
subroutine test_scalar_char_mold(p, x)
|
||||
character(:), pointer :: p, x
|
||||
! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: %[[VAL_9:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_10:.*]] = fir.embox %[[VAL_8]] typeparams %[[VAL_9]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.store %[[VAL_10]] to %[[VAL_7]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_7]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.box_elesize %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
|
||||
! CHECK: %[[VAL_13:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_13]] typeparams %[[VAL_12]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.store %[[VAL_14]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
p => NULL(x)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPtest_array_mold(
|
||||
! CHECK-SAME: %[[p:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{[^,]*}},
|
||||
subroutine test_array_mold(p, x)
|
||||
real, pointer :: p(:), x(:)
|
||||
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_2:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_1]](%[[VAL_3]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_4]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_6:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_7:.*]]:3 = fir.box_dims %[[VAL_5]], %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[VAL_8:.*]] = fir.shift %[[VAL_7]]#0 : (index) -> !fir.shift<1>
|
||||
! CHECK: %[[VAL_9:.*]] = fir.rebox %[[VAL_5]](%[[VAL_8]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_9]] to %[[p]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
p => NULL(x)
|
||||
end subroutine
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
! Test lowering of pointer initial target
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
! This tests focus on the scope context of initial data target.
|
||||
! More complete tests regarding the initial data target expression
|
||||
! are done in pointer-initial-target.f90.
|
||||
|
||||
! Test pointer initial data target in modules
|
||||
module some_mod
|
||||
real, target :: x(100)
|
||||
real, pointer :: p(:) => x
|
||||
! CHECK-LABEL: fir.global @_QMsome_modEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QMsome_modEx) : !fir.ref<!fir.array<100xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
end module
|
||||
|
||||
! Test initial data target in a common block
|
||||
module some_mod_2
|
||||
real, target :: x(100), y(10:209)
|
||||
common /com/ x, y
|
||||
save :: /com/
|
||||
real, pointer :: p(:) => y
|
||||
! CHECK-LABEL: fir.global @_QMsome_mod_2Ep : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
|
||||
! CHECK: %[[c:.*]] = fir.address_of(@_QBcom) : !fir.ref<!fir.array<1200xi8>>
|
||||
! CHECK: %[[com:.*]] = fir.convert %[[c]] : (!fir.ref<!fir.array<1200xi8>>) -> !fir.ref<!fir.array<?xi8>>
|
||||
! CHECK: %[[yRaw:.*]] = fir.coordinate_of %[[com]], %c400{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
|
||||
! CHECK: %[[y:.*]] = fir.convert %[[yRaw]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<200xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape_shift %c10{{.*}}, %c200{{.*}} : (index, index) -> !fir.shapeshift<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[y]](%[[shape]]) : (!fir.ref<!fir.array<200xf32>>, !fir.shapeshift<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
end module
|
||||
|
||||
! Test pointer initial data target with pointer in common blocks
|
||||
block data
|
||||
real, pointer :: p
|
||||
real, save, target :: b
|
||||
common /a/ p
|
||||
data p /b/
|
||||
! CHECK-LABEL: fir.global @_QBa : tuple<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[undef:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: %[[b:.*]] = fir.address_of(@_QEb) : !fir.ref<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[b]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[a:.*]] = fir.insert_value %[[undef]], %[[box]], [0 : index] : (tuple<!fir.box<!fir.ptr<f32>>>, !fir.box<!fir.ptr<f32>>) -> tuple<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.has_value %[[a]] : tuple<!fir.box<!fir.ptr<f32>>>
|
||||
end block data
|
||||
|
||||
! Test pointer in a common with initial target in the same common.
|
||||
block data snake
|
||||
integer, target :: b = 42
|
||||
integer, pointer :: p => b
|
||||
common /snake/ p, b
|
||||
! CHECK-LABEL: fir.global @_QBsnake : tuple<!fir.box<!fir.ptr<i32>>, i32>
|
||||
! CHECK: %[[tuple0:.*]] = fir.undefined tuple<!fir.box<!fir.ptr<i32>>, i32>
|
||||
! CHECK: %[[snakeAddr:.*]] = fir.address_of(@_QBsnake) : !fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>
|
||||
! CHECK: %[[byteView:.*]] = fir.convert %[[snakeAddr:.*]] : (!fir.ref<tuple<!fir.box<!fir.ptr<i32>>, i32>>) -> !fir.ref<!fir.array<?xi8>>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[byteView]], %c24{{.*}} : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
|
||||
! CHECK: %[[bAddr:.*]] = fir.convert %[[coor]] : (!fir.ref<i8>) -> !fir.ref<i32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[bAddr]] : (!fir.ref<i32>) -> !fir.box<!fir.ptr<i32>>
|
||||
! CHECK: %[[tuple1:.*]] = fir.insert_value %[[tuple0]], %[[box]], [0 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, !fir.box<!fir.ptr<i32>>) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
|
||||
! CHECK: %[[tuple2:.*]] = fir.insert_value %[[tuple1]], %c42{{.*}}, [1 : index] : (tuple<!fir.box<!fir.ptr<i32>>, i32>, i32) -> tuple<!fir.box<!fir.ptr<i32>>, i32>
|
||||
! CHECK: fir.has_value %[[tuple2]] : tuple<!fir.box<!fir.ptr<i32>>, i32>
|
||||
end block data
|
||||
|
||||
! Test two common depending on each others because of initial data
|
||||
! targets
|
||||
block data tied
|
||||
real, target :: x1 = 42
|
||||
real, target :: x2 = 43
|
||||
real, pointer :: p1 => x2
|
||||
real, pointer :: p2 => x1
|
||||
common /c1/ x1, p1
|
||||
common /c2/ x2, p2
|
||||
! CHECK-LABEL: fir.global @_QBc1 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.address_of(@_QBc2) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
|
||||
! CHECK-LABEL: fir.global @_QBc2 : tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.address_of(@_QBc1) : !fir.ref<tuple<f32, !fir.array<4xi8>, !fir.box<!fir.ptr<f32>>>>
|
||||
end block data
|
||||
|
|
@ -0,0 +1,186 @@
|
|||
! Test lowering of pointer initial target
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test scalar initial data target that are simple names
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
subroutine scalar()
|
||||
real, save, target :: x
|
||||
real, pointer :: p => x
|
||||
! CHECK-LABEL: fir.global internal @_QFscalarEp : !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalarEx) : !fir.ref<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
|
||||
end subroutine
|
||||
|
||||
subroutine scalar_char()
|
||||
character(10), save, target :: x
|
||||
character(:), pointer :: p => x
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_charEp : !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_charEx) : !fir.ref<!fir.char<1,10>>
|
||||
! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[xCast]] typeparams %c10{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
end subroutine
|
||||
|
||||
subroutine scalar_char_2()
|
||||
character(10), save, target :: x
|
||||
character(10), pointer :: p => x
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_char_2Ep : !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_2Ex) : !fir.ref<!fir.char<1,10>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
end subroutine
|
||||
|
||||
subroutine scalar_derived()
|
||||
type t
|
||||
real :: x
|
||||
integer :: i
|
||||
end type
|
||||
type(t), save, target :: x
|
||||
type(t), pointer :: p => x
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_derivedEp : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_derivedEx) : !fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>) -> !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.type<_QFscalar_derivedTt{x:f32,i:i32}>>>
|
||||
end subroutine
|
||||
|
||||
subroutine scalar_null()
|
||||
real, pointer :: p => NULL()
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_nullEp : !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[zero]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test array initial data target that are simple names
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
subroutine array()
|
||||
real, save, target :: x(100)
|
||||
real, pointer :: p(:) => x
|
||||
! CHECK-LABEL: fir.global internal @_QFarrayEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFarrayEx) : !fir.ref<!fir.array<100xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
end subroutine
|
||||
|
||||
subroutine array_char()
|
||||
character(10), save, target :: x(20)
|
||||
character(:), pointer :: p(:) => x
|
||||
! CHECK-LABEL: fir.global internal @_QFarray_charEp : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_charEx) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[xCast:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.array<20x!fir.char<1,10>>>) -> !fir.ptr<!fir.array<?x!fir.char<1,?>>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[xCast]](%[[shape]]) typeparams %c10{{.*}} : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
|
||||
end subroutine
|
||||
|
||||
subroutine array_char_2()
|
||||
character(10), save, target :: x(20)
|
||||
character(10), pointer :: p(:) => x
|
||||
! CHECK-LABEL: fir.global internal @_QFarray_char_2Ep : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_char_2Ex) : !fir.ref<!fir.array<20x!fir.char<1,10>>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c20{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<20x!fir.char<1,10>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,10>>>>
|
||||
end subroutine
|
||||
|
||||
subroutine array_derived()
|
||||
type t
|
||||
real :: x
|
||||
integer :: i
|
||||
end type
|
||||
type(t), save, target :: x(100)
|
||||
type(t), pointer :: p(:) => x
|
||||
! CHECK-LABEL: fir.global internal @_QFarray_derivedEp : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFarray_derivedEx) : !fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c100{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[x]](%[[shape]]) : (!fir.ref<!fir.array<100x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?x!fir.type<_QFarray_derivedTt{x:f32,i:i32}>>>>
|
||||
end subroutine
|
||||
|
||||
subroutine array_null()
|
||||
real, pointer :: p(:) => NULL()
|
||||
! CHECK-LABEL: fir.global internal @_QFarray_nullEp : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[shape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[zero]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test scalar initial data target that are data references
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
subroutine scalar_ref()
|
||||
real, save, target :: x(4:100)
|
||||
real, pointer :: p => x(50)
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_refEp : !fir.box<!fir.ptr<f32>> {
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_refEx) : !fir.ref<!fir.array<97xf32>>
|
||||
! CHECK: %[[lb:.*]] = fir.convert %c4 : (index) -> i64
|
||||
! CHECK: %[[idx:.*]] = arith.subi %c50{{.*}}, %[[lb]] : i64
|
||||
! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<97xf32>>, i64) -> !fir.ref<f32>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[elt]] : (!fir.ref<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<f32>>
|
||||
end subroutine
|
||||
|
||||
subroutine scalar_char_ref()
|
||||
character(20), save, target :: x(100)
|
||||
character(10), pointer :: p => x(6)(7:16)
|
||||
! CHECK-LABEL: fir.global internal @_QFscalar_char_refEp : !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
! CHECK: %[[x:.*]] = fir.address_of(@_QFscalar_char_refEx) : !fir.ref<!fir.array<100x!fir.char<1,20>>>
|
||||
! CHECK: %[[idx:.*]] = arith.subi %c6{{.*}}, %c1{{.*}} : i64
|
||||
! CHECK: %[[elt:.*]] = fir.coordinate_of %[[x]], %[[idx]] : (!fir.ref<!fir.array<100x!fir.char<1,20>>>, i64) -> !fir.ref<!fir.char<1,20>>
|
||||
! CHECK: %[[eltCast:.*]] = fir.convert %[[elt:.*]] : (!fir.ref<!fir.char<1,20>>) -> !fir.ref<!fir.array<20x!fir.char<1>>>
|
||||
! CHECK: %[[coor:.*]] = fir.coordinate_of %[[eltCast]], %{{.*}} : (!fir.ref<!fir.array<20x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
|
||||
! CHECK: %[[substring:.*]] = fir.convert %[[coor]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
|
||||
! CHECK: %[[substringCast:.*]] = fir.convert %[[substring]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ptr<!fir.char<1,10>>
|
||||
! CHECK: %[[box:.*]] = fir.embox %[[substringCast]] : (!fir.ptr<!fir.char<1,10>>) -> !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
! CHECK: fir.has_value %[[box]] : !fir.box<!fir.ptr<!fir.char<1,10>>>
|
||||
end subroutine
|
||||
|
||||
! -----------------------------------------------------------------------------
|
||||
! Test array initial data target that are data references
|
||||
! -----------------------------------------------------------------------------
|
||||
|
||||
|
||||
subroutine array_ref()
|
||||
real, save, target :: x(4:103, 5:104)
|
||||
real, pointer :: p(:) => x(10, 20:100:2)
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: fir.global internal @_QFarray_refEp : !fir.box<!fir.ptr<!fir.array<?xf32>>> {
|
||||
! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFarray_refEx) : !fir.ref<!fir.array<100x100xf32>>
|
||||
! CHECK: %[[VAL_1:.*]] = arith.constant 4 : index
|
||||
! CHECK: %[[VAL_2:.*]] = arith.constant 100 : index
|
||||
! CHECK: %[[VAL_3:.*]] = arith.constant 5 : index
|
||||
! CHECK: %[[VAL_4:.*]] = arith.constant 100 : index
|
||||
! CHECK: %[[VAL_5:.*]] = arith.constant 1 : index
|
||||
! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index
|
||||
! CHECK: %[[VAL_7:.*]] = arith.constant 10 : i64
|
||||
! CHECK: %[[VAL_8:.*]] = fir.undefined index
|
||||
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
|
||||
! CHECK: %[[VAL_10:.*]] = arith.subi %[[VAL_9]], %[[VAL_1]] : index
|
||||
! CHECK: %[[VAL_11:.*]] = arith.constant 20 : i64
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
|
||||
! CHECK: %[[VAL_13:.*]] = arith.constant 2 : i64
|
||||
! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i64) -> index
|
||||
! CHECK: %[[VAL_15:.*]] = arith.constant 100 : i64
|
||||
! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i64) -> index
|
||||
! CHECK: %[[VAL_17:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_18:.*]] = arith.subi %[[VAL_16]], %[[VAL_12]] : index
|
||||
! CHECK: %[[VAL_19:.*]] = arith.addi %[[VAL_18]], %[[VAL_14]] : index
|
||||
! CHECK: %[[VAL_20:.*]] = arith.divsi %[[VAL_19]], %[[VAL_14]] : index
|
||||
! CHECK: %[[VAL_21:.*]] = arith.cmpi sgt, %[[VAL_20]], %[[VAL_17]] : index
|
||||
! CHECK: %[[VAL_22:.*]] = arith.select %[[VAL_21]], %[[VAL_20]], %[[VAL_17]] : index
|
||||
! CHECK: %[[VAL_23:.*]] = fir.shape_shift %[[VAL_1]], %[[VAL_2]], %[[VAL_3]], %[[VAL_4]] : (index, index, index, index) -> !fir.shapeshift<2>
|
||||
! CHECK: %[[VAL_24:.*]] = fir.slice %[[VAL_7]], %[[VAL_8]], %[[VAL_8]], %[[VAL_12]], %[[VAL_16]], %[[VAL_14]] : (i64, index, index, index, index, index) -> !fir.slice<2>
|
||||
! CHECK: %[[VAL_25:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref<!fir.array<100x100xf32>>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_26:.*]] = fir.embox %[[VAL_0]](%[[VAL_23]]) {{\[}}%[[VAL_24]]] : (!fir.ref<!fir.array<100x100xf32>>, !fir.shapeshift<2>, !fir.slice<2>) -> !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: fir.has_value %[[VAL_26]] : !fir.box<!fir.ptr<!fir.array<?xf32>>>
|
||||
! CHECK: }
|
||||
|
||||
|
|
@ -0,0 +1,180 @@
|
|||
! Test lowering of references to pointers
|
||||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
! Assigning/reading to scalar pointer target.
|
||||
! CHECK-LABEL: func @_QPscal_ptr(
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<f32>>>{{.*}})
|
||||
subroutine scal_ptr(p)
|
||||
real, pointer :: p
|
||||
real :: x
|
||||
! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
|
||||
! CHECK: fir.store %{{.*}} to %[[addr]]
|
||||
p = 3.
|
||||
|
||||
! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
|
||||
! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
|
||||
! CHECK: %[[val:.*]] = fir.load %[[addr2]]
|
||||
! CHECK: fir.store %[[val]] to %{{.*}}
|
||||
x = p
|
||||
end subroutine
|
||||
|
||||
! Assigning/reading scalar character pointer target.
|
||||
! CHECK-LABEL: func @_QPchar_ptr(
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,12>>>>{{.*}})
|
||||
subroutine char_ptr(p)
|
||||
character(12), pointer :: p
|
||||
character(12) :: x
|
||||
|
||||
! CHECK-DAG: %[[str:.*]] = fir.address_of(@_QQcl.68656C6C6F20776F726C6421) : !fir.ref<!fir.char<1,12>>
|
||||
! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
|
||||
! CHECK: %[[addr:.*]] = fir.box_addr %[[boxload]]
|
||||
! CHECK-DAG: %[[one:.*]] = arith.constant 1
|
||||
! CHECK-DAG: %[[size:.*]] = fir.convert %{{.*}} : (index) -> i64
|
||||
! CHECK: %[[count:.*]] = arith.muli %[[one]], %[[size]] : i64
|
||||
! CHECK: %[[dst:.*]] = fir.convert %[[addr]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
|
||||
! CHECK: %[[src:.*]] = fir.convert %[[str]] : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
|
||||
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %5, %false) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
|
||||
p = "hello world!"
|
||||
|
||||
! CHECK: %[[boxload2:.*]] = fir.load %[[arg0]]
|
||||
! CHECK: %[[addr2:.*]] = fir.box_addr %[[boxload2]]
|
||||
! CHECK: %[[count:.*]] = arith.muli %{{.*}}, %{{.*}} : i64
|
||||
! CHECK: %[[dst:.*]] = fir.convert %{{.*}} : (!fir.ref<!fir.char<1,12>>) -> !fir.ref<i8>
|
||||
! CHECK: %[[src:.*]] = fir.convert %[[addr2]] : (!fir.ptr<!fir.char<1,12>>) -> !fir.ref<i8>
|
||||
! CHECK: fir.call @llvm.memmove.p0i8.p0i8.i64(%[[dst]], %[[src]], %[[count]], %{{.*}}) : (!fir.ref<i8>, !fir.ref<i8>, i64, i1) -> ()
|
||||
x = p
|
||||
end subroutine
|
||||
|
||||
! Reading from pointer in array expression
|
||||
! CHECK-LABEL: func @_QParr_ptr_read(
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}})
|
||||
subroutine arr_ptr_read(p)
|
||||
real, pointer :: p(:)
|
||||
real :: x(100)
|
||||
! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
|
||||
! CHECK: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[lb:.*]] = fir.shift %[[dims]]#0 : (index) -> !fir.shift<1>
|
||||
! CHECK: fir.array_load %[[boxload]](%[[lb]]) : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>) -> !fir.array<?xf32>
|
||||
x = p
|
||||
end subroutine
|
||||
|
||||
! Reading from contiguous pointer in array expression
|
||||
! CHECK-LABEL: func @_QParr_contig_ptr_read(
|
||||
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous})
|
||||
subroutine arr_contig_ptr_read(p)
|
||||
real, pointer, contiguous :: p(:)
|
||||
real :: x(100)
|
||||
! CHECK: %[[boxload:.*]] = fir.load %[[arg0]]
|
||||
! CHECK-DAG: %[[dims:.*]]:3 = fir.box_dims %[[boxload]], %c0{{.*}} : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK-DAG: %[[addr:.*]] = fir.box_addr %[[boxload]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK-DAG: %[[shape:.*]] = fir.shape_shift %[[dims]]#0, %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
|
||||
! CHECK: fir.array_load %[[addr]](%[[shape]]) : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>) -> !fir.array<?xf32>
|
||||
x = p
|
||||
end subroutine
|
||||
|
||||
! Assigning to pointer target in array expression
|
||||
|
||||
! CHECK-LABEL: func @_QParr_ptr_target_write(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>{{.*}}) {
|
||||
! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index
|
||||
! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_ptr_target_writeEx"}
|
||||
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[VAL_6:.*]] = arith.constant 2 : i64
|
||||
! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
|
||||
! CHECK: %[[VAL_8:.*]] = arith.constant 6 : i64
|
||||
! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
|
||||
! CHECK: %[[VAL_10:.*]] = arith.constant 601 : i64
|
||||
! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i64) -> index
|
||||
! CHECK: %[[VAL_12:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_13:.*]] = arith.subi %[[VAL_11]], %[[VAL_7]] : index
|
||||
! CHECK: %[[VAL_14:.*]] = arith.addi %[[VAL_13]], %[[VAL_9]] : index
|
||||
! CHECK: %[[VAL_15:.*]] = arith.divsi %[[VAL_14]], %[[VAL_9]] : index
|
||||
! CHECK: %[[VAL_16:.*]] = arith.cmpi sgt, %[[VAL_15]], %[[VAL_12]] : index
|
||||
! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_16]], %[[VAL_15]], %[[VAL_12]] : index
|
||||
! CHECK: %[[VAL_18:.*]] = fir.shift %[[VAL_5]]#0 : (index) -> !fir.shift<1>
|
||||
! CHECK: %[[VAL_19:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1>
|
||||
! CHECK: %[[VAL_20:.*]] = fir.array_load %[[VAL_3]](%[[VAL_18]]) {{\[}}%[[VAL_19]]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.shift<1>, !fir.slice<1>) -> !fir.array<?xf32>
|
||||
! CHECK: %[[VAL_21:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_22:.*]] = fir.array_load %[[VAL_2]](%[[VAL_21]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
|
||||
! CHECK: %[[VAL_23:.*]] = arith.constant 1 : index
|
||||
! CHECK: %[[VAL_24:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_25:.*]] = arith.subi %[[VAL_17]], %[[VAL_23]] : index
|
||||
! CHECK: %[[VAL_26:.*]] = fir.do_loop %[[VAL_27:.*]] = %[[VAL_24]] to %[[VAL_25]] step %[[VAL_23]] unordered iter_args(%[[VAL_28:.*]] = %[[VAL_20]]) -> (!fir.array<?xf32>) {
|
||||
! CHECK: %[[VAL_29:.*]] = fir.array_fetch %[[VAL_22]], %[[VAL_27]] : (!fir.array<100xf32>, index) -> f32
|
||||
! CHECK: %[[VAL_30:.*]] = fir.array_update %[[VAL_28]], %[[VAL_29]], %[[VAL_27]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
|
||||
! CHECK: fir.result %[[VAL_30]] : !fir.array<?xf32>
|
||||
! CHECK: }
|
||||
! CHECK: fir.array_merge_store %[[VAL_20]], %[[VAL_31:.*]] to %[[VAL_3]]{{\[}}%[[VAL_19]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.box<!fir.ptr<!fir.array<?xf32>>>, !fir.slice<1>
|
||||
! CHECK: return
|
||||
! CHECK: }
|
||||
|
||||
subroutine arr_ptr_target_write(p)
|
||||
real, pointer :: p(:)
|
||||
real :: x(100)
|
||||
p(2:601:6) = x
|
||||
end subroutine
|
||||
|
||||
! Assigning to contiguous pointer target in array expression
|
||||
|
||||
! CHECK-LABEL: func @_QParr_contig_ptr_target_write(
|
||||
! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>> {{{.*}}, fir.contiguous}) {
|
||||
! CHECK: %[[VAL_1:.*]] = arith.constant 100 : index
|
||||
! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.array<100xf32> {bindc_name = "x", uniq_name = "_QFarr_contig_ptr_target_writeEx"}
|
||||
! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xf32>>>>
|
||||
! CHECK: %[[VAL_4:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_5:.*]]:3 = fir.box_dims %[[VAL_3]], %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>, index) -> (index, index, index)
|
||||
! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_3]] : (!fir.box<!fir.ptr<!fir.array<?xf32>>>) -> !fir.ptr<!fir.array<?xf32>>
|
||||
! CHECK: %[[VAL_7:.*]] = arith.constant 2 : i64
|
||||
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (i64) -> index
|
||||
! CHECK: %[[VAL_9:.*]] = arith.constant 6 : i64
|
||||
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
|
||||
! CHECK: %[[VAL_11:.*]] = arith.constant 601 : i64
|
||||
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i64) -> index
|
||||
! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_14:.*]] = arith.subi %[[VAL_12]], %[[VAL_8]] : index
|
||||
! CHECK: %[[VAL_15:.*]] = arith.addi %[[VAL_14]], %[[VAL_10]] : index
|
||||
! CHECK: %[[VAL_16:.*]] = arith.divsi %[[VAL_15]], %[[VAL_10]] : index
|
||||
! CHECK: %[[VAL_17:.*]] = arith.cmpi sgt, %[[VAL_16]], %[[VAL_13]] : index
|
||||
! CHECK: %[[VAL_18:.*]] = arith.select %[[VAL_17]], %[[VAL_16]], %[[VAL_13]] : index
|
||||
! CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_5]]#0, %[[VAL_5]]#1 : (index, index) -> !fir.shapeshift<1>
|
||||
! CHECK: %[[VAL_20:.*]] = fir.slice %[[VAL_8]], %[[VAL_12]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
|
||||
! CHECK: %[[VAL_21:.*]] = fir.array_load %[[VAL_6]](%[[VAL_19]]) {{\[}}%[[VAL_20]]] : (!fir.ptr<!fir.array<?xf32>>, !fir.shapeshift<1>, !fir.slice<1>) -> !fir.array<?xf32>
|
||||
! CHECK: %[[VAL_22:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
|
||||
! CHECK: %[[VAL_23:.*]] = fir.array_load %[[VAL_2]](%[[VAL_22]]) : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>) -> !fir.array<100xf32>
|
||||
! CHECK: %[[VAL_24:.*]] = arith.constant 1 : index
|
||||
! CHECK: %[[VAL_25:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_26:.*]] = arith.subi %[[VAL_18]], %[[VAL_24]] : index
|
||||
! CHECK: %[[VAL_27:.*]] = fir.do_loop %[[VAL_28:.*]] = %[[VAL_25]] to %[[VAL_26]] step %[[VAL_24]] unordered iter_args(%[[VAL_29:.*]] = %[[VAL_21]]) -> (!fir.array<?xf32>) {
|
||||
! CHECK: %[[VAL_30:.*]] = fir.array_fetch %[[VAL_23]], %[[VAL_28]] : (!fir.array<100xf32>, index) -> f32
|
||||
! CHECK: %[[VAL_31:.*]] = fir.array_update %[[VAL_29]], %[[VAL_30]], %[[VAL_28]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
|
||||
! CHECK: fir.result %[[VAL_31]] : !fir.array<?xf32>
|
||||
! CHECK: }
|
||||
! CHECK: fir.array_merge_store %[[VAL_21]], %[[VAL_32:.*]] to %[[VAL_6]]{{\[}}%[[VAL_20]]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.ptr<!fir.array<?xf32>>, !fir.slice<1>
|
||||
! CHECK: return
|
||||
! CHECK: }
|
||||
|
||||
subroutine arr_contig_ptr_target_write(p)
|
||||
real, pointer, contiguous :: p(:)
|
||||
real :: x(100)
|
||||
p(2:601:6) = x
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: func @_QPpointer_result_as_value
|
||||
subroutine pointer_result_as_value()
|
||||
! Test that function pointer results used as values are correctly loaded.
|
||||
interface
|
||||
function returns_int_pointer()
|
||||
integer, pointer :: returns_int_pointer
|
||||
end function
|
||||
end interface
|
||||
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = ".result"}
|
||||
! CHECK: %[[VAL_6:.*]] = fir.call @_QPreturns_int_pointer() : () -> !fir.box<!fir.ptr<i32>>
|
||||
! CHECK: fir.save_result %[[VAL_6]] to %[[VAL_0]] : !fir.box<!fir.ptr<i32>>, !fir.ref<!fir.box<!fir.ptr<i32>>>
|
||||
! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
|
||||
! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
|
||||
! CHECK: fir.load %[[VAL_8]] : !fir.ptr<i32>
|
||||
print *, returns_int_pointer()
|
||||
end subroutine
|
||||
|
|
@ -0,0 +1,85 @@
|
|||
! Test passing pointers results to pointer dummy arguments
|
||||
! RUN: bbc %s -o - | FileCheck %s
|
||||
|
||||
module presults
|
||||
interface
|
||||
subroutine bar_scalar(x)
|
||||
real, pointer :: x
|
||||
end subroutine
|
||||
subroutine bar(x)
|
||||
real, pointer :: x(:, :)
|
||||
end subroutine
|
||||
function get_scalar_pointer()
|
||||
real, pointer :: get_scalar_pointer
|
||||
end function
|
||||
function get_pointer()
|
||||
real, pointer :: get_pointer(:, :)
|
||||
end function
|
||||
end interface
|
||||
real, pointer :: x
|
||||
real, pointer :: xa(:, :)
|
||||
contains
|
||||
|
||||
! CHECK-LABEL: test_scalar_null
|
||||
subroutine test_scalar_null()
|
||||
! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[VAL_1:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[VAL_2]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.call @_QPbar_scalar(%[[VAL_0]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
|
||||
call bar_scalar(null())
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: test_scalar_null_mold
|
||||
subroutine test_scalar_null_mold()
|
||||
! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<f32>
|
||||
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<f32>) -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.call @_QPbar_scalar(%[[VAL_3]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
|
||||
call bar_scalar(null(x))
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: test_scalar_result
|
||||
subroutine test_scalar_result()
|
||||
! CHECK: %[[VAL_6:.*]] = fir.alloca !fir.box<!fir.ptr<f32>> {bindc_name = ".result"}
|
||||
! CHECK: %[[VAL_7:.*]] = fir.call @_QPget_scalar_pointer() : () -> !fir.box<!fir.ptr<f32>>
|
||||
! CHECK: fir.save_result %[[VAL_7]] to %[[VAL_6]] : !fir.box<!fir.ptr<f32>>, !fir.ref<!fir.box<!fir.ptr<f32>>>
|
||||
! CHECK: fir.call @_QPbar_scalar(%[[VAL_6]]) : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> ()
|
||||
call bar_scalar(get_scalar_pointer())
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: test_null
|
||||
subroutine test_null()
|
||||
! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xf32>>
|
||||
! CHECK: %[[VAL_11:.*]] = fir.shape %[[VAL_8]], %[[VAL_8]] : (index, index) -> !fir.shape<2>
|
||||
! CHECK: %[[VAL_12:.*]] = fir.embox %[[VAL_10]](%[[VAL_11]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_12]] to %[[VAL_9]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
! CHECK: fir.call @_QPbar(%[[VAL_9]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
|
||||
call bar(null())
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: test_null_mold
|
||||
subroutine test_null_mold()
|
||||
! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index
|
||||
! CHECK: %[[VAL_14:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: %[[VAL_15:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x?xf32>>
|
||||
! CHECK: %[[VAL_16:.*]] = fir.shape %[[VAL_13]], %[[VAL_13]] : (index, index) -> !fir.shape<2>
|
||||
! CHECK: %[[VAL_17:.*]] = fir.embox %[[VAL_15]](%[[VAL_16]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.store %[[VAL_17]] to %[[VAL_14]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
! CHECK: fir.call @_QPbar(%[[VAL_14]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
|
||||
call bar(null(xa))
|
||||
end subroutine
|
||||
|
||||
! CHECK-LABEL: test_result
|
||||
subroutine test_result()
|
||||
! CHECK: %[[VAL_18:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x?xf32>>> {bindc_name = ".result"}
|
||||
! CHECK: %[[VAL_19:.*]] = fir.call @_QPget_pointer() : () -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
|
||||
! CHECK: fir.save_result %[[VAL_19]] to %[[VAL_18]] : !fir.box<!fir.ptr<!fir.array<?x?xf32>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
|
||||
! CHECK: fir.call @_QPbar(%[[VAL_18]]) : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>) -> ()
|
||||
call bar(get_pointer())
|
||||
end subroutine
|
||||
|
||||
end module
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
! RUN: bbc -emit-fir -use-alloc-runtime %s -o - | FileCheck %s
|
||||
|
||||
! Test lowering of allocatables using runtime for allocate/deallocate statements.
|
||||
! CHECK-LABEL: _QPpointer_runtime(
|
||||
subroutine pointer_runtime(n)
|
||||
integer :: n
|
||||
character(:), pointer :: scalar, array(:)
|
||||
! CHECK-DAG: %[[sBoxAddr:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>> {{{.*}}uniq_name = "_QFpointer_runtimeEscalar"}
|
||||
! CHECK-DAG: %[[sNullAddr:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK-DAG: %[[sInitBox:.*]] = fir.embox %[[sNullAddr]] typeparams %c0{{.*}} : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
|
||||
! CHECK-DAG: fir.store %[[sInitBox]] to %[[sBoxAddr]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
|
||||
|
||||
! CHECK-DAG: %[[aBoxAddr:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>> {{{.*}}uniq_name = "_QFpointer_runtimeEarray"}
|
||||
! CHECK-DAG: %[[aNullAddr:.*]] = fir.zero_bits !fir.ptr<!fir.array<?x!fir.char<1,?>>>
|
||||
! CHECK-DAG: %[[aNullShape:.*]] = fir.shape %c0{{.*}} : (index) -> !fir.shape<1>
|
||||
! CHECK-DAG: %[[aInitBox:.*]] = fir.embox %[[aNullAddr]](%[[aNullShape]]) typeparams %c0{{.*}} : (!fir.ptr<!fir.array<?x!fir.char<1,?>>>, !fir.shape<1>, index) -> !fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>
|
||||
! CHECK-DAG: fir.store %[[aInitBox]] to %[[aBoxAddr]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>
|
||||
|
||||
allocate(character(10):: scalar, array(30))
|
||||
! CHECK-DAG: %[[sBoxCast1:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK-DAG: %[[ten1:.*]] = fir.convert %c10{{.*}} : (i32) -> i64
|
||||
! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast1]], %[[ten1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}})
|
||||
! CHECK-NOT: PointerSetBounds
|
||||
! CHECK: %[[sBoxCast2:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerAllocate(%[[sBoxCast2]]
|
||||
|
||||
! CHECK-DAG: %[[aBoxCast1:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK-DAG: %[[ten2:.*]] = fir.convert %c10{{.*}} : (i32) -> i64
|
||||
! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast1]], %[[ten2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}})
|
||||
! CHECK: %[[aBoxCast2:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerSetBounds(%[[aBoxCast2]]
|
||||
! CHECK: %[[aBoxCast3:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerAllocate(%[[aBoxCast3]]
|
||||
|
||||
deallocate(scalar, array)
|
||||
! CHECK: %[[sBoxCast3:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerDeallocate(%[[sBoxCast3]]
|
||||
! CHECK: %[[aBoxCast4:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerDeallocate(%[[aBoxCast4]]
|
||||
|
||||
! only testing that the correct length is set in the descriptor.
|
||||
allocate(character(n):: scalar, array(40))
|
||||
! CHECK: %[[n:.*]] = fir.load %arg0 : !fir.ref<i32>
|
||||
! CHECK-DAG: %[[ncast1:.*]] = fir.convert %[[n]] : (i32) -> i64
|
||||
! CHECK-DAG: %[[sBoxCast4:.*]] = fir.convert %[[sBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[sBoxCast4]], %[[ncast1]], %c1{{.*}}, %c0{{.*}}, %c0{{.*}})
|
||||
! CHECK-DAG: %[[ncast2:.*]] = fir.convert %[[n]] : (i32) -> i64
|
||||
! CHECK-DAG: %[[aBoxCast5:.*]] = fir.convert %[[aBoxAddr]] : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?x!fir.char<1,?>>>>>) -> !fir.ref<!fir.box<none>>
|
||||
! CHECK: fir.call @{{.*}}PointerNullifyCharacter(%[[aBoxCast5]], %[[ncast2]], %c1{{.*}}, %c1{{.*}}, %c0{{.*}})
|
||||
end subroutine
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
! RUN: bbc -emit-fir %s -o - | FileCheck %s
|
||||
|
||||
! TODO: Descriptor (fir.box) will most likely be used for pointers
|
||||
! (at least for the character case below). This code is hitting a
|
||||
! hard todo until pointers are handled correctly.
|
||||
! XFAIL: true
|
||||
|
||||
! CHECK-LABEL: func @_QPpointertests
|
||||
subroutine pointerTests
|
||||
! CHECK: fir.global internal @_QFpointertestsEptr1 : !fir.ptr<i32>
|
||||
integer, pointer :: ptr1 => NULL()
|
||||
! CHECK: %[[c0:.*]] = arith.constant 0 : index
|
||||
! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
|
||||
! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<i32>
|
||||
! CHECK: fir.has_value [[reg2]] : !fir.ptr<i32>
|
||||
|
||||
! CHECK: fir.global internal @_QFpointertestsEptr2 : !fir.ptr<f32>
|
||||
real, pointer :: ptr2 => NULL()
|
||||
! CHECK: %[[c0:.*]] = arith.constant 0 : index
|
||||
! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
|
||||
! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<f32>
|
||||
! CHECK: fir.has_value [[reg2]] : !fir.ptr<f32>
|
||||
|
||||
! CHECK: fir.global internal @_QFpointertestsEptr3 : !fir.ptr<!fir.complex<4>>
|
||||
complex, pointer :: ptr3 => NULL()
|
||||
! CHECK: %[[c0:.*]] = arith.constant 0 : index
|
||||
! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
|
||||
! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.complex<4>>
|
||||
! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.complex<4>>
|
||||
|
||||
! CHECK: fir.global internal @_QFpointertestsEptr4 : !fir.ptr<!fir.char<1,?>>
|
||||
character(:), pointer :: ptr4 => NULL()
|
||||
! CHECK: %[[c0:.*]] = arith.constant 0 : index
|
||||
! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
|
||||
! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.char<1,?>>
|
||||
! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.char<1,?>>
|
||||
|
||||
! CHECK: fir.global internal @_QFpointertestsEptr5 : !fir.ptr<!fir.logical<4>>
|
||||
logical, pointer :: ptr5 => NULL()
|
||||
! CHECK: %[[c0:.*]] = arith.constant 0 : index
|
||||
! CHECK: [[reg1:%[0-9]+]] = fir.convert %[[c0:.*]] : (index) -> !fir.ref<none>
|
||||
! CHECK: [[reg2:%[0-9]+]] = fir.convert [[reg1]] : (!fir.ref<none>) -> !fir.ptr<!fir.logical<4>>
|
||||
! CHECK: fir.has_value [[reg2]] : !fir.ptr<!fir.logical<4>>
|
||||
|
||||
end subroutine pointerTests
|
||||
Loading…
Reference in New Issue