[flang-commits] [flang] 9aeb7f0 - [flang] Lower IO input with vector subscripts
Valentin Clement via flang-commits
flang-commits at lists.llvm.org
Wed Mar 16 09:13:34 PDT 2022
Author: Valentin Clement
Date: 2022-03-16T17:13:23+01:00
New Revision: 9aeb7f035bdde83501e5eddd9e6ad175b8ed697f
URL: https://github.com/llvm/llvm-project/commit/9aeb7f035bdde83501e5eddd9e6ad175b8ed697f
DIFF: https://github.com/llvm/llvm-project/commit/9aeb7f035bdde83501e5eddd9e6ad175b8ed697f.diff
LOG: [flang] Lower IO input with vector subscripts
This patch adds lowering for IO input with vector subscripts.
It defines a VectorSubscriptBox class that allow representing and working
with a lowered Designator containing vector subscripts while ensuring
all the subscripts expression are only lowered once.
This patch is part of the upstreaming effort from fir-dev branch.
Reviewed By: PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D121806
Co-authored-by: Jean Perier <jperier at nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz at nvidia.com>
Added:
flang/include/flang/Lower/VectorSubscripts.h
flang/lib/Lower/VectorSubscripts.cpp
flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp
flang/test/Lower/vector-subscript-io.f90
Modified:
flang/include/flang/Lower/AbstractConverter.h
flang/include/flang/Lower/Support/Utils.h
flang/include/flang/Optimizer/Transforms/Passes.h
flang/include/flang/Optimizer/Transforms/Passes.td
flang/include/flang/Tools/CLOptions.inc
flang/lib/Lower/Bridge.cpp
flang/lib/Lower/CMakeLists.txt
flang/lib/Lower/ConvertType.cpp
flang/lib/Lower/IO.cpp
flang/lib/Optimizer/Transforms/CMakeLists.txt
flang/lib/Optimizer/Transforms/RewriteLoop.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h
index fc907c2e5ada6..7187e1128ad04 100644
--- a/flang/include/flang/Lower/AbstractConverter.h
+++ b/flang/include/flang/Lower/AbstractConverter.h
@@ -159,6 +159,11 @@ class AbstractConverter {
/// Generate the type from a Variable
virtual mlir::Type genType(const pft::Variable &) = 0;
+ /// Register a runtime derived type information object symbol to ensure its
+ /// object will be generated as a global.
+ virtual void registerRuntimeTypeInfo(mlir::Location loc,
+ SymbolRef typeInfoSym) = 0;
+
//===--------------------------------------------------------------------===//
// Locations
//===--------------------------------------------------------------------===//
diff --git a/flang/include/flang/Lower/Support/Utils.h b/flang/include/flang/Lower/Support/Utils.h
index 40968d42233d9..44d7e86ed03d1 100644
--- a/flang/include/flang/Lower/Support/Utils.h
+++ b/flang/include/flang/Lower/Support/Utils.h
@@ -57,4 +57,25 @@ static Fortran::lower::SomeExpr toEvExpr(const A &x) {
return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x));
}
+template <Fortran::common::TypeCategory FROM>
+static Fortran::lower::SomeExpr ignoreEvConvert(
+ const Fortran::evaluate::Convert<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer, 8>,
+ FROM> &x) {
+ return toEvExpr(x.left());
+}
+template <typename A>
+static Fortran::lower::SomeExpr ignoreEvConvert(const A &x) {
+ return toEvExpr(x);
+}
+
+/// A vector subscript expression may be wrapped with a cast to INTEGER*8.
+/// Get rid of it here so the vector can be loaded. Add it back when
+/// generating the elemental evaluation (inside the loop nest).
+inline Fortran::lower::SomeExpr
+ignoreEvConvert(const Fortran::evaluate::Expr<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Integer, 8>> &x) {
+ return std::visit([](const auto &v) { return ignoreEvConvert(v); }, x.u);
+}
+
#endif // FORTRAN_LOWER_SUPPORT_UTILS_H
diff --git a/flang/include/flang/Lower/VectorSubscripts.h b/flang/include/flang/Lower/VectorSubscripts.h
new file mode 100644
index 0000000000000..98223c547bdba
--- /dev/null
+++ b/flang/include/flang/Lower/VectorSubscripts.h
@@ -0,0 +1,154 @@
+//===-- VectorSubscripts.h -- vector subscripts tools -----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// \brief Defines a compiler internal representation for lowered designators
+/// containing vector subscripts. This representation allows working on such
+/// designators in custom ways while ensuring the designator subscripts are
+/// only evaluated once. It is mainly intended for cases that do not fit in
+/// the array expression lowering framework like input IO in presence of
+/// vector subscripts.
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_VECTORSUBSCRIPTS_H
+#define FORTRAN_LOWER_VECTORSUBSCRIPTS_H
+
+#include "flang/Optimizer/Builder/BoxValue.h"
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace Fortran {
+
+namespace evaluate {
+template <typename>
+class Expr;
+struct SomeType;
+} // namespace evaluate
+
+namespace lower {
+
+class AbstractConverter;
+class StatementContext;
+
+/// VectorSubscriptBox is a lowered representation for any Designator<T> that
+/// contain at least one vector subscript.
+///
+/// A designator `x%a(i,j)%b(1:foo():1, vector, k)%c%d(m)%e1
+/// Is lowered into:
+/// - an ExtendedValue for ranked base (x%a(i,j)%b)
+/// - mlir:Values and ExtendedValues for the triplet, vector subscript and
+/// scalar subscripts of the ranked array reference (1:foo():1, vector, k)
+/// - a list of fir.field_index and scalar integers mlir::Value for the
+/// component
+/// path at the right of the ranked array ref (%c%d(m)%e).
+///
+/// This representation allows later creating loops over the designator elements
+/// and fir.array_coor to get the element addresses without re-evaluating any
+/// sub-expressions.
+class VectorSubscriptBox {
+public:
+ /// Type of the callbacks that can be passed to work with the element
+ /// addresses.
+ using ElementalGenerator = std::function<void(const fir::ExtendedValue &)>;
+ using ElementalGeneratorWithBoolReturn =
+ std::function<mlir::Value(const fir::ExtendedValue &)>;
+ struct LoweredVectorSubscript {
+ LoweredVectorSubscript(fir::ExtendedValue &&vector, mlir::Value size)
+ : vector{std::move(vector)}, size{size} {}
+ fir::ExtendedValue vector;
+ // Vector size, guaranteed to be of indexType.
+ mlir::Value size;
+ };
+ struct LoweredTriplet {
+ // Triplets value, guaranteed to be of indexType.
+ mlir::Value lb;
+ mlir::Value ub;
+ mlir::Value stride;
+ };
+ using LoweredSubscript =
+ std::variant<mlir::Value, LoweredTriplet, LoweredVectorSubscript>;
+ using MaybeSubstring = llvm::SmallVector<mlir::Value, 2>;
+ VectorSubscriptBox(
+ fir::ExtendedValue &&loweredBase,
+ llvm::SmallVector<LoweredSubscript, 16> &&loweredSubscripts,
+ llvm::SmallVector<mlir::Value> &&componentPath,
+ MaybeSubstring substringBounds, mlir::Type elementType)
+ : loweredBase{std::move(loweredBase)}, loweredSubscripts{std::move(
+ loweredSubscripts)},
+ componentPath{std::move(componentPath)},
+ substringBounds{substringBounds}, elementType{elementType} {};
+
+ /// Loop over the elements described by the VectorSubscriptBox, and call
+ /// \p elementalGenerator inside the loops with the element addresses.
+ void loopOverElements(fir::FirOpBuilder &builder, mlir::Location loc,
+ const ElementalGenerator &elementalGenerator);
+
+ /// Loop over the elements described by the VectorSubscriptBox while a
+ /// condition is true, and call \p elementalGenerator inside the loops with
+ /// the element addresses. The initial condition value is \p initialCondition,
+ /// and then it is the result of \p elementalGenerator. The value of the
+ /// condition after the loops is returned.
+ mlir::Value loopOverElementsWhile(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const ElementalGeneratorWithBoolReturn &elementalGenerator,
+ mlir::Value initialCondition);
+
+ /// Return the type of the elements of the array section.
+ mlir::Type getElementType() { return elementType; }
+
+private:
+ /// Common implementation for DoLoop and IterWhile loop creations.
+ template <typename LoopType, typename Generator>
+ mlir::Value loopOverElementsBase(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ const Generator &elementalGenerator,
+ mlir::Value initialCondition);
+ /// Create sliceOp for the designator.
+ mlir::Value createSlice(fir::FirOpBuilder &builder, mlir::Location loc);
+
+ /// Create ExtendedValue the element inside the loop.
+ fir::ExtendedValue getElementAt(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value shape,
+ mlir::Value slice,
+ mlir::ValueRange inductionVariables);
+
+ /// Generate the [lb, ub, step] to loop over the section (in loop order, not
+ /// Fortran dimension order).
+ llvm::SmallVector<std::tuple<mlir::Value, mlir::Value, mlir::Value>>
+ genLoopBounds(fir::FirOpBuilder &builder, mlir::Location loc);
+
+ /// Lowered base of the ranked array ref.
+ fir::ExtendedValue loweredBase;
+ /// Subscripts values of the rank arrayRef part.
+ llvm::SmallVector<LoweredSubscript, 16> loweredSubscripts;
+ /// Scalar subscripts and components at the right of the ranked
+ /// array ref part of any.
+ llvm::SmallVector<mlir::Value> componentPath;
+ /// List of substring bounds if this is a substring (only the lower bound if
+ /// the upper is implicit).
+ MaybeSubstring substringBounds;
+ /// Type of the elements described by this array section.
+ mlir::Type elementType;
+};
+
+/// Lower \p expr, that must be an designator containing vector subscripts, to a
+/// VectorSubscriptBox representation. This causes evaluation of all the
+/// subscripts. Any required clean-ups from subscript expression are added to \p
+/// stmtCtx.
+VectorSubscriptBox genVectorSubscriptBox(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::StatementContext &stmtCtx,
+ const Fortran::evaluate::Expr<Fortran::evaluate::SomeType> &expr);
+
+} // namespace lower
+} // namespace Fortran
+
+#endif // FORTRAN_LOWER_VECTORSUBSCRIPTS_H
diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h
index 7a28f8595dde1..38c071f76d3a9 100644
--- a/flang/include/flang/Optimizer/Transforms/Passes.h
+++ b/flang/include/flang/Optimizer/Transforms/Passes.h
@@ -38,6 +38,7 @@ std::unique_ptr<mlir::Pass> createMemoryAllocationPass();
std::unique_ptr<mlir::Pass>
createMemoryAllocationPass(bool dynOnHeap, std::size_t maxStackSize);
std::unique_ptr<mlir::Pass> createAnnotateConstantOperandsPass();
+std::unique_ptr<mlir::Pass> createSimplifyRegionLitePass();
// declarative passes
#define GEN_PASS_REGISTRATION
diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td
index ca466ce205e09..aec7ef212c60c 100644
--- a/flang/include/flang/Optimizer/Transforms/Passes.td
+++ b/flang/include/flang/Optimizer/Transforms/Passes.td
@@ -188,4 +188,12 @@ def MemoryAllocationOpt : Pass<"memory-allocation-opt", "mlir::FuncOp"> {
let constructor = "::fir::createMemoryAllocationPass()";
}
+def SimplifyRegionLite : Pass<"simplify-region-lite", "mlir::ModuleOp"> {
+ let summary = "Region simplification";
+ let description = [{
+ Run region DCE and erase unreachable blocks in regions.
+ }];
+ let constructor = "::fir::createSimplifyRegionLitePass()";
+}
+
#endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES
diff --git a/flang/include/flang/Tools/CLOptions.inc b/flang/include/flang/Tools/CLOptions.inc
index 7ef6cfeff3c25..adda9b410793f 100644
--- a/flang/include/flang/Tools/CLOptions.inc
+++ b/flang/include/flang/Tools/CLOptions.inc
@@ -143,6 +143,7 @@ inline void createDefaultFIROptimizerPassPipeline(mlir::PassManager &pm) {
fir::addAVC(pm);
pm.addNestedPass<mlir::FuncOp>(fir::createCharacterConversionPass());
pm.addPass(mlir::createCanonicalizerPass(config));
+ pm.addPass(fir::createSimplifyRegionLitePass());
fir::addMemoryAllocationOpt(pm);
// The default inliner pass adds the canonicalizer pass with the default
@@ -157,6 +158,7 @@ inline void createDefaultFIROptimizerPassPipeline(mlir::PassManager &pm) {
pm.addPass(mlir::createConvertSCFToCFPass());
pm.addPass(mlir::createCanonicalizerPass(config));
+ pm.addPass(fir::createSimplifyRegionLitePass());
}
#if !defined(FLANG_EXCLUDE_CODEGEN)
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 65e45d5f310cb..aee742d2e4f71 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -49,6 +49,68 @@ static llvm::cl::opt<bool> dumpBeforeFir(
"fdebug-dump-pre-fir", llvm::cl::init(false),
llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation"));
+namespace {
+/// Helper class to generate the runtime type info global data. This data
+/// is required to describe the derived type to the runtime so that it can
+/// operate over it. It must be ensured this data will be generated for every
+/// derived type lowered in the current translated unit. However, this data
+/// cannot be generated before FuncOp have been created for functions since the
+/// initializers may take their address (e.g for type bound procedures). This
+/// class allows registering all the required runtime type info while it is not
+/// possible to create globals, and to generate this data after function
+/// lowering.
+class RuntimeTypeInfoConverter {
+ /// Store the location and symbols of derived type info to be generated.
+ /// The location of the derived type instantiation is also stored because
+ /// runtime type descriptor symbol are compiler generated and cannot be mapped
+ /// to user code on their own.
+ struct TypeInfoSymbol {
+ Fortran::semantics::SymbolRef symbol;
+ mlir::Location loc;
+ };
+
+public:
+ void registerTypeInfoSymbol(Fortran::lower::AbstractConverter &converter,
+ mlir::Location loc,
+ Fortran::semantics::SymbolRef typeInfoSym) {
+ if (seen.contains(typeInfoSym))
+ return;
+ seen.insert(typeInfoSym);
+ if (!skipRegistration) {
+ registeredTypeInfoSymbols.emplace_back(TypeInfoSymbol{typeInfoSym, loc});
+ return;
+ }
+ // Once the registration is closed, symbols cannot be added to the
+ // registeredTypeInfoSymbols list because it may be iterated over.
+ // However, after registration is closed, it is safe to directly generate
+ // the globals because all FuncOps whose addresses may be required by the
+ // initializers have been generated.
+ Fortran::lower::createRuntimeTypeInfoGlobal(converter, loc,
+ typeInfoSym.get());
+ }
+
+ void createTypeInfoGlobals(Fortran::lower::AbstractConverter &converter) {
+ skipRegistration = true;
+ for (const TypeInfoSymbol &info : registeredTypeInfoSymbols)
+ Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.loc,
+ info.symbol.get());
+ registeredTypeInfoSymbols.clear();
+ }
+
+private:
+ /// Store the runtime type descriptors that will be required for the
+ /// derived type that have been converted to FIR derived types.
+ llvm::SmallVector<TypeInfoSymbol> registeredTypeInfoSymbols;
+ /// Create derived type runtime info global immediately without storing the
+ /// symbol in registeredTypeInfoSymbols.
+ bool skipRegistration = false;
+ /// Track symbols symbols processed during and after the registration
+ /// to avoid infinite loops between type conversions and global variable
+ /// creation.
+ llvm::SmallSetVector<Fortran::semantics::SymbolRef, 64> seen;
+};
+} // namespace
+
//===----------------------------------------------------------------------===//
// FirConverter
//===----------------------------------------------------------------------===//
@@ -101,6 +163,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
},
u);
}
+
+ /// Once all the code has been translated, create runtime type info
+ /// global data structure for the derived types that have been
+ /// processed.
+ createGlobalOutsideOfFunctionLowering(
+ [&]() { runtimeTypeInfoConverter.createTypeInfoGlobals(*this); });
}
/// Declare a function.
@@ -689,6 +757,12 @@ class FirConverter : public Fortran::lower::AbstractConverter {
hostAssocTuple = val;
}
+ void registerRuntimeTypeInfo(
+ mlir::Location loc,
+ Fortran::lower::SymbolRef typeInfoSym) override final {
+ runtimeTypeInfoConverter.registerTypeInfoSymbol(*this, loc, typeInfoSym);
+ }
+
private:
FirConverter() = delete;
FirConverter(const FirConverter &) = delete;
@@ -2319,6 +2393,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
Fortran::lower::pft::Evaluation *evalPtr = nullptr;
Fortran::lower::SymMap localSymbols;
Fortran::parser::CharBlock currentPosition;
+ RuntimeTypeInfoConverter runtimeTypeInfoConverter;
/// Tuple of host assoicated variables.
mlir::Value hostAssocTuple;
diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt
index 638787e800539..9309253f178ce 100644
--- a/flang/lib/Lower/CMakeLists.txt
+++ b/flang/lib/Lower/CMakeLists.txt
@@ -21,6 +21,7 @@ add_flang_library(FortranLower
PFTBuilder.cpp
Runtime.cpp
SymbolMap.cpp
+ VectorSubscripts.cpp
DEPENDS
FIRDialect
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 21379efc1f94e..fa29e5466f247 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -8,6 +8,8 @@
#include "flang/Lower/ConvertType.h"
#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/CallInterface.h"
+#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/Mangler.h"
#include "flang/Lower/PFTBuilder.h"
#include "flang/Lower/Support/Utils.h"
@@ -128,8 +130,8 @@ genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
/// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types
/// since it is not guaranteed to exist yet when we lower types.
namespace {
-class TypeBuilder {
-public:
+struct TypeBuilder {
+
TypeBuilder(Fortran::lower::AbstractConverter &converter)
: converter{converter}, context{&converter.getMLIRContext()} {}
@@ -196,8 +198,7 @@ class TypeBuilder {
},
[&](const Fortran::evaluate::ProcedureDesignator &proc)
-> mlir::Type {
- TODO(converter.getCurrentLocation(),
- "genTypelessExprType ProcedureDesignator");
+ return Fortran::lower::translateSignature(proc, converter);
},
[&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type {
return mlir::NoneType::get(context);
@@ -232,7 +233,7 @@ class TypeBuilder {
translateLenParameters(params, tySpec->category(), ultimate);
ty = genFIRType(context, tySpec->category(), kind, params);
} else if (type->IsPolymorphic()) {
- TODO(loc, "genSymbolType polymorphic types");
+ TODO(loc, "[genSymbolType] polymorphic types");
} else if (const Fortran::semantics::DerivedTypeSpec *tySpec =
type->AsDerived()) {
ty = genDerivedType(*tySpec);
@@ -321,13 +322,20 @@ class TypeBuilder {
rec.finalize(ps, cs);
popDerivedTypeInConstruction();
+ mlir::Location loc = converter.genLocation(typeSymbol.name());
if (!ps.empty()) {
// This type is a PDT (parametric derived type). Create the functions to
// use for allocation, dereferencing, and address arithmetic here.
- TODO(converter.genLocation(typeSymbol.name()),
- "parametrized derived types lowering");
+ TODO(loc, "parametrized derived types lowering");
}
LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n');
+
+ // Generate the type descriptor object if any
+ if (const Fortran::semantics::Scope *derivedScope =
+ tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope())
+ if (const Fortran::semantics::Symbol *typeInfoSym =
+ derivedScope->runtimeDerivedTypeDescription())
+ converter.registerRuntimeTypeInfo(loc, *typeInfoSym);
return rec;
}
@@ -418,7 +426,6 @@ class TypeBuilder {
Fortran::lower::AbstractConverter &converter;
mlir::MLIRContext *context;
};
-
} // namespace
mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 9acb8ae8b5ffb..68ef2f7822a68 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -12,18 +12,21 @@
#include "flang/Lower/IO.h"
#include "flang/Common/uint128.h"
+#include "flang/Lower/Allocatable.h"
#include "flang/Lower/Bridge.h"
+#include "flang/Lower/ConvertExpr.h"
#include "flang/Lower/ConvertVariable.h"
#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/Runtime.h"
#include "flang/Lower/StatementContext.h"
#include "flang/Lower/Support/Utils.h"
#include "flang/Lower/Todo.h"
-#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Lower/VectorSubscripts.h"
#include "flang/Optimizer/Builder/Character.h"
#include "flang/Optimizer/Builder/Complex.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
-#include "flang/Optimizer/Builder/MutableBox.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Optimizer/Support/FIRContext.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Runtime/io-api.h"
#include "flang/Semantics/tools.h"
@@ -31,8 +34,6 @@
#define DEBUG_TYPE "flang-lower-io"
-using namespace mlir;
-
// Define additional runtime type models specific to IO.
namespace fir::runtime {
template <>
@@ -90,14 +91,15 @@ static constexpr std::tuple<
#ifdef __SIZEOF_INT128__
mkIOKey(OutputInteger128),
#endif
- mkIOKey(InputInteger), mkIOKey(OutputReal32), mkIOKey(InputReal32),
- mkIOKey(OutputReal64), mkIOKey(InputReal64), mkIOKey(OutputComplex32),
- mkIOKey(InputComplex32), mkIOKey(OutputComplex64), mkIOKey(InputComplex64),
- mkIOKey(OutputAscii), mkIOKey(InputAscii), mkIOKey(OutputLogical),
- mkIOKey(InputLogical), mkIOKey(SetAccess), mkIOKey(SetAction),
- mkIOKey(SetAsynchronous), mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding),
- mkIOKey(SetForm), mkIOKey(SetPosition), mkIOKey(SetRecl),
- mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
+ mkIOKey(InputInteger),
+ mkIOKey(OutputReal32), mkIOKey(InputReal32), mkIOKey(OutputReal64),
+ mkIOKey(InputReal64), mkIOKey(OutputComplex32), mkIOKey(InputComplex32),
+ mkIOKey(OutputComplex64), mkIOKey(InputComplex64), mkIOKey(OutputAscii),
+ mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical),
+ mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous),
+ mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm),
+ mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus),
+ mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)>
@@ -152,6 +154,10 @@ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
return std::get<A>(Fortran::lower::newIOTable).getTypeModel();
}
+inline int64_t getLength(mlir::Type argTy) {
+ return argTy.cast<fir::SequenceType>().getShape()[0];
+}
+
/// Get (or generate) the MLIR FuncOp for a given IO runtime function.
template <typename E>
static mlir::FuncOp getIORuntimeFunc(mlir::Location loc,
@@ -267,18 +273,22 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
groupIsLocal = true;
continue;
}
- std::string mangleName = converter.mangleName(s) + ".desc";
- if (builder.getNamedGlobal(mangleName))
- continue;
- const auto expr = Fortran::evaluate::AsGenericExpr(s);
- fir::BoxType boxTy =
- fir::BoxType::get(fir::PointerType::get(converter.genType(s)));
- auto descFunc = [&](fir::FirOpBuilder &b) {
- auto box =
- Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr);
- b.create<fir::HasValueOp>(loc, box);
- };
- builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce);
+ // We know we have a global item. It it's not a pointer or allocatable,
+ // create a static pointer to it.
+ if (!IsAllocatableOrPointer(s)) {
+ std::string mangleName = converter.mangleName(s) + ".desc";
+ if (builder.getNamedGlobal(mangleName))
+ continue;
+ const auto expr = Fortran::evaluate::AsGenericExpr(s);
+ fir::BoxType boxTy =
+ fir::BoxType::get(fir::PointerType::get(converter.genType(s)));
+ auto descFunc = [&](fir::FirOpBuilder &b) {
+ auto box =
+ Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr);
+ b.create<fir::HasValueOp>(loc, box);
+ };
+ builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce);
+ }
}
// Define the list of Items.
@@ -301,8 +311,10 @@ getNamelistGroup(Fortran::lower::AbstractConverter &converter,
builder.getArrayAttr(idx));
idx[1] = one;
mlir::Value descAddr;
+ // Items that we created end in ".desc".
+ std::string suffix = IsAllocatableOrPointer(s) ? "" : ".desc";
if (auto desc =
- builder.getNamedGlobal(converter.mangleName(s) + ".desc")) {
+ builder.getNamedGlobal(converter.mangleName(s) + suffix)) {
descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(),
desc.getSymbol());
} else {
@@ -408,10 +420,8 @@ static mlir::FuncOp getOutputFunc(mlir::Location loc,
return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
case 64:
return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
-#ifdef __SIZEOF_INT128__
case 128:
return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
-#endif
}
llvm_unreachable("unknown OutputInteger kind");
}
@@ -421,16 +431,27 @@ static mlir::FuncOp getOutputFunc(mlir::Location loc,
else if (width == 64)
return getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder);
}
+ auto kindMap = fir::getKindMapping(builder.getModule());
if (auto ty = type.dyn_cast<fir::ComplexType>()) {
- if (auto kind = ty.getFKind(); kind == 4)
+ // COMPLEX(KIND=k) corresponds to a pair of REAL(KIND=k).
+ auto width = kindMap.getRealBitsize(ty.getFKind());
+ if (width == 32)
return getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder);
- else if (kind == 8)
+ else if (width == 64)
return getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder);
}
if (type.isa<fir::LogicalType>())
return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
- if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
- return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
+ if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) {
+ // TODO: What would it mean if the default CHARACTER KIND is set to a wide
+ // character encoding scheme? How do we handle UTF-8? Is it a distinct KIND
+ // value? For now, assume that if the default CHARACTER KIND is 8 bit,
+ // then it is an ASCII string and UTF-8 is unsupported.
+ auto asciiKind = kindMap.defaultCharacterKind();
+ if (kindMap.getCharacterBitsize(asciiKind) == 8 &&
+ fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind)
+ return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
+ }
return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
}
@@ -509,19 +530,42 @@ static mlir::FuncOp getInputFunc(mlir::Location loc, fir::FirOpBuilder &builder,
else if (width <= 64)
return getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder);
}
+ auto kindMap = fir::getKindMapping(builder.getModule());
if (auto ty = type.dyn_cast<fir::ComplexType>()) {
- if (auto kind = ty.getFKind(); kind <= 4)
+ auto width = kindMap.getRealBitsize(ty.getFKind());
+ if (width <= 32)
return getIORuntimeFunc<mkIOKey(InputComplex32)>(loc, builder);
- else if (kind <= 8)
+ else if (width <= 64)
return getIORuntimeFunc<mkIOKey(InputComplex64)>(loc, builder);
}
if (type.isa<fir::LogicalType>())
return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder);
- if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
- return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
+ if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) {
+ auto asciiKind = kindMap.defaultCharacterKind();
+ if (kindMap.getCharacterBitsize(asciiKind) == 8 &&
+ fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind)
+ return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
+ }
return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
}
+/// Interpret the lowest byte of a LOGICAL and store that value into the full
+/// storage of the LOGICAL. The load, convert, and store effectively (sign or
+/// zero) extends the lowest byte into the full LOGICAL value storage, as the
+/// runtime is unaware of the LOGICAL value's actual bit width (it was passed
+/// as a `bool&` to the runtime in order to be set).
+static void boolRefToLogical(mlir::Location loc, fir::FirOpBuilder &builder,
+ mlir::Value addr) {
+ auto boolType = builder.getRefType(builder.getI1Type());
+ auto boolAddr = builder.createConvert(loc, boolType, addr);
+ auto boolValue = builder.create<fir::LoadOp>(loc, boolAddr);
+ auto logicalType = fir::unwrapPassByRefType(addr.getType());
+ // The convert avoid making any assumptions about how LOGICALs are actually
+ // represented (it might end-up being either a signed or zero extension).
+ auto logicalValue = builder.createConvert(loc, logicalType, boolValue);
+ builder.create<fir::StoreOp>(loc, logicalValue, addr);
+}
+
static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
fir::FirOpBuilder &builder,
mlir::FuncOp inputFunc,
@@ -548,8 +592,12 @@ static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
itemTy.cast<mlir::IntegerType>().getWidth() / 8)));
}
}
- return builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs)
- .getResult(0);
+ auto call = builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs);
+ auto itemAddr = fir::getBase(item);
+ auto itemTy = fir::unwrapRefType(itemAddr.getType());
+ if (itemTy.isa<fir::LogicalType>())
+ boolRefToLogical(loc, builder, itemAddr);
+ return call.getResult(0);
}
/// Generate a sequence of input data transfer calls.
@@ -573,7 +621,31 @@ static void genInputItemList(Fortran::lower::AbstractConverter &converter,
if (!expr)
fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
if (Fortran::evaluate::HasVectorSubscript(*expr)) {
- TODO(loc, "genInputItemList with VectorSubscript");
+ auto vectorSubscriptBox =
+ Fortran::lower::genVectorSubscriptBox(loc, converter, stmtCtx, *expr);
+ mlir::FuncOp inputFunc = getInputFunc(
+ loc, builder, vectorSubscriptBox.getElementType(), isFormatted);
+ const bool mustBox = inputFunc.getType().getInput(1).isa<fir::BoxType>();
+ if (!checkResult) {
+ auto elementalGenerator = [&](const fir::ExtendedValue &element) {
+ createIoRuntimeCallForItem(loc, builder, inputFunc, cookie,
+ mustBox ? builder.createBox(loc, element)
+ : element);
+ };
+ vectorSubscriptBox.loopOverElements(builder, loc, elementalGenerator);
+ } else {
+ auto elementalGenerator =
+ [&](const fir::ExtendedValue &element) -> mlir::Value {
+ return createIoRuntimeCallForItem(
+ loc, builder, inputFunc, cookie,
+ mustBox ? builder.createBox(loc, element) : element);
+ };
+ if (!ok)
+ ok = builder.createBool(loc, true);
+ ok = vectorSubscriptBox.loopOverElementsWhile(builder, loc,
+ elementalGenerator, ok);
+ }
+ continue;
}
mlir::Type itemTy = converter.genType(*expr);
mlir::FuncOp inputFunc = getInputFunc(loc, builder, itemTy, isFormatted);
@@ -653,8 +725,8 @@ static void genIoLoop(Fortran::lower::AbstractConverter &converter,
genItemList(ioImpliedDo);
// Unwind nested IO call scopes, filling in true and false ResultOp's.
for (mlir::Operation *op = builder.getBlock()->getParentOp();
- isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
- auto ifOp = dyn_cast<fir::IfOp>(op);
+ mlir::isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
+ auto ifOp = mlir::dyn_cast<fir::IfOp>(op);
mlir::Operation *lastOp = &ifOp.getThenRegion().front().back();
builder.setInsertionPointAfter(lastOp);
// The primary ifOp result is the result of an IO call or loop.
@@ -924,24 +996,6 @@ mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>(
return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec);
}
-template <>
-mlir::Value genIOOption<Fortran::parser::ConnectSpec::Newunit>(
- Fortran::lower::AbstractConverter &converter, mlir::Location loc,
- mlir::Value cookie, const Fortran::parser::ConnectSpec::Newunit &spec) {
- Fortran::lower::StatementContext stmtCtx;
- fir::FirOpBuilder &builder = converter.getFirOpBuilder();
- mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
- mlir::FunctionType ioFuncTy = ioFunc.getType();
- const auto *var = Fortran::semantics::GetExpr(spec);
- mlir::Value addr = builder.createConvert(
- loc, ioFuncTy.getInput(1),
- fir::getBase(converter.genExprAddr(var, stmtCtx, loc)));
- auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2),
- var->GetType().value().kind());
- llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind};
- return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
-}
-
template <>
mlir::Value genIOOption<Fortran::parser::StatusExpr>(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
@@ -1062,7 +1116,7 @@ static bool hasX(const A &list) {
}
template <typename SEEK, typename A>
-static bool hasMem(const A &stmt) {
+static bool hasSpec(const A &stmt) {
return hasX<SEEK>(stmt.v);
}
@@ -1090,6 +1144,12 @@ static void threadSpecs(Fortran::lower::AbstractConverter &converter,
// before.
return ok;
},
+ [&](const Fortran::parser::ConnectSpec::Newunit &x) -> mlir::Value {
+ // Newunit must be queried after OPEN specifier runtime calls
+ // that may fail to avoid modifying the newunit variable if
+ // there is an error.
+ return ok;
+ },
[&](const auto &x) {
return genIOOption(converter, loc, cookie, x);
}},
@@ -1539,6 +1599,29 @@ Fortran::lower::genRewindStatement(Fortran::lower::AbstractConverter &converter,
return genBasicIOStmt<mkIOKey(BeginRewind)>(converter, stmt);
}
+static mlir::Value
+genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ mlir::Value cookie,
+ const std::list<Fortran::parser::ConnectSpec> &specList) {
+ for (const auto &spec : specList)
+ if (auto *newunit =
+ std::get_if<Fortran::parser::ConnectSpec::Newunit>(&spec.u)) {
+ Fortran::lower::StatementContext stmtCtx;
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
+ mlir::FunctionType ioFuncTy = ioFunc.getType();
+ const auto *var = Fortran::semantics::GetExpr(newunit->v);
+ mlir::Value addr = builder.createConvert(
+ loc, ioFuncTy.getInput(1),
+ fir::getBase(converter.genExprAddr(var, stmtCtx, loc)));
+ auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2),
+ var->GetType().value().kind());
+ llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind};
+ return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+ }
+ llvm_unreachable("missing Newunit spec");
+}
+
mlir::Value
Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
const Fortran::parser::OpenStmt &stmt) {
@@ -1547,7 +1630,8 @@ Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
mlir::FuncOp beginFunc;
llvm::SmallVector<mlir::Value> beginArgs;
mlir::Location loc = converter.getCurrentLocation();
- if (hasMem<Fortran::parser::FileUnitNumber>(stmt)) {
+ bool hasNewunitSpec = false;
+ if (hasSpec<Fortran::parser::FileUnitNumber>(stmt)) {
beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder);
mlir::FunctionType beginFuncTy = beginFunc.getType();
mlir::Value unit = fir::getBase(converter.genExprValue(
@@ -1557,7 +1641,8 @@ Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1)));
beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2)));
} else {
- assert(hasMem<Fortran::parser::ConnectSpec::Newunit>(stmt));
+ hasNewunitSpec = hasSpec<Fortran::parser::ConnectSpec::Newunit>(stmt);
+ assert(hasNewunitSpec && "missing unit specifier");
beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder);
mlir::FunctionType beginFuncTy = beginFunc.getType();
beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0)));
@@ -1570,6 +1655,8 @@ Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
mlir::Value ok;
auto insertPt = builder.saveInsertionPoint();
threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
+ if (hasNewunitSpec)
+ genNewunitSpec(converter, loc, cookie, stmt.v);
builder.restoreInsertionPoint(insertPt);
return genEndIO(converter, loc, cookie, csi, stmtCtx);
}
@@ -1586,7 +1673,7 @@ Fortran::lower::genWaitStatement(Fortran::lower::AbstractConverter &converter,
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
Fortran::lower::StatementContext stmtCtx;
mlir::Location loc = converter.getCurrentLocation();
- bool hasId = hasMem<Fortran::parser::IdExpr>(stmt);
+ bool hasId = hasSpec<Fortran::parser::IdExpr>(stmt);
mlir::FuncOp beginFunc =
hasId ? getIORuntimeFunc<mkIOKey(BeginWait)>(loc, builder)
: getIORuntimeFunc<mkIOKey(BeginWaitAll)>(loc, builder);
@@ -1911,9 +1998,9 @@ mlir::Value genInquireSpec<Fortran::parser::InquireSpec::IntVar>(
if (!eleTy)
fir::emitFatalError(loc,
"internal error: expected a memory reference type");
- auto bitWidth = eleTy.cast<mlir::IntegerType>().getWidth();
+ auto width = eleTy.cast<mlir::IntegerType>().getWidth();
mlir::IndexType idxTy = builder.getIndexType();
- mlir::Value kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8);
+ mlir::Value kind = builder.createIntegerConstant(loc, idxTy, width / 8);
llvm::SmallVector<mlir::Value> args = {
builder.createConvert(loc, specFuncTy.getInput(0), cookie),
builder.createIntegerConstant(
@@ -1958,7 +2045,9 @@ mlir::Value genInquireSpec<Fortran::parser::InquireSpec::LogVar>(
Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind)
.c_str())));
args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr));
- return builder.create<fir::CallOp>(loc, specFunc, args).getResult(0);
+ auto call = builder.create<fir::CallOp>(loc, specFunc, args);
+ boolRefToLogical(loc, builder, addr);
+ return call.getResult(0);
}
/// If there is an IdExpr in the list of inquire-specs, then lower it and return
diff --git a/flang/lib/Lower/VectorSubscripts.cpp b/flang/lib/Lower/VectorSubscripts.cpp
new file mode 100644
index 0000000000000..e4a7fdd7f0180
--- /dev/null
+++ b/flang/lib/Lower/VectorSubscripts.cpp
@@ -0,0 +1,427 @@
+//===-- VectorSubscripts.cpp -- Vector subscripts tools -------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/VectorSubscripts.h"
+#include "flang/Lower/AbstractConverter.h"
+#include "flang/Lower/Support/Utils.h"
+#include "flang/Lower/Todo.h"
+#include "flang/Optimizer/Builder/Character.h"
+#include "flang/Optimizer/Builder/Complex.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Semantics/expression.h"
+
+namespace {
+/// Helper class to lower a designator containing vector subscripts into a
+/// lowered representation that can be worked with.
+class VectorSubscriptBoxBuilder {
+public:
+ VectorSubscriptBoxBuilder(mlir::Location loc,
+ Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::StatementContext &stmtCtx)
+ : converter{converter}, stmtCtx{stmtCtx}, loc{loc} {}
+
+ Fortran::lower::VectorSubscriptBox gen(const Fortran::lower::SomeExpr &expr) {
+ elementType = genDesignator(expr);
+ return Fortran::lower::VectorSubscriptBox(
+ std::move(loweredBase), std::move(loweredSubscripts),
+ std::move(componentPath), substringBounds, elementType);
+ }
+
+private:
+ using LoweredVectorSubscript =
+ Fortran::lower::VectorSubscriptBox::LoweredVectorSubscript;
+ using LoweredTriplet = Fortran::lower::VectorSubscriptBox::LoweredTriplet;
+ using LoweredSubscript = Fortran::lower::VectorSubscriptBox::LoweredSubscript;
+ using MaybeSubstring = Fortran::lower::VectorSubscriptBox::MaybeSubstring;
+
+ /// genDesignator unwraps a Designator<T> and calls `gen` on what the
+ /// designator actually contains.
+ template <typename A>
+ mlir::Type genDesignator(const A &) {
+ fir::emitFatalError(loc, "expr must contain a designator");
+ }
+ template <typename T>
+ mlir::Type genDesignator(const Fortran::evaluate::Expr<T> &expr) {
+ using ExprVariant = decltype(Fortran::evaluate::Expr<T>::u);
+ using Designator = Fortran::evaluate::Designator<T>;
+ if constexpr (Fortran::common::HasMember<Designator, ExprVariant>) {
+ const auto &designator = std::get<Designator>(expr.u);
+ return std::visit([&](const auto &x) { return gen(x); }, designator.u);
+ } else {
+ return std::visit([&](const auto &x) { return genDesignator(x); },
+ expr.u);
+ }
+ }
+
+ // The gen(X) methods visit X to lower its base and subscripts and return the
+ // type of X elements.
+
+ mlir::Type gen(const Fortran::evaluate::DataRef &dataRef) {
+ return std::visit([&](const auto &ref) -> mlir::Type { return gen(ref); },
+ dataRef.u);
+ }
+
+ mlir::Type gen(const Fortran::evaluate::SymbolRef &symRef) {
+ // Never visited because expr lowering is used to lowered the ranked
+ // ArrayRef.
+ fir::emitFatalError(
+ loc, "expected at least one ArrayRef with vector susbcripts");
+ }
+
+ mlir::Type gen(const Fortran::evaluate::Substring &substring) {
+ // StaticDataObject::Pointer bases are constants and cannot be
+ // subscripted, so the base must be a DataRef here.
+ mlir::Type baseElementType =
+ gen(std::get<Fortran::evaluate::DataRef>(substring.parent()));
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Type idxTy = builder.getIndexType();
+ mlir::Value lb = genScalarValue(substring.lower());
+ substringBounds.emplace_back(builder.createConvert(loc, idxTy, lb));
+ if (const auto &ubExpr = substring.upper()) {
+ mlir::Value ub = genScalarValue(*ubExpr);
+ substringBounds.emplace_back(builder.createConvert(loc, idxTy, ub));
+ }
+ return baseElementType;
+ }
+
+ mlir::Type gen(const Fortran::evaluate::ComplexPart &complexPart) {
+ auto complexType = gen(complexPart.complex());
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Type i32Ty = builder.getI32Type(); // llvm's GEP requires i32
+ mlir::Value offset = builder.createIntegerConstant(
+ loc, i32Ty,
+ complexPart.part() == Fortran::evaluate::ComplexPart::Part::RE ? 0 : 1);
+ componentPath.emplace_back(offset);
+ return fir::factory::Complex{builder, loc}.getComplexPartType(complexType);
+ }
+
+ mlir::Type gen(const Fortran::evaluate::Component &component) {
+ auto recTy = gen(component.base()).cast<fir::RecordType>();
+ const Fortran::semantics::Symbol &componentSymbol =
+ component.GetLastSymbol();
+ // Parent components will not be found here, they are not part
+ // of the FIR type and cannot be used in the path yet.
+ if (componentSymbol.test(Fortran::semantics::Symbol::Flag::ParentComp))
+ TODO(loc, "Reference to parent component");
+ mlir::Type fldTy = fir::FieldType::get(&converter.getMLIRContext());
+ llvm::StringRef componentName = toStringRef(componentSymbol.name());
+ // Parameters threading in field_index is not yet very clear. We only
+ // have the ones of the ranked array ref at hand, but it looks like
+ // the fir.field_index expects the one of the direct base.
+ if (recTy.getNumLenParams() != 0)
+ TODO(loc, "threading length parameters in field index op");
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ componentPath.emplace_back(builder.create<fir::FieldIndexOp>(
+ loc, fldTy, componentName, recTy, /*typeParams*/ llvm::None));
+ return fir::unwrapSequenceType(recTy.getType(componentName));
+ }
+
+ mlir::Type gen(const Fortran::evaluate::ArrayRef &arrayRef) {
+ auto isTripletOrVector =
+ [](const Fortran::evaluate::Subscript &subscript) -> bool {
+ return std::visit(
+ Fortran::common::visitors{
+ [](const Fortran::evaluate::IndirectSubscriptIntegerExpr &expr) {
+ return expr.value().Rank() != 0;
+ },
+ [&](const Fortran::evaluate::Triplet &) { return true; }},
+ subscript.u);
+ };
+ if (llvm::any_of(arrayRef.subscript(), isTripletOrVector))
+ return genRankedArrayRefSubscriptAndBase(arrayRef);
+
+ // This is a scalar ArrayRef (only scalar indexes), collect the indexes and
+ // visit the base that must contain another arrayRef with the vector
+ // subscript.
+ mlir::Type elementType = gen(namedEntityToDataRef(arrayRef.base()));
+ for (const Fortran::evaluate::Subscript &subscript : arrayRef.subscript()) {
+ const auto &expr =
+ std::get<Fortran::evaluate::IndirectSubscriptIntegerExpr>(
+ subscript.u);
+ componentPath.emplace_back(genScalarValue(expr.value()));
+ }
+ return elementType;
+ }
+
+ /// Lower the subscripts and base of the ArrayRef that is an array (there must
+ /// be one since there is a vector subscript, and there can only be one
+ /// according to C925).
+ mlir::Type genRankedArrayRefSubscriptAndBase(
+ const Fortran::evaluate::ArrayRef &arrayRef) {
+ // Lower the save the base
+ Fortran::lower::SomeExpr baseExpr = namedEntityToExpr(arrayRef.base());
+ loweredBase = converter.genExprAddr(baseExpr, stmtCtx);
+ // Lower and save the subscripts
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ mlir::Type idxTy = builder.getIndexType();
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ for (const auto &subscript : llvm::enumerate(arrayRef.subscript())) {
+ std::visit(
+ Fortran::common::visitors{
+ [&](const Fortran::evaluate::IndirectSubscriptIntegerExpr &expr) {
+ if (expr.value().Rank() == 0) {
+ // Simple scalar subscript
+ loweredSubscripts.emplace_back(genScalarValue(expr.value()));
+ } else {
+ // Vector subscript.
+ // Remove conversion if any to avoid temp creation that may
+ // have been added by the front-end to avoid the creation of a
+ // temp array value.
+ auto vector = converter.genExprAddr(
+ ignoreEvConvert(expr.value()), stmtCtx);
+ mlir::Value size =
+ fir::factory::readExtent(builder, loc, vector, /*dim=*/0);
+ size = builder.createConvert(loc, idxTy, size);
+ loweredSubscripts.emplace_back(
+ LoweredVectorSubscript{std::move(vector), size});
+ }
+ },
+ [&](const Fortran::evaluate::Triplet &triplet) {
+ mlir::Value lb, ub;
+ if (const auto &lbExpr = triplet.lower())
+ lb = genScalarValue(*lbExpr);
+ else
+ lb = fir::factory::readLowerBound(builder, loc, loweredBase,
+ subscript.index(), one);
+ if (const auto &ubExpr = triplet.upper())
+ ub = genScalarValue(*ubExpr);
+ else
+ ub = fir::factory::readExtent(builder, loc, loweredBase,
+ subscript.index());
+ lb = builder.createConvert(loc, idxTy, lb);
+ ub = builder.createConvert(loc, idxTy, ub);
+ mlir::Value stride = genScalarValue(triplet.stride());
+ stride = builder.createConvert(loc, idxTy, stride);
+ loweredSubscripts.emplace_back(LoweredTriplet{lb, ub, stride});
+ },
+ },
+ subscript.value().u);
+ }
+ return fir::unwrapSequenceType(
+ fir::unwrapPassByRefType(fir::getBase(loweredBase).getType()));
+ }
+
+ mlir::Type gen(const Fortran::evaluate::CoarrayRef &) {
+ // Is this possible/legal ?
+ TODO(loc, "Coarray ref with vector subscript in IO input");
+ }
+
+ template <typename A>
+ mlir::Value genScalarValue(const A &expr) {
+ return fir::getBase(converter.genExprValue(toEvExpr(expr), stmtCtx));
+ }
+
+ Fortran::evaluate::DataRef
+ namedEntityToDataRef(const Fortran::evaluate::NamedEntity &namedEntity) {
+ if (namedEntity.IsSymbol())
+ return Fortran::evaluate::DataRef{namedEntity.GetFirstSymbol()};
+ return Fortran::evaluate::DataRef{namedEntity.GetComponent()};
+ }
+
+ Fortran::lower::SomeExpr
+ namedEntityToExpr(const Fortran::evaluate::NamedEntity &namedEntity) {
+ return Fortran::evaluate::AsGenericExpr(namedEntityToDataRef(namedEntity))
+ .value();
+ }
+
+ Fortran::lower::AbstractConverter &converter;
+ Fortran::lower::StatementContext &stmtCtx;
+ mlir::Location loc;
+ /// Elements of VectorSubscriptBox being built.
+ fir::ExtendedValue loweredBase;
+ llvm::SmallVector<LoweredSubscript, 16> loweredSubscripts;
+ llvm::SmallVector<mlir::Value> componentPath;
+ MaybeSubstring substringBounds;
+ mlir::Type elementType;
+};
+} // namespace
+
+Fortran::lower::VectorSubscriptBox Fortran::lower::genVectorSubscriptBox(
+ mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+ Fortran::lower::StatementContext &stmtCtx,
+ const Fortran::lower::SomeExpr &expr) {
+ return VectorSubscriptBoxBuilder(loc, converter, stmtCtx).gen(expr);
+}
+
+template <typename LoopType, typename Generator>
+mlir::Value Fortran::lower::VectorSubscriptBox::loopOverElementsBase(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const Generator &elementalGenerator,
+ [[maybe_unused]] mlir::Value initialCondition) {
+ mlir::Value shape = builder.createShape(loc, loweredBase);
+ mlir::Value slice = createSlice(builder, loc);
+
+ // Create loop nest for triplets and vector subscripts in column
+ // major order.
+ llvm::SmallVector<mlir::Value> inductionVariables;
+ LoopType outerLoop;
+ for (auto [lb, ub, step] : genLoopBounds(builder, loc)) {
+ LoopType loop;
+ if constexpr (std::is_same_v<LoopType, fir::IterWhileOp>) {
+ loop =
+ builder.create<fir::IterWhileOp>(loc, lb, ub, step, initialCondition);
+ initialCondition = loop.getIterateVar();
+ if (!outerLoop)
+ outerLoop = loop;
+ else
+ builder.create<fir::ResultOp>(loc, loop.getResult(0));
+ } else {
+ loop =
+ builder.create<fir::DoLoopOp>(loc, lb, ub, step, /*unordered=*/false);
+ if (!outerLoop)
+ outerLoop = loop;
+ }
+ builder.setInsertionPointToStart(loop.getBody());
+ inductionVariables.push_back(loop.getInductionVar());
+ }
+ assert(outerLoop && !inductionVariables.empty() &&
+ "at least one loop should be created");
+
+ fir::ExtendedValue elem =
+ getElementAt(builder, loc, shape, slice, inductionVariables);
+
+ if constexpr (std::is_same_v<LoopType, fir::IterWhileOp>) {
+ auto res = elementalGenerator(elem);
+ builder.create<fir::ResultOp>(loc, res);
+ builder.setInsertionPointAfter(outerLoop);
+ return outerLoop.getResult(0);
+ } else {
+ elementalGenerator(elem);
+ builder.setInsertionPointAfter(outerLoop);
+ return {};
+ }
+}
+
+void Fortran::lower::VectorSubscriptBox::loopOverElements(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const ElementalGenerator &elementalGenerator) {
+ mlir::Value initialCondition;
+ loopOverElementsBase<fir::DoLoopOp, ElementalGenerator>(
+ builder, loc, elementalGenerator, initialCondition);
+}
+
+mlir::Value Fortran::lower::VectorSubscriptBox::loopOverElementsWhile(
+ fir::FirOpBuilder &builder, mlir::Location loc,
+ const ElementalGeneratorWithBoolReturn &elementalGenerator,
+ mlir::Value initialCondition) {
+ return loopOverElementsBase<fir::IterWhileOp,
+ ElementalGeneratorWithBoolReturn>(
+ builder, loc, elementalGenerator, initialCondition);
+}
+
+mlir::Value
+Fortran::lower::VectorSubscriptBox::createSlice(fir::FirOpBuilder &builder,
+ mlir::Location loc) {
+ mlir::Type idxTy = builder.getIndexType();
+ llvm::SmallVector<mlir::Value> triples;
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ auto undef = builder.create<fir::UndefOp>(loc, idxTy);
+ for (const LoweredSubscript &subscript : loweredSubscripts)
+ std::visit(Fortran::common::visitors{
+ [&](const LoweredTriplet &triplet) {
+ triples.emplace_back(triplet.lb);
+ triples.emplace_back(triplet.ub);
+ triples.emplace_back(triplet.stride);
+ },
+ [&](const LoweredVectorSubscript &vector) {
+ triples.emplace_back(one);
+ triples.emplace_back(vector.size);
+ triples.emplace_back(one);
+ },
+ [&](const mlir::Value &i) {
+ triples.emplace_back(i);
+ triples.emplace_back(undef);
+ triples.emplace_back(undef);
+ },
+ },
+ subscript);
+ return builder.create<fir::SliceOp>(loc, triples, componentPath);
+}
+
+llvm::SmallVector<std::tuple<mlir::Value, mlir::Value, mlir::Value>>
+Fortran::lower::VectorSubscriptBox::genLoopBounds(fir::FirOpBuilder &builder,
+ mlir::Location loc) {
+ mlir::Type idxTy = builder.getIndexType();
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0);
+ llvm::SmallVector<std::tuple<mlir::Value, mlir::Value, mlir::Value>> bounds;
+ size_t dimension = loweredSubscripts.size();
+ for (const LoweredSubscript &subscript : llvm::reverse(loweredSubscripts)) {
+ --dimension;
+ if (std::holds_alternative<mlir::Value>(subscript))
+ continue;
+ mlir::Value lb, ub, step;
+ if (const auto *triplet = std::get_if<LoweredTriplet>(&subscript)) {
+ mlir::Value extent = builder.genExtentFromTriplet(
+ loc, triplet->lb, triplet->ub, triplet->stride, idxTy);
+ mlir::Value baseLb = fir::factory::readLowerBound(
+ builder, loc, loweredBase, dimension, one);
+ baseLb = builder.createConvert(loc, idxTy, baseLb);
+ lb = baseLb;
+ ub = builder.create<mlir::arith::SubIOp>(loc, idxTy, extent, one);
+ ub = builder.create<mlir::arith::AddIOp>(loc, idxTy, ub, baseLb);
+ step = one;
+ } else {
+ const auto &vector = std::get<LoweredVectorSubscript>(subscript);
+ lb = zero;
+ ub = builder.create<mlir::arith::SubIOp>(loc, idxTy, vector.size, one);
+ step = one;
+ }
+ bounds.emplace_back(lb, ub, step);
+ }
+ return bounds;
+}
+
+fir::ExtendedValue Fortran::lower::VectorSubscriptBox::getElementAt(
+ fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value shape,
+ mlir::Value slice, mlir::ValueRange inductionVariables) {
+ /// Generate the indexes for the array_coor inside the loops.
+ mlir::Type idxTy = builder.getIndexType();
+ llvm::SmallVector<mlir::Value> indexes;
+ size_t inductionIdx = inductionVariables.size() - 1;
+ for (const LoweredSubscript &subscript : loweredSubscripts)
+ std::visit(Fortran::common::visitors{
+ [&](const LoweredTriplet &triplet) {
+ indexes.emplace_back(inductionVariables[inductionIdx--]);
+ },
+ [&](const LoweredVectorSubscript &vector) {
+ mlir::Value vecIndex = inductionVariables[inductionIdx--];
+ mlir::Value vecBase = fir::getBase(vector.vector);
+ mlir::Type vecEleTy = fir::unwrapSequenceType(
+ fir::unwrapPassByRefType(vecBase.getType()));
+ mlir::Type refTy = builder.getRefType(vecEleTy);
+ auto vecEltRef = builder.create<fir::CoordinateOp>(
+ loc, refTy, vecBase, vecIndex);
+ auto vecElt =
+ builder.create<fir::LoadOp>(loc, vecEleTy, vecEltRef);
+ indexes.emplace_back(
+ builder.createConvert(loc, idxTy, vecElt));
+ },
+ [&](const mlir::Value &i) {
+ indexes.emplace_back(builder.createConvert(loc, idxTy, i));
+ },
+ },
+ subscript);
+ mlir::Type refTy = builder.getRefType(getElementType());
+ auto elementAddr = builder.create<fir::ArrayCoorOp>(
+ loc, refTy, fir::getBase(loweredBase), shape, slice, indexes,
+ fir::getTypeParams(loweredBase));
+ fir::ExtendedValue element = fir::factory::arraySectionElementToExtendedValue(
+ builder, loc, loweredBase, elementAddr, slice);
+ if (!substringBounds.empty()) {
+ const fir::CharBoxValue *charBox = element.getCharBox();
+ assert(charBox && "substring requires CharBox base");
+ fir::factory::CharacterExprHelper helper{builder, loc};
+ return helper.createSubstring(*charBox, substringBounds);
+ }
+ return element;
+}
diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt
index 9c20db02efb75..2d4ea740a5e68 100644
--- a/flang/lib/Optimizer/Transforms/CMakeLists.txt
+++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt
@@ -9,6 +9,7 @@ add_flang_library(FIRTransforms
MemoryAllocation.cpp
MemRefDataFlowOpt.cpp
RewriteLoop.cpp
+ SimplifyRegionLite.cpp
DEPENDS
FIRBuilder
diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp
index f46df8b2a7ef0..a28aecfab93e2 100644
--- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp
+++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp
@@ -155,8 +155,9 @@ class CfgIfConv : public mlir::OpRewritePattern<fir::IfOp> {
if (ifOp.getNumResults() == 0) {
continueBlock = remainingOpsBlock;
} else {
- continueBlock =
- rewriter.createBlock(remainingOpsBlock, ifOp.getResultTypes());
+ continueBlock = rewriter.createBlock(
+ remainingOpsBlock, ifOp.getResultTypes(),
+ llvm::SmallVector<mlir::Location>(ifOp.getNumResults(), loc));
rewriter.create<mlir::cf::BranchOp>(loc, remainingOpsBlock);
}
diff --git a/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp b/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp
new file mode 100644
index 0000000000000..369d7c8d9a10e
--- /dev/null
+++ b/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp
@@ -0,0 +1,47 @@
+//===- SimplifyRegionLite.cpp -- region simplification lite ---------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "PassDetail.h"
+#include "flang/Optimizer/Dialect/FIROps.h"
+#include "flang/Optimizer/Transforms/Passes.h"
+#include "mlir/IR/PatternMatch.h"
+#include "mlir/Pass/Pass.h"
+#include "mlir/Transforms/DialectConversion.h"
+#include "mlir/Transforms/GreedyPatternRewriteDriver.h"
+#include "mlir/Transforms/RegionUtils.h"
+
+namespace {
+
+class SimplifyRegionLitePass
+ : public fir::SimplifyRegionLiteBase<SimplifyRegionLitePass> {
+public:
+ void runOnOperation() override;
+};
+
+class DummyRewriter : public mlir::PatternRewriter {
+public:
+ DummyRewriter(mlir::MLIRContext *ctx) : mlir::PatternRewriter(ctx) {}
+};
+
+} // namespace
+
+void SimplifyRegionLitePass::runOnOperation() {
+ auto op = getOperation();
+ auto regions = op->getRegions();
+ mlir::RewritePatternSet patterns(op.getContext());
+ DummyRewriter rewriter(op.getContext());
+ if (regions.empty())
+ return;
+
+ (void)mlir::eraseUnreachableBlocks(rewriter, regions);
+ (void)mlir::runRegionDCE(rewriter, regions);
+}
+
+std::unique_ptr<mlir::Pass> fir::createSimplifyRegionLitePass() {
+ return std::make_unique<SimplifyRegionLitePass>();
+}
diff --git a/flang/test/Lower/vector-subscript-io.f90 b/flang/test/Lower/vector-subscript-io.f90
new file mode 100644
index 0000000000000..8399bfe10b96c
--- /dev/null
+++ b/flang/test/Lower/vector-subscript-io.f90
@@ -0,0 +1,581 @@
+! Test lowering of IO input items with vector subscripts
+! RUN: bbc %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPsimple(
+! CHECK-SAME: %[[VAL_20:.*]]: !fir.ref<!fir.array<10xi32>>{{.*}}, %[[VAL_16:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}) {
+subroutine simple(x, y)
+ integer :: y(3)
+ integer :: x(10)
+ read(*,*) x(y)
+ ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 10 : index
+ ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 4 : i32
+ ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_6:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_7:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_1]], %[[VAL_8]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
+ ! CHECK: %[[VAL_11:.*]] = fir.slice %[[VAL_6]], %[[VAL_4]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_5]], %[[VAL_4]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_12:.*]]: index, %[[VAL_13:.*]]: index):
+ ! CHECK: %[[VAL_14:.*]] = arith.cmpi sgt, %[[VAL_13]], %[[VAL_5]] : index
+ ! CHECK: cf.cond_br %[[VAL_14]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_12]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_15]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> index
+ ! CHECK: %[[VAL_19:.*]] = fir.array_coor %[[VAL_20]](%[[VAL_10]]) {{\[}}%[[VAL_11]]] %[[VAL_18]] : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_9]], %[[VAL_21]], %[[VAL_3]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_12]], %[[VAL_6]] : index
+ ! CHECK: %[[VAL_24:.*]] = arith.subi %[[VAL_13]], %[[VAL_6]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_23]], %[[VAL_24]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_9]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPonly_once(
+ ! CHECK-SAME: %[[VAL_51:.*]]: !fir.box<!fir.array<?x?xf32>>{{.*}}) {
+ subroutine only_once(x)
+ interface
+ function get_vector()
+ integer, allocatable :: get_vector(:)
+ end function
+ integer function get_substcript()
+ end function
+ end interface
+ real :: x(:, :)
+ ! Test subscripts are only evaluated once.
+ read(*,*) x(get_substcript(), get_vector())
+ ! CHECK-DAG: %[[VAL_26:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_28:.*]] = arith.constant 0 : i64
+ ! CHECK-DAG: %[[VAL_29:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_30:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_31:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {bindc_name = ".result"}
+ ! CHECK: %[[VAL_32:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_26]], %[[VAL_33]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_35:.*]] = fir.call @_QPget_substcript() : () -> i32
+ ! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_35]] : (i32) -> i64
+ ! CHECK: %[[VAL_37:.*]] = fir.call @_QPget_vector() : () -> !fir.box<!fir.heap<!fir.array<?xi32>>>
+ ! CHECK: fir.save_result %[[VAL_37]] to %[[VAL_31]] : !fir.box<!fir.heap<!fir.array<?xi32>>>, !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+ ! CHECK: %[[VAL_38:.*]] = fir.load %[[VAL_31]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+ ! CHECK: %[[VAL_39:.*]]:3 = fir.box_dims %[[VAL_38]], %[[VAL_29]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_40:.*]] = fir.box_addr %[[VAL_38]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+ ! CHECK: %[[VAL_41:.*]] = fir.undefined index
+ ! CHECK: %[[VAL_42:.*]] = fir.slice %[[VAL_36]], %[[VAL_41]], %[[VAL_41]], %[[VAL_30]], %[[VAL_39]]#1, %[[VAL_30]] : (i64, index, index, index, index, index) -> !fir.slice<2>
+ ! CHECK: cf.br ^bb1(%[[VAL_29]], %[[VAL_39]]#1 : index, index)
+ ! CHECK: ^bb1(%[[VAL_43:.*]]: index, %[[VAL_44:.*]]: index):
+ ! CHECK: %[[VAL_45:.*]] = arith.cmpi sgt, %[[VAL_44]], %[[VAL_29]] : index
+ ! CHECK: cf.cond_br %[[VAL_45]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_35]] : (i32) -> index
+ ! CHECK: %[[VAL_47:.*]] = fir.coordinate_of %[[VAL_40]], %[[VAL_43]] : (!fir.heap<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_48:.*]] = fir.load %[[VAL_47]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_49:.*]] = fir.convert %[[VAL_48]] : (i32) -> index
+ ! CHECK: %[[VAL_50:.*]] = fir.array_coor %[[VAL_51]] {{\[}}%[[VAL_42]]] %[[VAL_46]], %[[VAL_49]] : (!fir.box<!fir.array<?x?xf32>>, !fir.slice<2>, index, index) -> !fir.ref<f32>
+ ! CHECK: %[[VAL_52:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_34]], %[[VAL_50]]) : (!fir.ref<i8>, !fir.ref<f32>) -> i1
+ ! CHECK: %[[VAL_53:.*]] = arith.addi %[[VAL_43]], %[[VAL_30]] : index
+ ! CHECK: %[[VAL_54:.*]] = arith.subi %[[VAL_44]], %[[VAL_30]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_53]], %[[VAL_54]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_55:.*]] = fir.load %[[VAL_31]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+ ! CHECK: %[[VAL_56:.*]] = fir.box_addr %[[VAL_55]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+ ! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_56]] : (!fir.heap<!fir.array<?xi32>>) -> i64
+ ! CHECK: %[[VAL_58:.*]] = arith.cmpi ne, %[[VAL_57]], %[[VAL_28]] : i64
+ ! CHECK: cf.cond_br %[[VAL_58]], ^bb4, ^bb5
+ ! CHECK: ^bb4:
+ ! CHECK: fir.freemem %[[VAL_56]]
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_59:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_34]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPwith_assumed_shapes(
+ ! CHECK-SAME: %[[VAL_78:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}, %[[VAL_69:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}) {
+ subroutine with_assumed_shapes(x, y)
+ integer :: y(:)
+ integer :: x(:)
+ read(*,*) x(y)
+ ! CHECK-DAG: %[[VAL_60:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_62:.*]] = arith.constant 4 : i32
+ ! CHECK-DAG: %[[VAL_63:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_64:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_65:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_66:.*]] = fir.convert %[[VAL_65]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_67:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_60]], %[[VAL_66]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_68:.*]]:3 = fir.box_dims %[[VAL_69]], %[[VAL_63]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_70:.*]] = fir.slice %[[VAL_64]], %[[VAL_68]]#1, %[[VAL_64]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_63]], %[[VAL_68]]#1 : index, index)
+ ! CHECK: ^bb1(%[[VAL_71:.*]]: index, %[[VAL_72:.*]]: index):
+ ! CHECK: %[[VAL_73:.*]] = arith.cmpi sgt, %[[VAL_72]], %[[VAL_63]] : index
+ ! CHECK: cf.cond_br %[[VAL_73]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_69]], %[[VAL_71]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_75:.*]] = fir.load %[[VAL_74]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_76:.*]] = fir.convert %[[VAL_75]] : (i32) -> index
+ ! CHECK: %[[VAL_77:.*]] = fir.array_coor %[[VAL_78]] {{\[}}%[[VAL_70]]] %[[VAL_76]] : (!fir.box<!fir.array<?xi32>>, !fir.slice<1>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_79:.*]] = fir.convert %[[VAL_77]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_80:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_67]], %[[VAL_79]], %[[VAL_62]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: %[[VAL_81:.*]] = arith.addi %[[VAL_71]], %[[VAL_64]] : index
+ ! CHECK: %[[VAL_82:.*]] = arith.subi %[[VAL_72]], %[[VAL_64]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_81]], %[[VAL_82]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_83:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_67]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPlower_bounds(
+ ! CHECK-SAME: %[[VAL_108:.*]]: !fir.ref<!fir.array<4x6xi32>>{{.*}}, %[[VAL_104:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}) {
+ subroutine lower_bounds(x, y)
+ integer :: y(3)
+ integer :: x(2:5,3:8)
+ read(*,*) x(3, y)
+ ! CHECK-DAG: %[[VAL_84:.*]] = arith.constant 4 : index
+ ! CHECK-DAG: %[[VAL_85:.*]] = arith.constant 6 : index
+ ! CHECK-DAG: %[[VAL_86:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_88:.*]] = arith.constant 3 : i64
+ ! CHECK-DAG: %[[VAL_89:.*]] = arith.constant 2 : index
+ ! CHECK-DAG: %[[VAL_90:.*]] = arith.constant 4 : i32
+ ! CHECK-DAG: %[[VAL_91:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_92:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_93:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_94:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_95:.*]] = fir.convert %[[VAL_94]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_96:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_86]], %[[VAL_95]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_97:.*]] = fir.shape_shift %[[VAL_89]], %[[VAL_84]], %[[VAL_91]], %[[VAL_85]] : (index, index, index, index) -> !fir.shapeshift<2>
+ ! CHECK: %[[VAL_98:.*]] = fir.undefined index
+ ! CHECK: %[[VAL_99:.*]] = fir.slice %[[VAL_88]], %[[VAL_98]], %[[VAL_98]], %[[VAL_93]], %[[VAL_91]], %[[VAL_93]] : (i64, index, index, index, index, index) -> !fir.slice<2>
+ ! CHECK: cf.br ^bb1(%[[VAL_92]], %[[VAL_91]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_100:.*]]: index, %[[VAL_101:.*]]: index):
+ ! CHECK: %[[VAL_102:.*]] = arith.cmpi sgt, %[[VAL_101]], %[[VAL_92]] : index
+ ! CHECK: cf.cond_br %[[VAL_102]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_103:.*]] = fir.coordinate_of %[[VAL_104]], %[[VAL_100]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_105:.*]] = fir.load %[[VAL_103]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_106:.*]] = fir.convert %[[VAL_105]] : (i32) -> index
+ ! CHECK: %[[VAL_107:.*]] = fir.array_coor %[[VAL_108]](%[[VAL_97]]) {{\[}}%[[VAL_99]]] %[[VAL_91]], %[[VAL_106]] : (!fir.ref<!fir.array<4x6xi32>>, !fir.shapeshift<2>, !fir.slice<2>, index, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_109:.*]] = fir.convert %[[VAL_107]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_110:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_96]], %[[VAL_109]], %[[VAL_90]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: %[[VAL_111:.*]] = arith.addi %[[VAL_100]], %[[VAL_93]] : index
+ ! CHECK: %[[VAL_112:.*]] = arith.subi %[[VAL_101]], %[[VAL_93]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_111]], %[[VAL_112]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_113:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_96]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPtwo_vectors(
+ ! CHECK-SAME: %[[VAL_140:.*]]: !fir.ref<!fir.array<4x4xf32>>{{.*}}, %[[VAL_132:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}, %[[VAL_136:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}) {
+ subroutine two_vectors(x, y1, y2)
+ integer :: y1(3), y2(3)
+ real :: x(4, 4)
+ read(*,*) x(y1, y2)
+ ! CHECK-DAG: %[[VAL_114:.*]] = arith.constant 4 : index
+ ! CHECK-DAG: %[[VAL_115:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_117:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_118:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_119:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_120:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_121:.*]] = fir.convert %[[VAL_120]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_122:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_115]], %[[VAL_121]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_123:.*]] = fir.shape %[[VAL_114]], %[[VAL_114]] : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_124:.*]] = fir.slice %[[VAL_119]], %[[VAL_117]], %[[VAL_119]], %[[VAL_119]], %[[VAL_117]], %[[VAL_119]] : (index, index, index, index, index, index) -> !fir.slice<2>
+ ! CHECK: cf.br ^bb1(%[[VAL_118]], %[[VAL_117]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_125:.*]]: index, %[[VAL_126:.*]]: index):
+ ! CHECK: %[[VAL_127:.*]] = arith.cmpi sgt, %[[VAL_126]], %[[VAL_118]] : index
+ ! CHECK: cf.cond_br %[[VAL_127]], ^bb2(%[[VAL_118]], %[[VAL_117]] : index, index), ^bb5
+ ! CHECK: ^bb2(%[[VAL_128:.*]]: index, %[[VAL_129:.*]]: index):
+ ! CHECK: %[[VAL_130:.*]] = arith.cmpi sgt, %[[VAL_129]], %[[VAL_118]] : index
+ ! CHECK: cf.cond_br %[[VAL_130]], ^bb3, ^bb4
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_131:.*]] = fir.coordinate_of %[[VAL_132]], %[[VAL_128]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_133:.*]] = fir.load %[[VAL_131]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_134:.*]] = fir.convert %[[VAL_133]] : (i32) -> index
+ ! CHECK: %[[VAL_135:.*]] = fir.coordinate_of %[[VAL_136]], %[[VAL_125]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_137:.*]] = fir.load %[[VAL_135]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_138:.*]] = fir.convert %[[VAL_137]] : (i32) -> index
+ ! CHECK: %[[VAL_139:.*]] = fir.array_coor %[[VAL_140]](%[[VAL_123]]) {{\[}}%[[VAL_124]]] %[[VAL_134]], %[[VAL_138]] : (!fir.ref<!fir.array<4x4xf32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<f32>
+ ! CHECK: %[[VAL_141:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_122]], %[[VAL_139]]) : (!fir.ref<i8>, !fir.ref<f32>) -> i1
+ ! CHECK: %[[VAL_142:.*]] = arith.addi %[[VAL_128]], %[[VAL_119]] : index
+ ! CHECK: %[[VAL_143:.*]] = arith.subi %[[VAL_129]], %[[VAL_119]] : index
+ ! CHECK: cf.br ^bb2(%[[VAL_142]], %[[VAL_143]] : index, index)
+ ! CHECK: ^bb4:
+ ! CHECK: %[[VAL_144:.*]] = arith.addi %[[VAL_125]], %[[VAL_119]] : index
+ ! CHECK: %[[VAL_145:.*]] = arith.subi %[[VAL_126]], %[[VAL_119]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_144]], %[[VAL_145]] : index, index)
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_146:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_122]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPtriplets_and_vector(
+ ! CHECK-SAME: %[[VAL_170:.*]]: !fir.ref<!fir.array<4x4x!fir.complex<4>>>{{.*}}, %[[VAL_166:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}) {
+ subroutine triplets_and_vector(x, y)
+ integer :: y(3)
+ complex :: x(4, 4)
+ read(*,*) x(1:4:2, y)
+ ! CHECK-DAG: %[[VAL_147:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_149:.*]] = arith.constant 4 : index
+ ! CHECK-DAG: %[[VAL_150:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_151:.*]] = arith.constant 2 : index
+ ! CHECK-DAG: %[[VAL_152:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_153:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_154:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_155:.*]] = fir.convert %[[VAL_154]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_156:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_147]], %[[VAL_155]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_157:.*]] = fir.shape %[[VAL_149]], %[[VAL_149]] : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_158:.*]] = fir.slice %[[VAL_153]], %[[VAL_149]], %[[VAL_151]], %[[VAL_153]], %[[VAL_150]], %[[VAL_153]] : (index, index, index, index, index, index) -> !fir.slice<2>
+ ! CHECK: cf.br ^bb1(%[[VAL_152]], %[[VAL_150]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_159:.*]]: index, %[[VAL_160:.*]]: index):
+ ! CHECK: %[[VAL_161:.*]] = arith.cmpi sgt, %[[VAL_160]], %[[VAL_152]] : index
+ ! CHECK: cf.cond_br %[[VAL_161]], ^bb2(%[[VAL_153]], %[[VAL_151]] : index, index), ^bb5
+ ! CHECK: ^bb2(%[[VAL_162:.*]]: index, %[[VAL_163:.*]]: index):
+ ! CHECK: %[[VAL_164:.*]] = arith.cmpi sgt, %[[VAL_163]], %[[VAL_152]] : index
+ ! CHECK: cf.cond_br %[[VAL_164]], ^bb3, ^bb4
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_165:.*]] = fir.coordinate_of %[[VAL_166]], %[[VAL_159]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_167:.*]] = fir.load %[[VAL_165]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_168:.*]] = fir.convert %[[VAL_167]] : (i32) -> index
+ ! CHECK: %[[VAL_169:.*]] = fir.array_coor %[[VAL_170]](%[[VAL_157]]) {{\[}}%[[VAL_158]]] %[[VAL_162]], %[[VAL_168]] : (!fir.ref<!fir.array<4x4x!fir.complex<4>>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<!fir.complex<4>>
+ ! CHECK: %[[VAL_171:.*]] = fir.convert %[[VAL_169]] : (!fir.ref<!fir.complex<4>>) -> !fir.ref<f32>
+ ! CHECK: %[[VAL_172:.*]] = fir.call @_FortranAioInputComplex32(%[[VAL_156]], %[[VAL_171]]) : (!fir.ref<i8>, !fir.ref<f32>) -> i1
+ ! CHECK: %[[VAL_173:.*]] = arith.addi %[[VAL_162]], %[[VAL_153]] : index
+ ! CHECK: %[[VAL_174:.*]] = arith.subi %[[VAL_163]], %[[VAL_153]] : index
+ ! CHECK: cf.br ^bb2(%[[VAL_173]], %[[VAL_174]] : index, index)
+ ! CHECK: ^bb4:
+ ! CHECK: %[[VAL_175:.*]] = arith.addi %[[VAL_159]], %[[VAL_153]] : index
+ ! CHECK: %[[VAL_176:.*]] = arith.subi %[[VAL_160]], %[[VAL_153]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_175]], %[[VAL_176]] : index, index)
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_177:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_156]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPsimple_char(
+ ! CHECK-SAME: %[[VAL_185:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_196:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}) {
+ subroutine simple_char(x, y)
+ integer :: y(3)
+ character(*) :: x(3:8)
+ read(*,*) x(y)
+ ! CHECK-DAG: %[[VAL_178:.*]] = arith.constant 6 : index
+ ! CHECK-DAG: %[[VAL_179:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_181:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_182:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_183:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_184:.*]]:2 = fir.unboxchar %[[VAL_185]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK: %[[VAL_186:.*]] = fir.convert %[[VAL_184]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<6x!fir.char<1,?>>>
+ ! CHECK: %[[VAL_187:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_188:.*]] = fir.convert %[[VAL_187]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_189:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_179]], %[[VAL_188]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_190:.*]] = fir.shape_shift %[[VAL_181]], %[[VAL_178]] : (index, index) -> !fir.shapeshift<1>
+ ! CHECK: %[[VAL_191:.*]] = fir.slice %[[VAL_183]], %[[VAL_181]], %[[VAL_183]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_182]], %[[VAL_181]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_192:.*]]: index, %[[VAL_193:.*]]: index):
+ ! CHECK: %[[VAL_194:.*]] = arith.cmpi sgt, %[[VAL_193]], %[[VAL_182]] : index
+ ! CHECK: cf.cond_br %[[VAL_194]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_195:.*]] = fir.coordinate_of %[[VAL_196]], %[[VAL_192]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_197:.*]] = fir.load %[[VAL_195]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_198:.*]] = fir.convert %[[VAL_197]] : (i32) -> index
+ ! CHECK: %[[VAL_199:.*]] = fir.array_coor %[[VAL_186]](%[[VAL_190]]) {{\[}}%[[VAL_191]]] %[[VAL_198]] typeparams %[[VAL_184]]#1 : (!fir.ref<!fir.array<6x!fir.char<1,?>>>, !fir.shapeshift<1>, !fir.slice<1>, index, index) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[VAL_200:.*]] = fir.convert %[[VAL_199]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_201:.*]] = fir.convert %[[VAL_184]]#1 : (index) -> i64
+ ! CHECK: %[[VAL_202:.*]] = fir.call @_FortranAioInputAscii(%[[VAL_189]], %[[VAL_200]], %[[VAL_201]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+ ! CHECK: %[[VAL_203:.*]] = arith.addi %[[VAL_192]], %[[VAL_183]] : index
+ ! CHECK: %[[VAL_204:.*]] = arith.subi %[[VAL_193]], %[[VAL_183]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_203]], %[[VAL_204]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_205:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_189]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPsubstring(
+ ! CHECK-SAME: %[[VAL_229:.*]]: !fir.box<!fir.array<?x!fir.char<1,?>>>{{.*}}, %[[VAL_225:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}, %[[VAL_215:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_218:.*]]: !fir.ref<i32>{{.*}}) {
+ subroutine substring(x, y, i, j)
+ integer :: y(3), i, j
+ character(*) :: x(:)
+ read(*,*) x(y)(i:j)
+ ! CHECK-DAG: %[[VAL_206:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_208:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_209:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_210:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_211:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_212:.*]] = fir.convert %[[VAL_211]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_213:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_206]], %[[VAL_212]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_214:.*]] = fir.load %[[VAL_215]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_216:.*]] = fir.convert %[[VAL_214]] : (i32) -> index
+ ! CHECK: %[[VAL_217:.*]] = fir.load %[[VAL_218]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_219:.*]] = fir.convert %[[VAL_217]] : (i32) -> index
+ ! CHECK: %[[VAL_220:.*]] = fir.slice %[[VAL_210]], %[[VAL_208]], %[[VAL_210]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_209]], %[[VAL_208]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_221:.*]]: index, %[[VAL_222:.*]]: index):
+ ! CHECK: %[[VAL_223:.*]] = arith.cmpi sgt, %[[VAL_222]], %[[VAL_209]] : index
+ ! CHECK: cf.cond_br %[[VAL_223]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_224:.*]] = fir.coordinate_of %[[VAL_225]], %[[VAL_221]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_226:.*]] = fir.load %[[VAL_224]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_227:.*]] = fir.convert %[[VAL_226]] : (i32) -> index
+ ! CHECK: %[[VAL_228:.*]] = fir.array_coor %[[VAL_229]] {{\[}}%[[VAL_220]]] %[[VAL_227]] : (!fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.slice<1>, index) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[VAL_230:.*]] = arith.subi %[[VAL_216]], %[[VAL_210]] : index
+ ! CHECK: %[[VAL_231:.*]] = fir.convert %[[VAL_228]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<?x!fir.char<1>>>
+ ! CHECK: %[[VAL_232:.*]] = fir.coordinate_of %[[VAL_231]], %[[VAL_230]] : (!fir.ref<!fir.array<?x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+ ! CHECK: %[[VAL_233:.*]] = fir.convert %[[VAL_232]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
+ ! CHECK: %[[VAL_234:.*]] = arith.subi %[[VAL_219]], %[[VAL_216]] : index
+ ! CHECK: %[[VAL_235:.*]] = arith.addi %[[VAL_234]], %[[VAL_210]] : index
+ ! CHECK: %[[VAL_236:.*]] = arith.cmpi slt, %[[VAL_235]], %[[VAL_209]] : index
+ ! CHECK: %[[VAL_237:.*]] = arith.select %[[VAL_236]], %[[VAL_209]], %[[VAL_235]] : index
+ ! CHECK: %[[VAL_238:.*]] = fir.convert %[[VAL_233]] : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_239:.*]] = fir.convert %[[VAL_237]] : (index) -> i64
+ ! CHECK: %[[VAL_240:.*]] = fir.call @_FortranAioInputAscii(%[[VAL_213]], %[[VAL_238]], %[[VAL_239]]) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+ ! CHECK: %[[VAL_241:.*]] = arith.addi %[[VAL_221]], %[[VAL_210]] : index
+ ! CHECK: %[[VAL_242:.*]] = arith.subi %[[VAL_222]], %[[VAL_210]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_241]], %[[VAL_242]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_243:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_213]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPcomplex_part(
+ ! CHECK-SAME: %[[VAL_262:.*]]: !fir.box<!fir.array<?x!fir.complex<4>>>{{.*}}, %[[VAL_253:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}) {
+ subroutine complex_part(z, y)
+ integer :: y(:)
+ complex :: z(:)
+ read(*,*) z(y)%IM
+ ! CHECK-DAG: %[[VAL_244:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_246:.*]] = arith.constant 1 : i32
+ ! CHECK-DAG: %[[VAL_247:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_248:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_249:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_250:.*]] = fir.convert %[[VAL_249]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_251:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_244]], %[[VAL_250]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_252:.*]]:3 = fir.box_dims %[[VAL_253]], %[[VAL_247]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_254:.*]] = fir.slice %[[VAL_248]], %[[VAL_252]]#1, %[[VAL_248]] path %[[VAL_246]] : (index, index, index, i32) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_247]], %[[VAL_252]]#1 : index, index)
+ ! CHECK: ^bb1(%[[VAL_255:.*]]: index, %[[VAL_256:.*]]: index):
+ ! CHECK: %[[VAL_257:.*]] = arith.cmpi sgt, %[[VAL_256]], %[[VAL_247]] : index
+ ! CHECK: cf.cond_br %[[VAL_257]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_258:.*]] = fir.coordinate_of %[[VAL_253]], %[[VAL_255]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_259:.*]] = fir.load %[[VAL_258]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_260:.*]] = fir.convert %[[VAL_259]] : (i32) -> index
+ ! CHECK: %[[VAL_261:.*]] = fir.array_coor %[[VAL_262]] {{\[}}%[[VAL_254]]] %[[VAL_260]] : (!fir.box<!fir.array<?x!fir.complex<4>>>, !fir.slice<1>, index) -> !fir.ref<f32>
+ ! CHECK: %[[VAL_263:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_251]], %[[VAL_261]]) : (!fir.ref<i8>, !fir.ref<f32>) -> i1
+ ! CHECK: %[[VAL_264:.*]] = arith.addi %[[VAL_255]], %[[VAL_248]] : index
+ ! CHECK: %[[VAL_265:.*]] = arith.subi %[[VAL_256]], %[[VAL_248]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_264]], %[[VAL_265]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_266:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_251]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ module derived_types
+ type t
+ integer :: i
+ character(2) :: c
+ end type
+ type t2
+ type(t) :: a(5,5)
+ end type
+ end module
+
+ ! CHECK-LABEL: func @_QPsimple_derived(
+ ! CHECK-SAME: %[[VAL_287:.*]]: !fir.ref<!fir.array<6x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>>{{.*}}, %[[VAL_283:.*]]: !fir.ref<!fir.array<4xi32>>{{.*}}) {
+ subroutine simple_derived(x, y)
+ use derived_types
+ integer :: y(4)
+ type(t) :: x(3:8)
+ read(*,*) x(y)
+ ! CHECK-DAG: %[[VAL_267:.*]] = arith.constant 6 : index
+ ! CHECK-DAG: %[[VAL_268:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_270:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_271:.*]] = arith.constant 4 : index
+ ! CHECK-DAG: %[[VAL_272:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_273:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_274:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_275:.*]] = fir.convert %[[VAL_274]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_276:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_268]], %[[VAL_275]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_277:.*]] = fir.shape_shift %[[VAL_270]], %[[VAL_267]] : (index, index) -> !fir.shapeshift<1>
+ ! CHECK: %[[VAL_278:.*]] = fir.slice %[[VAL_273]], %[[VAL_271]], %[[VAL_273]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: cf.br ^bb1(%[[VAL_272]], %[[VAL_271]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_279:.*]]: index, %[[VAL_280:.*]]: index):
+ ! CHECK: %[[VAL_281:.*]] = arith.cmpi sgt, %[[VAL_280]], %[[VAL_272]] : index
+ ! CHECK: cf.cond_br %[[VAL_281]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_282:.*]] = fir.coordinate_of %[[VAL_283]], %[[VAL_279]] : (!fir.ref<!fir.array<4xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_284:.*]] = fir.load %[[VAL_282]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_285:.*]] = fir.convert %[[VAL_284]] : (i32) -> index
+ ! CHECK: %[[VAL_286:.*]] = fir.array_coor %[[VAL_287]](%[[VAL_277]]) {{\[}}%[[VAL_278]]] %[[VAL_285]] : (!fir.ref<!fir.array<6x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>>, !fir.shapeshift<1>, !fir.slice<1>, index) -> !fir.ref<!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>
+ ! CHECK: %[[VAL_288:.*]] = fir.embox %[[VAL_286]] : (!fir.ref<!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>) -> !fir.box<!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>
+ ! CHECK: %[[VAL_289:.*]] = fir.convert %[[VAL_288]] : (!fir.box<!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>) -> !fir.box<none>
+ ! CHECK: %[[VAL_290:.*]] = fir.call @_FortranAioInputDescriptor(%[[VAL_276]], %[[VAL_289]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+ ! CHECK: %[[VAL_291:.*]] = arith.addi %[[VAL_279]], %[[VAL_273]] : index
+ ! CHECK: %[[VAL_292:.*]] = arith.subi %[[VAL_280]], %[[VAL_273]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_291]], %[[VAL_292]] : index, index)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_293:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_276]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPwith_path(
+ ! CHECK-SAME: [[VAL_326:.*]]: !fir.box<!fir.array<?x?x?x!fir.type<_QMderived_typesTt2{a:!fir.array<5x5x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>}>>>{{.*}}, [[VAL_310:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}) {
+ subroutine with_path(b, i)
+ use derived_types
+ type(t2) :: b(4:, 4:, 4:)
+ integer :: i(:)
+ read (*, *) b(5, i, 8:9:1)%a(4,5)%i
+ ! CHECK-DAG: %[[VAL_294:.*]] = arith.constant 4 : index
+ ! CHECK-DAG: %[[VAL_295:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_297:.*]] = arith.constant 8 : index
+ ! CHECK-DAG: %[[VAL_298:.*]] = arith.constant 9 : index
+ ! CHECK-DAG: %[[VAL_299:.*]] = arith.constant 4 : i64
+ ! CHECK-DAG: %[[VAL_300:.*]] = arith.constant 5 : i64
+ ! CHECK-DAG: %[[VAL_301:.*]] = arith.constant 5 : index
+ ! CHECK-DAG: %[[VAL_302:.*]] = arith.constant 4 : i32
+ ! CHECK-DAG: %[[VAL_303:.*]] = arith.constant 2 : index
+ ! CHECK-DAG: %[[VAL_304:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_305:.*]] = arith.constant 1 : index
+ ! CHECK: %[[VAL_306:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_307:.*]] = fir.convert %[[VAL_306]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_308:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_295]], %[[VAL_307]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_309:.*]]:3 = fir.box_dims %[[VAL_310:.*]], %[[VAL_304]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_311:.*]] = fir.field_index a, !fir.type<_QMderived_typesTt2{a:!fir.array<5x5x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>}>
+ ! CHECK: %[[VAL_312:.*]] = fir.field_index i, !fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>
+ ! CHECK: %[[VAL_313:.*]] = fir.shift %[[VAL_294]], %[[VAL_294]], %[[VAL_294]] : (index, index, index) -> !fir.shift<3>
+ ! CHECK: %[[VAL_314:.*]] = fir.undefined index
+ ! CHECK: %[[VAL_315:.*]] = fir.slice %[[VAL_300]], %[[VAL_314]], %[[VAL_314]], %[[VAL_305]], %[[VAL_309]]#1, %[[VAL_305]], %[[VAL_297]], %[[VAL_298]], %[[VAL_305]] path %[[VAL_311]], %[[VAL_299]], %[[VAL_300]], %[[VAL_312]] : (i64, index, index, index, index, index, index, index, index, !fir.field, i64, i64, !fir.field) -> !fir.slice<3>
+ ! CHECK: cf.br ^bb1(%[[VAL_294]], %[[VAL_303]] : index, index)
+ ! CHECK: ^bb1(%[[VAL_316:.*]]: index, %[[VAL_317:.*]]: index):
+ ! CHECK: %[[VAL_318:.*]] = arith.cmpi sgt, %[[VAL_317]], %[[VAL_304]] : index
+ ! CHECK: cf.cond_br %[[VAL_318]], ^bb2(%[[VAL_304]], %[[VAL_309]]#1 : index, index), ^bb5
+ ! CHECK: ^bb2(%[[VAL_319:.*]]: index, %[[VAL_320:.*]]: index):
+ ! CHECK: %[[VAL_321:.*]] = arith.cmpi sgt, %[[VAL_320]], %[[VAL_304]] : index
+ ! CHECK: cf.cond_br %[[VAL_321]], ^bb3, ^bb4
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_322:.*]] = fir.coordinate_of %[[VAL_310]], %[[VAL_319]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_323:.*]] = fir.load %[[VAL_322]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_324:.*]] = fir.convert %[[VAL_323]] : (i32) -> index
+ ! CHECK: %[[VAL_325:.*]] = fir.array_coor %[[VAL_326:.*]](%[[VAL_313]]) {{\[}}%[[VAL_315]]] %[[VAL_301]], %[[VAL_324]], %[[VAL_316]] : (!fir.box<!fir.array<?x?x?x!fir.type<_QMderived_typesTt2{a:!fir.array<5x5x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>}>>>, !fir.shift<3>, !fir.slice<3>, index, index, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_327:.*]] = fir.convert %[[VAL_325]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_328:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_308]], %[[VAL_327]], %[[VAL_302]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: %[[VAL_329:.*]] = arith.addi %[[VAL_319]], %[[VAL_305]] : index
+ ! CHECK: %[[VAL_330:.*]] = arith.subi %[[VAL_320]], %[[VAL_305]] : index
+ ! CHECK: cf.br ^bb2(%[[VAL_329]], %[[VAL_330]] : index, index)
+ ! CHECK: ^bb4:
+ ! CHECK: %[[VAL_331:.*]] = arith.addi %[[VAL_316]], %[[VAL_305]] : index
+ ! CHECK: %[[VAL_332:.*]] = arith.subi %[[VAL_317]], %[[VAL_305]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_331]], %[[VAL_332]] : index, index)
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_333:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_308]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPsimple_iostat(
+ ! CHECK-SAME: %[[VAL_357:.*]]: !fir.box<!fir.array<?xf32>>{{.*}}, %[[VAL_346:.*]]: !fir.box<!fir.array<?xi32>>{{.*}}, %[[VAL_361:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_364:.*]]: !fir.ref<i32>{{.*}}) {
+ subroutine simple_iostat(x, y, j, stat)
+ integer :: j, y(:), stat
+ real :: x(:)
+ read(*, *, iostat=stat) x(y), j
+ ! CHECK-DAG: %[[VAL_334:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_336:.*]] = arith.constant false
+ ! CHECK-DAG: %[[VAL_337:.*]] = arith.constant true
+ ! CHECK-DAG: %[[VAL_338:.*]] = arith.constant 1 : index
+ ! CHECK-DAG: %[[VAL_339:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_340:.*]] = arith.constant 4 : i32
+ ! CHECK: %[[VAL_341:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_342:.*]] = fir.convert %[[VAL_341]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_343:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_334]], %[[VAL_342]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_344:.*]] = fir.call @_FortranAioEnableHandlers(%[[VAL_343]], %[[VAL_337]], %[[VAL_336]], %[[VAL_336]], %[[VAL_336]], %[[VAL_336]]) : (!fir.ref<i8>, i1, i1, i1, i1, i1) -> none
+ ! CHECK: %[[VAL_345:.*]]:3 = fir.box_dims %[[VAL_346]], %[[VAL_339]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+ ! CHECK: %[[VAL_347:.*]] = fir.slice %[[VAL_338]], %[[VAL_345]]#1, %[[VAL_338]] : (index, index, index) -> !fir.slice<1>
+ ! CHECK: %[[VAL_348:.*]] = arith.subi %[[VAL_345]]#1, %[[VAL_338]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_339]], %[[VAL_337]] : index, i1)
+ ! CHECK: ^bb1(%[[VAL_349:.*]]: index, %[[VAL_350:.*]]: i1):
+ ! CHECK: %[[VAL_351:.*]] = arith.cmpi sle, %[[VAL_349]], %[[VAL_348]] : index
+ ! CHECK: %[[VAL_352:.*]] = arith.andi %[[VAL_350]], %[[VAL_351]] : i1
+ ! CHECK: cf.cond_br %[[VAL_352]], ^bb2, ^bb3
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_353:.*]] = fir.coordinate_of %[[VAL_346]], %[[VAL_349]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_354:.*]] = fir.load %[[VAL_353]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_355:.*]] = fir.convert %[[VAL_354]] : (i32) -> index
+ ! CHECK: %[[VAL_356:.*]] = fir.array_coor %[[VAL_357]] {{\[}}%[[VAL_347]]] %[[VAL_355]] : (!fir.box<!fir.array<?xf32>>, !fir.slice<1>, index) -> !fir.ref<f32>
+ ! CHECK: %[[VAL_358:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_343]], %[[VAL_356]]) : (!fir.ref<i8>, !fir.ref<f32>) -> i1
+ ! CHECK: %[[VAL_359:.*]] = arith.addi %[[VAL_349]], %[[VAL_338]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_359]], %[[VAL_358]] : index, i1)
+ ! CHECK: ^bb3:
+ ! CHECK: cf.cond_br %[[VAL_350]], ^bb4, ^bb5
+ ! CHECK: ^bb4:
+ ! CHECK: %[[VAL_360:.*]] = fir.convert %[[VAL_361]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_362:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_343]], %[[VAL_360]], %[[VAL_340]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: cf.br ^bb5
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_363:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_343]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: fir.store %[[VAL_363]] to %[[VAL_364]] : !fir.ref<i32>
+ ! CHECK: return
+ end subroutine
+
+ ! CHECK-LABEL: func @_QPiostat_in_io_loop(
+ ! CHECK-SAME: %[[VAL_400:.*]]: !fir.ref<!fir.array<3x5xi32>>{{.*}}, %[[VAL_396:.*]]: !fir.ref<!fir.array<3xi32>>{{.*}}, %[[VAL_408:.*]]: !fir.ref<i32>{{.*}}) {
+ subroutine iostat_in_io_loop(k, j, stat)
+ integer :: k(3, 5)
+ integer :: j(3)
+ integer :: stat
+ read(*, *, iostat=stat) (k(i, j), i=1,3,1)
+ ! CHECK-DAG: %[[VAL_365:.*]] = arith.constant 5 : index
+ ! CHECK-DAG: %[[VAL_366:.*]] = arith.constant -1 : i32
+ ! CHECK-DAG: %[[VAL_368:.*]] = arith.constant 3 : index
+ ! CHECK-DAG: %[[VAL_369:.*]] = arith.constant true
+ ! CHECK-DAG: %[[VAL_370:.*]] = arith.constant false
+ ! CHECK-DAG: %[[VAL_371:.*]] = arith.constant 1 : index
+ ! CHECK-DAG: %[[VAL_372:.*]] = arith.constant 0 : index
+ ! CHECK-DAG: %[[VAL_373:.*]] = arith.constant 2 : index
+ ! CHECK-DAG: %[[VAL_374:.*]] = arith.constant 4 : i32
+ ! CHECK: %[[VAL_375:.*]] = fir.alloca i32
+ ! CHECK: %[[VAL_376:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ ! CHECK: %[[VAL_377:.*]] = fir.convert %[[VAL_376]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_378:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_366]], %[[VAL_377]], %{{.*}}) : (i32, !fir.ref<i8>, i32) -> !fir.ref<i8>
+ ! CHECK: %[[VAL_379:.*]] = fir.call @_FortranAioEnableHandlers(%[[VAL_378]], %[[VAL_369]], %[[VAL_370]], %[[VAL_370]], %[[VAL_370]], %[[VAL_370]]) : (!fir.ref<i8>, i1, i1, i1, i1, i1) -> none
+ ! CHECK: cf.br ^bb1(%[[VAL_371]], %[[VAL_369]] : index, i1)
+ ! CHECK: ^bb1(%[[VAL_380:.*]]: index, %[[VAL_381:.*]]: i1):
+ ! CHECK: %[[VAL_382:.*]] = arith.cmpi sle, %[[VAL_380]], %[[VAL_368]] : index
+ ! CHECK: %[[VAL_383:.*]] = arith.andi %[[VAL_381]], %[[VAL_382]] : i1
+ ! CHECK: cf.cond_br %[[VAL_383]], ^bb2, ^bb7
+ ! CHECK: ^bb2:
+ ! CHECK: %[[VAL_384:.*]] = fir.convert %[[VAL_380]] : (index) -> i32
+ ! CHECK: fir.store %[[VAL_384]] to %[[VAL_375]] : !fir.ref<i32>
+ ! CHECK: cf.cond_br %[[VAL_381]], ^bb3, ^bb6(%[[VAL_370]] : i1)
+ ! CHECK: ^bb3:
+ ! CHECK: %[[VAL_385:.*]] = fir.load %[[VAL_375]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_386:.*]] = fir.convert %[[VAL_385]] : (i32) -> i64
+ ! CHECK: %[[VAL_387:.*]] = fir.shape %[[VAL_368]], %[[VAL_365]] : (index, index) -> !fir.shape<2>
+ ! CHECK: %[[VAL_388:.*]] = fir.undefined index
+ ! CHECK: %[[VAL_389:.*]] = fir.slice %[[VAL_386]], %[[VAL_388]], %[[VAL_388]], %[[VAL_371]], %[[VAL_368]], %[[VAL_371]] : (i64, index, index, index, index, index) -> !fir.slice<2>
+ ! CHECK: cf.br ^bb4(%[[VAL_372]], %[[VAL_369]] : index, i1)
+ ! CHECK: ^bb4(%[[VAL_390:.*]]: index, %[[VAL_391:.*]]: i1):
+ ! CHECK: %[[VAL_392:.*]] = arith.cmpi sle, %[[VAL_390]], %[[VAL_373]] : index
+ ! CHECK: %[[VAL_393:.*]] = arith.andi %[[VAL_391]], %[[VAL_392]] : i1
+ ! CHECK: cf.cond_br %[[VAL_393]], ^bb5, ^bb6(%[[VAL_391]] : i1)
+ ! CHECK: ^bb5:
+ ! CHECK: %[[VAL_394:.*]] = fir.convert %[[VAL_385]] : (i32) -> index
+ ! CHECK: %[[VAL_395:.*]] = fir.coordinate_of %[[VAL_396]], %[[VAL_390]] : (!fir.ref<!fir.array<3xi32>>, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_397:.*]] = fir.load %[[VAL_395]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_398:.*]] = fir.convert %[[VAL_397]] : (i32) -> index
+ ! CHECK: %[[VAL_399:.*]] = fir.array_coor %[[VAL_400]](%[[VAL_387]]) {{\[}}%[[VAL_389]]] %[[VAL_394]], %[[VAL_398]] : (!fir.ref<!fir.array<3x5xi32>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref<i32>
+ ! CHECK: %[[VAL_401:.*]] = fir.convert %[[VAL_399]] : (!fir.ref<i32>) -> !fir.ref<i64>
+ ! CHECK: %[[VAL_402:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_378]], %[[VAL_401]], %[[VAL_374]]) : (!fir.ref<i8>, !fir.ref<i64>, i32) -> i1
+ ! CHECK: %[[VAL_403:.*]] = arith.addi %[[VAL_390]], %[[VAL_371]] : index
+ ! CHECK: cf.br ^bb4(%[[VAL_403]], %[[VAL_402]] : index, i1)
+ ! CHECK: ^bb6(%[[VAL_404:.*]]: i1):
+ ! CHECK: %[[VAL_405:.*]] = arith.addi %[[VAL_380]], %[[VAL_371]] : index
+ ! CHECK: cf.br ^bb1(%[[VAL_405]], %[[VAL_404]] : index, i1)
+ ! CHECK: ^bb7:
+ ! CHECK: %[[VAL_406:.*]] = fir.convert %[[VAL_380]] : (index) -> i32
+ ! CHECK: fir.store %[[VAL_406]] to %[[VAL_375]] : !fir.ref<i32>
+ ! CHECK: %[[VAL_407:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_378]]) : (!fir.ref<i8>) -> i32
+ ! CHECK: fir.store %[[VAL_407]] to %[[VAL_408]] : !fir.ref<i32>
+ ! CHECK: return
+ end subroutine
More information about the flang-commits
mailing list