[flang-commits] [flang] [flang] Fix lowering of host associated cray pointee symbols (PR #86121)
via flang-commits
flang-commits at lists.llvm.org
Thu Mar 21 07:11:08 PDT 2024
https://github.com/jeanPerier created https://github.com/llvm/llvm-project/pull/86121
Cray pointee symbols can be host associated from a module or host procedure while the related cray pointer is not explicitly associated.
This caused the "not yet implemented: lowering symbol to HLFIR" to fire when lowering a reference to the cray pointee and fetching the cray pointer.
This patch:
- Ensures cray pointers are always instantiated when instantiating a cray pointee.
- Fix internal procedure lowering to deal with cray pointee host association like it does for pointers (the lowering strategy for cray pointee is to create a pointer that is updated with the cray pointer value before being fetched).
This should fix the bug reported in https://github.com/llvm/llvm-project/issues/85420.
>From f60da363416523c14eb5436b1c6577b9b374b4ce Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier at nvidia.com>
Date: Thu, 21 Mar 2024 07:02:20 -0700
Subject: [PATCH] [flang] Fix lowering of host associated cray pointee symbols
Cray pointee symbols can be host associated from a module or host
procedure while the related cray pointer is not explicitly
associated.
This caused the "not yet implemented: lowering symbol to HLFIR"
to fire when lowering a reference to the cray pointee and fetching
the cray pointer.
This patch:
- Ensures cray pointers are always instantiated when instantiating
a cray pointee.
- Fix internal procedure lowering to deal with cray pointee host
association like it does for pointers (the lowering strategy for
cray pointee is to create a pointer that is updated with the
cray pointer value before being fetched).
This should fix the bug reported in https://github.com/llvm/llvm-project/issues/85420.
---
flang/include/flang/Lower/ConvertVariable.h | 6 +-
flang/include/flang/Semantics/tools.h | 3 +
flang/lib/Lower/Bridge.cpp | 5 +-
flang/lib/Lower/ConvertExpr.cpp | 10 +-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 9 +-
flang/lib/Lower/ConvertVariable.cpp | 48 ++++-----
flang/lib/Lower/HostAssociations.cpp | 9 +-
flang/lib/Lower/PFTBuilder.cpp | 9 ++
flang/lib/Semantics/tools.cpp | 12 +++
flang/test/Lower/HLFIR/cray-pointers.f90 | 114 ++++++++++++++++++--
flang/test/Lower/cray-pointer.f90 | 4 +-
11 files changed, 176 insertions(+), 53 deletions(-)
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index ab30e317d1d9d4..d70d3268acac13 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -161,9 +161,9 @@ void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
fir::FortranVariableFlagsEnum::None,
bool force = false);
-/// For the given Cray pointee symbol return the corresponding
-/// Cray pointer symbol. Assert if the pointer symbol cannot be found.
-Fortran::semantics::SymbolRef getCrayPointer(Fortran::semantics::SymbolRef sym);
+/// Given the Fortran type of a Cray pointee, return the fir.box type used to
+/// track the cray pointee as Fortran pointer.
+mlir::Type getCrayPointeeBoxType(mlir::Type);
} // namespace lower
} // namespace Fortran
diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index dc3cd6c894a2c2..66774b51316cbf 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -282,6 +282,9 @@ const Symbol *FindExternallyVisibleObject(
// specific procedure of the same name, return it instead.
const Symbol &BypassGeneric(const Symbol &);
+// Given a cray pointee symbol, returns the related cray pointer symbol.
+const Symbol &GetCrayPointer(const Symbol &crayPointee);
+
using SomeExpr = evaluate::Expr<evaluate::SomeType>;
bool ExprHasTypeCategory(
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index c3cb9ba6a47e3d..0b54ee818e3cd9 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3995,11 +3995,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
sym->Rank() == 0) {
// get the corresponding Cray pointer
- auto ptrSym = Fortran::lower::getCrayPointer(*sym);
+ const Fortran::semantics::Symbol &ptrSym =
+ Fortran::semantics::GetCrayPointer(*sym);
fir::ExtendedValue ptr =
getSymbolExtendedValue(ptrSym, nullptr);
mlir::Value ptrVal = fir::getBase(ptr);
- mlir::Type ptrTy = genType(*ptrSym);
+ mlir::Type ptrTy = genType(ptrSym);
fir::ExtendedValue pte =
getSymbolExtendedValue(*sym, nullptr);
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index d157db2cde4961..fb7807718ff888 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -862,7 +862,8 @@ class ScalarExprLowering {
addr);
} else if (sym->test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
// get the corresponding Cray pointer
- auto ptrSym = Fortran::lower::getCrayPointer(sym);
+ Fortran::semantics::SymbolRef ptrSym{
+ Fortran::semantics::GetCrayPointer(sym)};
ExtValue ptr = gen(ptrSym);
mlir::Value ptrVal = fir::getBase(ptr);
mlir::Type ptrTy = converter.genType(*ptrSym);
@@ -1537,8 +1538,8 @@ class ScalarExprLowering {
auto baseSym = getFirstSym(aref);
if (baseSym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
// get the corresponding Cray pointer
- auto ptrSym = Fortran::lower::getCrayPointer(baseSym);
-
+ Fortran::semantics::SymbolRef ptrSym{
+ Fortran::semantics::GetCrayPointer(baseSym)};
fir::ExtendedValue ptr = gen(ptrSym);
mlir::Value ptrVal = fir::getBase(ptr);
mlir::Type ptrTy = ptrVal.getType();
@@ -6946,7 +6947,8 @@ class ArrayExprLowering {
ComponentPath &components) {
mlir::Value ptrVal = nullptr;
if (x.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
- auto ptrSym = Fortran::lower::getCrayPointer(x);
+ Fortran::semantics::SymbolRef ptrSym{
+ Fortran::semantics::GetCrayPointer(x)};
ExtValue ptr = converter.getSymbolExtendedValue(ptrSym);
ptrVal = fir::getBase(ptr);
}
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index c5bfbdf6b8c115..fe5ce4b17b2587 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -284,7 +284,7 @@ class HlfirDesignatorBuilder {
// value of the Cray pointer variable.
fir::FirOpBuilder &builder = getBuilder();
fir::FortranVariableOpInterface ptrVar =
- gen(Fortran::lower::getCrayPointer(symbolRef));
+ gen(Fortran::semantics::GetCrayPointer(symbolRef));
mlir::Value ptrAddr = ptrVar.getBase();
// Reinterpret the reference to a Cray pointer so that
@@ -306,9 +306,16 @@ class HlfirDesignatorBuilder {
}
return *varDef;
}
+ llvm::errs() << *symbolRef << "\n";
TODO(getLoc(), "lowering symbol to HLFIR");
}
+ fir::FortranVariableOpInterface
+ gen(const Fortran::semantics::Symbol &symbol) {
+ Fortran::evaluate::SymbolRef symref{symbol};
+ return gen(symref);
+ }
+
fir::FortranVariableOpInterface
gen(const Fortran::evaluate::Component &component) {
if (Fortran::semantics::IsAllocatableOrPointer(component.GetLastSymbol()))
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 94d849862099eb..e07ae42dc74973 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1554,6 +1554,11 @@ fir::FortranVariableFlagsAttr Fortran::lower::translateSymbolAttributes(
mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym,
fir::FortranVariableFlagsEnum extraFlags) {
fir::FortranVariableFlagsEnum flags = extraFlags;
+ if (sym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
+ // CrayPointee are represented as pointers.
+ flags = flags | fir::FortranVariableFlagsEnum::pointer;
+ return fir::FortranVariableFlagsAttr::get(mlirContext, flags);
+ }
const auto &attrs = sym.attrs();
if (attrs.test(Fortran::semantics::Attr::ALLOCATABLE))
flags = flags | fir::FortranVariableFlagsEnum::allocatable;
@@ -1615,8 +1620,6 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
(!Fortran::semantics::IsProcedure(sym) ||
Fortran::semantics::IsPointer(sym)) &&
!sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
- bool isCrayPointee =
- sym.test(Fortran::semantics::Symbol::Flag::CrayPointee);
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
const mlir::Location loc = genLocation(converter, sym);
mlir::Value shapeOrShift;
@@ -1636,31 +1639,21 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
Fortran::lower::translateSymbolCUDADataAttribute(builder.getContext(),
sym);
- if (isCrayPointee) {
- mlir::Type baseType =
- hlfir::getFortranElementOrSequenceType(base.getType());
- if (auto seqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
- // The pointer box's sequence type must be with unknown shape.
- llvm::SmallVector<int64_t> shape(seqType.getDimension(),
- fir::SequenceType::getUnknownExtent());
- baseType = fir::SequenceType::get(shape, seqType.getEleTy());
- }
- fir::BoxType ptrBoxType =
- fir::BoxType::get(fir::PointerType::get(baseType));
+ if (sym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
+ mlir::Type ptrBoxType =
+ Fortran::lower::getCrayPointeeBoxType(base.getType());
mlir::Value boxAlloc = builder.createTemporary(loc, ptrBoxType);
// Declare a local pointer variable.
- attributes = fir::FortranVariableFlagsAttr::get(
- builder.getContext(), fir::FortranVariableFlagsEnum::pointer);
auto newBase = builder.create<hlfir::DeclareOp>(
loc, boxAlloc, name, /*shape=*/nullptr, lenParams, attributes);
- mlir::Value nullAddr =
- builder.createNullConstant(loc, ptrBoxType.getEleTy());
+ mlir::Value nullAddr = builder.createNullConstant(
+ loc, llvm::cast<fir::BaseBoxType>(ptrBoxType).getEleTy());
// If the element type is known-length character, then
// EmboxOp does not need the length parameters.
if (auto charType = mlir::dyn_cast<fir::CharacterType>(
- fir::unwrapSequenceType(baseType)))
+ hlfir::getFortranElementType(base.getType())))
if (!charType.hasDynamicLen())
lenParams.clear();
@@ -2346,16 +2339,13 @@ void Fortran::lower::createRuntimeTypeInfoGlobal(
defineGlobal(converter, var, globalName, linkage);
}
-Fortran::semantics::SymbolRef
-Fortran::lower::getCrayPointer(Fortran::semantics::SymbolRef sym) {
- assert(!sym->GetUltimate().owner().crayPointers().empty() &&
- "empty Cray pointer/pointee map");
- for (const auto &[pointee, pointer] :
- sym->GetUltimate().owner().crayPointers()) {
- if (pointee == sym->name()) {
- Fortran::semantics::SymbolRef v{pointer.get()};
- return v;
- }
+mlir::Type Fortran::lower::getCrayPointeeBoxType(mlir::Type fortranType) {
+ mlir::Type baseType = hlfir::getFortranElementOrSequenceType(fortranType);
+ if (auto seqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
+ // The pointer box's sequence type must be with unknown shape.
+ llvm::SmallVector<int64_t> shape(seqType.getDimension(),
+ fir::SequenceType::getUnknownExtent());
+ baseType = fir::SequenceType::get(shape, seqType.getEleTy());
}
- llvm_unreachable("corresponding Cray pointer cannot be found");
+ return fir::BoxType::get(fir::PointerType::get(baseType));
}
diff --git a/flang/lib/Lower/HostAssociations.cpp b/flang/lib/Lower/HostAssociations.cpp
index 414673b00f44ca..8eb548eb2bd5fe 100644
--- a/flang/lib/Lower/HostAssociations.cpp
+++ b/flang/lib/Lower/HostAssociations.cpp
@@ -315,7 +315,11 @@ class CapturedAllocatableAndPointer
public:
static mlir::Type getType(Fortran::lower::AbstractConverter &converter,
const Fortran::semantics::Symbol &sym) {
- return fir::ReferenceType::get(converter.genType(sym));
+ mlir::Type baseType = converter.genType(sym);
+ if (sym.GetUltimate().test(Fortran::semantics::Symbol::Flag::CrayPointee))
+ return fir::ReferenceType::get(
+ Fortran::lower::getCrayPointeeBoxType(baseType));
+ return fir::ReferenceType::get(baseType);
}
static void instantiateHostTuple(const InstantiateHostTuple &args,
Fortran::lower::AbstractConverter &converter,
@@ -507,7 +511,8 @@ walkCaptureCategories(T visitor, Fortran::lower::AbstractConverter &converter,
if (Fortran::semantics::IsProcedure(sym))
return CapturedProcedure::visit(visitor, converter, sym, ba);
ba.analyze(sym);
- if (Fortran::semantics::IsAllocatableOrPointer(sym))
+ if (Fortran::semantics::IsAllocatableOrPointer(sym) ||
+ sym.GetUltimate().test(Fortran::semantics::Symbol::Flag::CrayPointee))
return CapturedAllocatableAndPointer::visit(visitor, converter, sym, ba);
if (ba.isArray())
return CapturedArrays::visit(visitor, converter, sym, ba);
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 1dacd5cf64cd99..f196b9c5a0cbcc 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -1594,6 +1594,11 @@ struct SymbolDependenceAnalysis {
if (!s->has<semantics::DerivedTypeDetails>())
depth = std::max(analyze(s) + 1, depth);
}
+
+ // Make sure cray pointer is instantiated even if it is not visible.
+ if (ultimate.test(Fortran::semantics::Symbol::Flag::CrayPointee))
+ depth = std::max(
+ analyze(Fortran::semantics::GetCrayPointer(ultimate)) + 1, depth);
adjustSize(depth + 1);
bool global = lower::symbolIsGlobal(sym);
layeredVarList[depth].emplace_back(sym, global, depth);
@@ -2002,6 +2007,10 @@ struct SymbolVisitor {
}
}
}
+ // - CrayPointer needs to be available whenever a CrayPointee is used.
+ if (symbol.GetUltimate().test(
+ Fortran::semantics::Symbol::Flag::CrayPointee))
+ visitSymbol(Fortran::semantics::GetCrayPointer(symbol));
}
template <typename A>
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 0484baae93cd59..2230047abd7220 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -403,6 +403,18 @@ const Symbol &BypassGeneric(const Symbol &symbol) {
return symbol;
}
+const Symbol &GetCrayPointer(const Symbol &crayPointee) {
+ const Symbol *found{nullptr};
+ for (const auto &[pointee, pointer] :
+ crayPointee.GetUltimate().owner().crayPointers()) {
+ if (pointee == crayPointee.name()) {
+ found = &pointer.get();
+ break;
+ }
+ }
+ return DEREF(found);
+}
+
bool ExprHasTypeCategory(
const SomeExpr &expr, const common::TypeCategory &type) {
auto dynamicType{expr.GetType()};
diff --git a/flang/test/Lower/HLFIR/cray-pointers.f90 b/flang/test/Lower/HLFIR/cray-pointers.f90
index d1f1a5647ff1ca..d969aa5d747a83 100644
--- a/flang/test/Lower/HLFIR/cray-pointers.f90
+++ b/flang/test/Lower/HLFIR/cray-pointers.f90
@@ -204,14 +204,14 @@ end subroutine test7
! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.array<5xi32> {bindc_name = "arr", uniq_name = "_QFtest7Earr"}
! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_3]](%[[VAL_4]]) {uniq_name = "_QFtest7Earr"} : (!fir.ref<!fir.array<5xi32>>, !fir.shape<1>) -> (!fir.ref<!fir.array<5xi32>>, !fir.ref<!fir.array<5xi32>>)
+! CHECK: %[[VAL_12:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest7Eptr"}
+! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_12]] {uniq_name = "_QFtest7Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_6:.*]] = arith.constant 5 : index
! CHECK: %[[VAL_8:.*]] = fir.shape %[[VAL_6]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest7Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_10]](%[[VAL_8]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_11]] to %[[VAL_9]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
-! CHECK: %[[VAL_12:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest7Eptr"}
-! CHECK: %[[VAL_13:.*]]:2 = hlfir.declare %[[VAL_12]] {uniq_name = "_QFtest7Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_13]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_9]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
@@ -226,14 +226,14 @@ subroutine test8()
end subroutine test8
! CHECK-LABEL: func.func @_QPtest8(
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: %[[VAL_8:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest8Eptr"}
+! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest8Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_2:.*]] = arith.constant 5 : index
! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest8Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_6]](%[[VAL_4]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_7]] to %[[VAL_5]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
-! CHECK: %[[VAL_8:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest8Eptr"}
-! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest8Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_5]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
@@ -256,14 +256,14 @@ subroutine sub(x)
end subroutine test9
! CHECK-LABEL: func.func @_QPtest9(
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: %[[VAL_8:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest9Eptr"}
+! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest9Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_2:.*]] = arith.constant 5 : index
! CHECK: %[[VAL_4:.*]] = fir.shape %[[VAL_2]] : (index) -> !fir.shape<1>
! CHECK: %[[VAL_5:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest9Epte"} : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>)
! CHECK: %[[VAL_6:.*]] = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
! CHECK: %[[VAL_7:.*]] = fir.embox %[[VAL_6]](%[[VAL_4]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
! CHECK: fir.store %[[VAL_7]] to %[[VAL_5]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
-! CHECK: %[[VAL_8:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest9Eptr"}
-! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_8]] {uniq_name = "_QFtest9Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_5]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
@@ -287,12 +287,12 @@ subroutine test10()
end subroutine test10
! CHECK-LABEL: func.func @_QPtest10(
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
+! CHECK: %[[VAL_6:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest10Eptr"}
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest10Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest10Epte"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<i32>
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
-! CHECK: %[[VAL_6:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest10Eptr"}
-! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest10Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> !fir.ref<!fir.box<none>>
@@ -315,12 +315,12 @@ subroutine sub2(x)
end subroutine test11
! CHECK-LABEL: func.func @_QPtest11(
! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<i32>>
+! CHECK: %[[VAL_6:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest11Eptr"}
+! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest11Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_1]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest11Epte"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.ptr<i32>
! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_4]] : (!fir.ptr<i32>) -> !fir.box<!fir.ptr<i32>>
! CHECK: fir.store %[[VAL_5]] to %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
-! CHECK: %[[VAL_6:.*]] = fir.alloca i64 {bindc_name = "ptr", uniq_name = "_QFtest11Eptr"}
-! CHECK: %[[VAL_7:.*]]:2 = hlfir.declare %[[VAL_6]] {uniq_name = "_QFtest11Eptr"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<!fir.ptr<i64>>
! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> !fir.ref<!fir.box<none>>
@@ -330,3 +330,97 @@ end subroutine test11
! CHECK: %[[VAL_14:.*]] = fir.box_addr %[[VAL_13]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ptr<i32>
! CHECK: fir.call @_QPsub2(%[[VAL_15]]) fastmath<contract> : (i32) -> ()
+
+module test_mod
+ integer(8) :: cray_pointer
+ real :: cray_pointee
+ pointer(cray_pointer, cray_pointee)
+end module
+
+subroutine test_hidden_pointer
+ ! Only the pointee is accessed, yet the pointer is needed
+ ! for lowering.
+ use test_mod, only : cray_pointee
+ call takes_real(cray_pointee)
+end
+! CHECK-LABEL: func.func @_QPtest_hidden_pointer() {
+! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<f32>>
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QMtest_modEcray_pointer) : !fir.ref<i64>
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_1]] {uniq_name = "_QMtest_modEcray_pointer"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_3:.*]]:2 = hlfir.declare %[[VAL_0]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QMtest_modEcray_pointee"} : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> (!fir.ref<!fir.box<!fir.ptr<f32>>>, !fir.ref<!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]]#0 : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_2]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
+! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_6]] : !fir.ref<!fir.ptr<i64>>
+! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_3]]#0 : (!fir.ref<!fir.box<!fir.ptr<f32>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_7]] : (!fir.ptr<i64>) -> !fir.llvm_ptr<i8>
+! CHECK: %[[VAL_10:.*]] = fir.call @_FortranAPointerAssociateScalar(%[[VAL_8]], %[[VAL_9]]) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.llvm_ptr<i8>) -> none
+! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[VAL_12:.*]] = fir.box_addr %[[VAL_11]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (!fir.ptr<f32>) -> !fir.ref<f32>
+! CHECK: fir.call @_QPtakes_real(%[[VAL_13]]) fastmath<contract> : (!fir.ref<f32>) -> ()
+! CHECK: return
+! CHECK: }
+
+
+
+subroutine test_craypointer_capture(n)
+ integer :: n
+ character(n) :: cray_pointee
+ integer(8) :: cray_pointer
+ pointer(cray_pointer, cray_pointee)
+ call internal()
+ contains
+subroutine internal()
+ call takes_character(cray_pointee)
+end subroutine
+end subroutine
+! CHECK-LABEL: func.func @_QPtest_craypointer_capture(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<i32> {fir.bindc_name = "n"}) {
+! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.char<1,?>>>
+! CHECK: %[[VAL_2:.*]]:2 = hlfir.declare %[[VAL_0]] {uniq_name = "_QFtest_craypointer_captureEn"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK: %[[VAL_3:.*]] = fir.alloca i64 {bindc_name = "cray_pointer", uniq_name = "_QFtest_craypointer_captureEcray_pointer"}
+! CHECK: %[[VAL_4:.*]]:2 = hlfir.declare %[[VAL_3]] {uniq_name = "_QFtest_craypointer_captureEcray_pointer"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_2]]#0 : !fir.ref<i32>
+! CHECK: %[[VAL_6:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_7:.*]] = arith.cmpi sgt, %[[VAL_5]], %[[VAL_6]] : i32
+! CHECK: %[[VAL_8:.*]] = arith.select %[[VAL_7]], %[[VAL_5]], %[[VAL_6]] : i32
+! CHECK: %[[VAL_9:.*]]:2 = hlfir.declare %[[VAL_1]] typeparams %[[VAL_8]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFtest_craypointer_captureEcray_pointee"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, i32) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
+! CHECK: %[[VAL_10:.*]] = fir.zero_bits !fir.ptr<!fir.char<1,?>>
+! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_10]] typeparams %[[VAL_8]] : (!fir.ptr<!fir.char<1,?>>, i32) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+! CHECK: fir.store %[[VAL_11]] to %[[VAL_9]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+! CHECK: %[[VAL_12:.*]] = fir.alloca tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>
+! CHECK: %[[VAL_13:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_12]], %[[VAL_13]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>>
+! CHECK: fir.store %[[VAL_9]]#1 to %[[VAL_14]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>>
+! CHECK: %[[VAL_15:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_12]], %[[VAL_15]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>>, i32) -> !fir.llvm_ptr<!fir.ref<i64>>
+! CHECK: fir.store %[[VAL_4]]#1 to %[[VAL_16]] : !fir.llvm_ptr<!fir.ref<i64>>
+! CHECK: fir.call @_QFtest_craypointer_capturePinternal(%[[VAL_12]]) fastmath<contract> : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>>) -> ()
+! CHECK: return
+! CHECK: }
+
+! CHECK-LABEL: func.func private @_QFtest_craypointer_capturePinternal(
+! CHECK-SAME: %[[VAL_0:.*]]: !fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>> {fir.host_assoc})
+! CHECK: %[[VAL_1:.*]] = arith.constant 0 : i32
+! CHECK: %[[VAL_2:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_1]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>>, i32) -> !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>>
+! CHECK: %[[VAL_3:.*]] = fir.load %[[VAL_2]] : !fir.llvm_ptr<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>>
+! CHECK: %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+! CHECK: %[[VAL_5:.*]] = fir.box_elesize %[[VAL_4]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+! CHECK: %[[VAL_6:.*]]:2 = hlfir.declare %[[VAL_3]] typeparams %[[VAL_5]] {fortran_attrs = #fir.var_attrs<pointer, host_assoc>, uniq_name = "_QFtest_craypointer_captureEcray_pointee"} : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, index) -> (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>)
+! CHECK: %[[VAL_7:.*]] = arith.constant 1 : i32
+! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_7]] : (!fir.ref<tuple<!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>, !fir.ref<i64>>>, i32) -> !fir.llvm_ptr<!fir.ref<i64>>
+! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.llvm_ptr<!fir.ref<i64>>
+! CHECK: %[[VAL_10:.*]]:2 = hlfir.declare %[[VAL_9]] {fortran_attrs = #fir.var_attrs<host_assoc>, uniq_name = "_QFtest_craypointer_captureEcray_pointer"} : (!fir.ref<i64>) -> (!fir.ref<i64>, !fir.ref<i64>)
+! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]]#0 : (!fir.ref<i64>) -> !fir.ref<!fir.ptr<i64>>
+! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref<!fir.ptr<i64>>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_6]]#0 : (!fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>) -> !fir.ref<!fir.box<none>>
+! CHECK: %[[VAL_14:.*]] = fir.convert %[[VAL_12]] : (!fir.ptr<i64>) -> !fir.llvm_ptr<i8>
+! CHECK: %[[VAL_15:.*]] = fir.call @_FortranAPointerAssociateScalar(%[[VAL_13]], %[[VAL_14]]) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.llvm_ptr<i8>) -> none
+! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_6]]#0 : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+! CHECK: %[[VAL_17:.*]] = fir.box_addr %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
+! CHECK: %[[VAL_18:.*]] = fir.emboxchar %[[VAL_17]], %[[VAL_5]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK: fir.call @_QPtakes_character(%[[VAL_18]]) fastmath<contract> : (!fir.boxchar<1>) -> ()
+! CHECK: return
+! CHECK: }
diff --git a/flang/test/Lower/cray-pointer.f90 b/flang/test/Lower/cray-pointer.f90
index 4e9f49daab4e99..06910bce35a144 100644
--- a/flang/test/Lower/cray-pointer.f90
+++ b/flang/test/Lower/cray-pointer.f90
@@ -264,8 +264,8 @@ subroutine cray_array()
! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}}
! CHECK: %[[c3:.*]] = arith.constant 3 : index
! CHECK: %[[k:.*]] = fir.alloca !fir.array<3xi32> {{.*}}
-! CHECK: %[[c31:.*]] = arith.constant 3 : index
! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[c31:.*]] = arith.constant 3 : index
! CHECK: %[[c2:.*]] = arith.constant 2 : i64
! CHECK: %[[c1:.*]] = arith.constant 1 : i64
! CHECK: %[[sub:.*]] = arith.subi %[[c2]], %[[c1]] : i64
@@ -327,8 +327,8 @@ subroutine cray_arraySection()
! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}}
! CHECK: %[[c2:.*]] = arith.constant 2 : index
! CHECK: %[[k:.*]] = fir.alloca !fir.array<2xi32> {{.*}}
-! CHECK: %[[c3:.*]] = arith.constant 3 : index
! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[c3:.*]] = arith.constant 3 : index
! CHECK: %[[c1:.*]] = arith.constant 2 : i64
! CHECK: %[[c0:.*]] = arith.constant 1 : i64
! CHECK: %[[sub:.*]] = arith.subi %[[c1]], %[[c0]] : i64
More information about the flang-commits
mailing list