diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Character.h b/flang/include/flang/Optimizer/Builder/Runtime/Character.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Optimizer/Builder/Runtime/Character.h @@ -0,0 +1,134 @@ +//===-- Character.h -- generate calls to character runtime API --*- 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 +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_CHARACTER_H +#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_CHARACTER_H + +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +namespace fir { +class ExtendedValue; +class FirOpBuilder; +} // namespace fir + +namespace fir::runtime { + +/// Generate a call to the `ADJUSTL` runtime. +/// This calls the simple runtime entry point that then calls into the more +/// complex runtime cases handling left or right adjustments. +/// +/// \p resultBox must be an unallocated allocatable used for the temporary +/// result. \p StringBox must be a fir.box describing the adjustl string +/// argument. Note that the \p genAdjust() helper is called to do the majority +/// of the lowering work. +void genAdjustL(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox); + +/// Generate a call to the `ADJUSTR` runtime. +/// This calls the simple runtime entry point that then calls into the more +/// complex runtime cases handling left or right adjustments. +/// +/// \p resultBox must be an unallocated allocatable used for the temporary +/// result. \p StringBox must be a fir.box describing the adjustr string +/// argument. Note that the \p genAdjust() helper is called to do the majority +/// of the lowering work. +void genAdjustR(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox); + +/// Generate a call to the `ADJUST[L|R]` runtime. +/// +/// \p resultBox must be an unallocated allocatable used for the temporary +/// result. \p StringBox must be a fir.box describing the adjustr string +/// argument. The \p adjustFunc should be a mlir::FuncOp for the appropriate +/// runtime entry function. +void genAdjust(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::FuncOp &adjustFunc); + +/// Generate call to a character comparison for two ssa-values of type +/// `boxchar`. +mlir::Value genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::arith::CmpIPredicate cmp, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs); + +/// Generate call to a character comparison op for two unboxed variables. There +/// are 4 arguments, 2 for the lhs and 2 for the rhs. Each CHARACTER must pass a +/// reference to its buffer (`ref>`) and its LEN type parameter (some +/// integral type). +mlir::Value genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::arith::CmpIPredicate cmp, mlir::Value lhsBuff, + mlir::Value lhsLen, mlir::Value rhsBuff, + mlir::Value rhsLen); + +/// Generate call to INDEX runtime. +/// This calls the simple runtime entry points based on the KIND of the string. +/// No descriptors are used. +mlir::Value genIndex(fir::FirOpBuilder &builder, mlir::Location loc, int kind, + mlir::Value stringBase, mlir::Value stringLen, + mlir::Value substringBase, mlir::Value substringLen, + mlir::Value back); + +/// Generate call to INDEX runtime. +/// This calls the descriptor based runtime call implementation for the index +/// intrinsic. +void genIndexDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::Value substringBox, mlir::Value backOpt, + mlir::Value kind); + +/// Generate call to repeat runtime. +/// \p resultBox must be an unallocated allocatable used for the temporary +/// result. \p stringBox must be a fir.box describing repeat string argument. +/// \p ncopies must be a value representing the number of copies. +/// The runtime will always allocate the resultBox. +void genRepeat(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::Value ncopies); + +/// Generate call to trim runtime. +/// \p resultBox must be an unallocated allocatable used for the temporary +/// result. \p stringBox must be a fir.box describing trim string argument. +/// The runtime will always allocate the resultBox. +void genTrim(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox); + +/// Generate call to scan runtime. +/// This calls the descriptor based runtime call implementation of the scan +/// intrinsics. +void genScanDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::Value setBox, mlir::Value backBox, + mlir::Value kind); + +/// Generate call to the scan runtime routine that is specialized on +/// \param kind. +/// The \param kind represents the kind of the elements in the strings. +mlir::Value genScan(fir::FirOpBuilder &builder, mlir::Location loc, int kind, + mlir::Value stringBase, mlir::Value stringLen, + mlir::Value setBase, mlir::Value setLen, mlir::Value back); + +/// Generate call to verify runtime. +/// This calls the descriptor based runtime call implementation of the scan +/// intrinsics. +void genVerifyDescriptor(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::Value setBox, mlir::Value backBox, + mlir::Value kind); + +/// Generate call to the verify runtime routine that is specialized on +/// \param kind. +/// The \param kind represents the kind of the elements in the strings. +mlir::Value genVerify(fir::FirOpBuilder &builder, mlir::Location loc, int kind, + mlir::Value stringBase, mlir::Value stringLen, + mlir::Value setBase, mlir::Value setLen, + mlir::Value back); + +} // namespace fir::runtime + +#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_CHARACTER_H diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -8,6 +8,7 @@ FIRBuilder.cpp MutableBox.cpp Runtime/Assign.cpp + Runtime/Character.cpp Runtime/Reduction.cpp Runtime/Transformational.cpp diff --git a/flang/lib/Optimizer/Builder/Runtime/Character.cpp b/flang/lib/Optimizer/Builder/Runtime/Character.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Builder/Runtime/Character.cpp @@ -0,0 +1,293 @@ +//===-- Character.cpp -- runtime for CHARACTER type entities --------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/Runtime/Character.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Optimizer/Builder/Runtime/RTBuilder.h" +#include "flang/Runtime/character.h" +#include "mlir/Dialect/StandardOps/IR/Ops.h" + +using namespace Fortran::runtime; + +/// Generate calls to string handling intrinsics such as index, scan, and +/// verify. These are the descriptor based implementations that take four +/// arguments (string1, string2, back, kind). +template +static void genCharacterSearch(FN func, fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value resultBox, + mlir::Value string1Box, mlir::Value string2Box, + mlir::Value backBox, mlir::Value kind); + +/// Helper function to recover the KIND from the FIR type. +static int discoverKind(mlir::Type ty) { + if (auto charTy = ty.dyn_cast()) + return charTy.getFKind(); + if (auto eleTy = fir::dyn_cast_ptrEleTy(ty)) + return discoverKind(eleTy); + if (auto arrTy = ty.dyn_cast()) + return discoverKind(arrTy.getEleTy()); + if (auto boxTy = ty.dyn_cast()) + return discoverKind(boxTy.getEleTy()); + if (auto boxTy = ty.dyn_cast()) + return discoverKind(boxTy.getEleTy()); + llvm_unreachable("unexpected character type"); +} + +//===----------------------------------------------------------------------===// +// Lower character operations +//===----------------------------------------------------------------------===// + +void fir::runtime::genAdjustL(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox) { + auto adjustFunc = + fir::runtime::getRuntimeFunc(loc, builder); + fir::runtime::genAdjust(builder, loc, resultBox, stringBox, adjustFunc); +} + +void fir::runtime::genAdjustR(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox) { + auto adjustFunc = + fir::runtime::getRuntimeFunc(loc, builder); + fir::runtime::genAdjust(builder, loc, resultBox, stringBox, adjustFunc); +} + +void fir::runtime::genAdjust(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::FuncOp &adjustFunc) { + + auto fTy = adjustFunc.getType(); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(3)); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox, + stringBox, sourceFile, sourceLine); + builder.create(loc, adjustFunc, args); +} + +mlir::Value +fir::runtime::genCharCompare(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::arith::CmpIPredicate cmp, + mlir::Value lhsBuff, mlir::Value lhsLen, + mlir::Value rhsBuff, mlir::Value rhsLen) { + mlir::FuncOp beginFunc; + switch (discoverKind(lhsBuff.getType())) { + case 1: + beginFunc = fir::runtime::getRuntimeFunc( + loc, builder); + break; + case 2: + beginFunc = fir::runtime::getRuntimeFunc( + loc, builder); + break; + case 4: + beginFunc = fir::runtime::getRuntimeFunc( + loc, builder); + break; + default: + llvm_unreachable("runtime does not support CHARACTER KIND"); + } + auto fTy = beginFunc.getType(); + auto args = fir::runtime::createArguments(builder, loc, fTy, lhsBuff, rhsBuff, + lhsLen, rhsLen); + auto tri = builder.create(loc, beginFunc, args).getResult(0); + auto zero = builder.createIntegerConstant(loc, tri.getType(), 0); + return builder.create(loc, cmp, tri, zero); +} + +mlir::Value fir::runtime::genCharCompare(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::arith::CmpIPredicate cmp, + const fir::ExtendedValue &lhs, + const fir::ExtendedValue &rhs) { + if (lhs.getBoxOf() || rhs.getBoxOf()) + TODO(loc, "character compare from descriptors"); + auto allocateIfNotInMemory = [&](mlir::Value base) -> mlir::Value { + if (fir::isa_ref_type(base.getType())) + return base; + auto mem = + builder.create(loc, base.getType(), /*pinned=*/false); + builder.create(loc, base, mem); + return mem; + }; + auto lhsBuffer = allocateIfNotInMemory(fir::getBase(lhs)); + auto rhsBuffer = allocateIfNotInMemory(fir::getBase(rhs)); + return genCharCompare(builder, loc, cmp, lhsBuffer, fir::getLen(lhs), + rhsBuffer, fir::getLen(rhs)); +} + +mlir::Value fir::runtime::genIndex(fir::FirOpBuilder &builder, + mlir::Location loc, int kind, + mlir::Value stringBase, + mlir::Value stringLen, + mlir::Value substringBase, + mlir::Value substringLen, mlir::Value back) { + mlir::FuncOp indexFunc; + switch (kind) { + case 1: + indexFunc = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 2: + indexFunc = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 4: + indexFunc = fir::runtime::getRuntimeFunc(loc, builder); + break; + default: + fir::emitFatalError( + loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4."); + } + auto fTy = indexFunc.getType(); + auto args = + fir::runtime::createArguments(builder, loc, fTy, stringBase, stringLen, + substringBase, substringLen, back); + return builder.create(loc, indexFunc, args).getResult(0); +} + +void fir::runtime::genIndexDescriptor(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value resultBox, + mlir::Value stringBox, + mlir::Value substringBox, + mlir::Value backOpt, mlir::Value kind) { + auto indexFunc = fir::runtime::getRuntimeFunc(loc, builder); + genCharacterSearch(indexFunc, builder, loc, resultBox, stringBox, + substringBox, backOpt, kind); +} + +void fir::runtime::genRepeat(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox, + mlir::Value ncopies) { + auto repeatFunc = fir::runtime::getRuntimeFunc(loc, builder); + auto fTy = repeatFunc.getType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(4)); + + auto args = fir::runtime::createArguments( + builder, loc, fTy, resultBox, stringBox, ncopies, sourceFile, sourceLine); + builder.create(loc, repeatFunc, args); +} + +void fir::runtime::genTrim(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value resultBox, mlir::Value stringBox) { + auto trimFunc = fir::runtime::getRuntimeFunc(loc, builder); + auto fTy = trimFunc.getType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(3)); + + auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox, + stringBox, sourceFile, sourceLine); + builder.create(loc, trimFunc, args); +} + +/// Generate call to scan runtime routine. +/// This calls the descriptor based runtime call implementation of the scan +/// intrinsic. +void fir::runtime::genScanDescriptor(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value resultBox, + mlir::Value stringBox, mlir::Value setBox, + mlir::Value backBox, mlir::Value kind) { + auto func = fir::runtime::getRuntimeFunc(loc, builder); + genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox, + kind); +} + +/// Generate call to scan runtime routine that is specialized on +/// \param kind. +/// The \param kind represents the kind of the elements in the strings. +mlir::Value fir::runtime::genScan(fir::FirOpBuilder &builder, + mlir::Location loc, int kind, + mlir::Value stringBase, mlir::Value stringLen, + mlir::Value setBase, mlir::Value setLen, + mlir::Value back) { + mlir::FuncOp func; + switch (kind) { + case 1: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 2: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 4: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + default: + fir::emitFatalError( + loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4."); + } + auto fTy = func.getType(); + auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase, + stringLen, setBase, setLen, back); + return builder.create(loc, func, args).getResult(0); +} + +/// Generate call to verify runtime routine. +/// This calls the descriptor based runtime call implementation of the +/// verify intrinsic. +void fir::runtime::genVerifyDescriptor(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value resultBox, + mlir::Value stringBox, + mlir::Value setBox, mlir::Value backBox, + mlir::Value kind) { + auto func = fir::runtime::getRuntimeFunc(loc, builder); + genCharacterSearch(func, builder, loc, resultBox, stringBox, setBox, backBox, + kind); +} + +/// Generate call to verify runtime routine that is specialized on +/// \param kind. +/// The \param kind represents the kind of the elements in the strings. +mlir::Value fir::runtime::genVerify(fir::FirOpBuilder &builder, + mlir::Location loc, int kind, + mlir::Value stringBase, + mlir::Value stringLen, mlir::Value setBase, + mlir::Value setLen, mlir::Value back) { + mlir::FuncOp func; + switch (kind) { + case 1: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 2: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + case 4: + func = fir::runtime::getRuntimeFunc(loc, builder); + break; + default: + fir::emitFatalError( + loc, "unsupported CHARACTER kind value. Runtime expects 1, 2, or 4."); + } + auto fTy = func.getType(); + auto args = fir::runtime::createArguments(builder, loc, fTy, stringBase, + stringLen, setBase, setLen, back); + return builder.create(loc, func, args).getResult(0); +} + +/// Generate calls to string handling intrinsics such as index, scan, and +/// verify. These are the descriptor based implementations that take four +/// arguments (string1, string2, back, kind). +template +static void genCharacterSearch(FN func, fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value resultBox, + mlir::Value string1Box, mlir::Value string2Box, + mlir::Value backBox, mlir::Value kind) { + + auto fTy = func.getType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(6)); + + auto args = fir::runtime::createArguments(builder, loc, fTy, resultBox, + string1Box, string2Box, backBox, + kind, sourceFile, sourceLine); + builder.create(loc, func, args); +} diff --git a/flang/unittests/Optimizer/Builder/Runtime/CharacterTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CharacterTest.cpp new file mode 100644 --- /dev/null +++ b/flang/unittests/Optimizer/Builder/Runtime/CharacterTest.cpp @@ -0,0 +1,181 @@ +//===- CharacterTest.cpp -- Character runtime builder unit tests ----------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Optimizer/Builder/Runtime/Character.h" +#include "RuntimeCallTestBase.h" +#include "gtest/gtest.h" + +TEST_F(RuntimeCallTest, genAdjustLTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value result = firBuilder->create(loc, boxTy); + mlir::Value string = firBuilder->create(loc, boxTy); + fir::runtime::genAdjustL(*firBuilder, loc, result, string); + checkCallOpFromResultBox(result, "_FortranAAdjustl", 2); +} + +TEST_F(RuntimeCallTest, genAdjustRTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value result = firBuilder->create(loc, boxTy); + mlir::Value string = firBuilder->create(loc, boxTy); + fir::runtime::genAdjustR(*firBuilder, loc, result, string); + checkCallOpFromResultBox(result, "_FortranAAdjustr", 2); +} + +void checkCharCompare( + fir::FirOpBuilder &builder, mlir::Type type, llvm::StringRef fctName) { + auto loc = builder.getUnknownLoc(); + mlir::Type i32Ty = IntegerType::get(builder.getContext(), 32); + mlir::Value lhsBuff = builder.create(loc, type); + mlir::Value lhsLen = builder.create(loc, i32Ty); + mlir::Value rhsBuff = builder.create(loc, type); + mlir::Value rhsLen = builder.create(loc, i32Ty); + mlir::Value res = fir::runtime::genCharCompare(builder, loc, + mlir::arith::CmpIPredicate::eq, lhsBuff, lhsLen, rhsBuff, rhsLen); + checkCallOpFromResultBox(lhsBuff, fctName, 4, /*addLocArgs=*/false); + EXPECT_TRUE(mlir::isa(res.getDefiningOp())); +} + +void checkCharCompareAllTypeForKind( + fir::FirOpBuilder &builder, llvm::StringRef fctName, unsigned kind) { + mlir::Type charTy = fir::CharacterType::get(builder.getContext(), kind, 10); + mlir::Type seqCharTy = fir::SequenceType::get(charTy, 10); + mlir::Type refCharTy = fir::ReferenceType::get(charTy); + mlir::Type boxCharTy = fir::BoxCharType::get(builder.getContext(), kind); + mlir::Type boxTy = fir::BoxType::get(charTy); + checkCharCompare(builder, charTy, fctName); + checkCharCompare(builder, seqCharTy, fctName); + checkCharCompare(builder, refCharTy, fctName); + checkCharCompare(builder, boxCharTy, fctName); + checkCharCompare(builder, boxTy, fctName); +} + +TEST_F(RuntimeCallTest, genCharCompareTest) { + checkCharCompareAllTypeForKind( + *firBuilder, "_FortranACharacterCompareScalar1", 1); + checkCharCompareAllTypeForKind( + *firBuilder, "_FortranACharacterCompareScalar2", 2); + checkCharCompareAllTypeForKind( + *firBuilder, "_FortranACharacterCompareScalar4", 4); +} + +void checkGenIndex( + fir::FirOpBuilder &builder, llvm::StringRef fctName, unsigned kind) { + auto loc = builder.getUnknownLoc(); + mlir::Type i32Ty = IntegerType::get(builder.getContext(), 32); + mlir::Value stringBase = builder.create(loc, i32Ty); + mlir::Value stringLen = builder.create(loc, i32Ty); + mlir::Value substringBase = builder.create(loc, i32Ty); + mlir::Value substringLen = builder.create(loc, i32Ty); + mlir::Value back = builder.create(loc, i32Ty); + mlir::Value res = fir::runtime::genIndex(builder, loc, kind, stringBase, + stringLen, substringBase, substringLen, back); + checkCallOp(res.getDefiningOp(), fctName, 5, /*addLocArgs=*/false); +} + +TEST_F(RuntimeCallTest, genIndexTest) { + checkGenIndex(*firBuilder, "_FortranAIndex1", 1); + checkGenIndex(*firBuilder, "_FortranAIndex2", 2); + checkGenIndex(*firBuilder, "_FortranAIndex4", 4); +} + +TEST_F(RuntimeCallTest, genIndexDescriptorTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value resultBox = firBuilder->create(loc, boxTy); + mlir::Value stringBox = firBuilder->create(loc, boxTy); + mlir::Value substringBox = firBuilder->create(loc, boxTy); + mlir::Value backOpt = firBuilder->create(loc, boxTy); + mlir::Value kind = firBuilder->create(loc, i32Ty); + fir::runtime::genIndexDescriptor( + *firBuilder, loc, resultBox, stringBox, substringBox, backOpt, kind); + checkCallOpFromResultBox(resultBox, "_FortranAIndex", 5); +} + +TEST_F(RuntimeCallTest, genRepeatTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value resultBox = firBuilder->create(loc, boxTy); + mlir::Value stringBox = firBuilder->create(loc, boxTy); + mlir::Value ncopies = firBuilder->create(loc, i32Ty); + fir::runtime::genRepeat(*firBuilder, loc, resultBox, stringBox, ncopies); + checkCallOpFromResultBox(resultBox, "_FortranARepeat", 3); +} + +TEST_F(RuntimeCallTest, genTrimTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value resultBox = firBuilder->create(loc, boxTy); + mlir::Value stringBox = firBuilder->create(loc, boxTy); + fir::runtime::genTrim(*firBuilder, loc, resultBox, stringBox); + checkCallOpFromResultBox(resultBox, "_FortranATrim", 2); +} + +TEST_F(RuntimeCallTest, genScanDescriptorTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value resultBox = firBuilder->create(loc, boxTy); + mlir::Value stringBox = firBuilder->create(loc, boxTy); + mlir::Value setBox = firBuilder->create(loc, boxTy); + mlir::Value backBox = firBuilder->create(loc, boxTy); + mlir::Value kind = firBuilder->create(loc, i32Ty); + fir::runtime::genScanDescriptor( + *firBuilder, loc, resultBox, stringBox, setBox, backBox, kind); + checkCallOpFromResultBox(resultBox, "_FortranAScan", 5); +} + +void checkGenScan( + fir::FirOpBuilder &builder, llvm::StringRef fctName, unsigned kind) { + auto loc = builder.getUnknownLoc(); + mlir::Type charTy = fir::CharacterType::get(builder.getContext(), kind, 10); + mlir::Type boxTy = fir::BoxType::get(charTy); + mlir::Type i32Ty = IntegerType::get(builder.getContext(), 32); + mlir::Value stringBase = builder.create(loc, boxTy); + mlir::Value stringLen = builder.create(loc, i32Ty); + mlir::Value setBase = builder.create(loc, boxTy); + mlir::Value setLen = builder.create(loc, i32Ty); + mlir::Value back = builder.create(loc, i32Ty); + mlir::Value res = fir::runtime::genScan( + builder, loc, kind, stringBase, stringLen, setBase, setLen, back); + checkCallOp(res.getDefiningOp(), fctName, 5, /*addLocArgs=*/false); +} + +TEST_F(RuntimeCallTest, genScanTest) { + checkGenScan(*firBuilder, "_FortranAScan1", 1); + checkGenScan(*firBuilder, "_FortranAScan2", 2); + checkGenScan(*firBuilder, "_FortranAScan4", 4); +} + +TEST_F(RuntimeCallTest, genVerifyDescriptorTest) { + auto loc = firBuilder->getUnknownLoc(); + mlir::Value resultBox = firBuilder->create(loc, boxTy); + mlir::Value stringBox = firBuilder->create(loc, boxTy); + mlir::Value setBox = firBuilder->create(loc, boxTy); + mlir::Value backBox = firBuilder->create(loc, boxTy); + mlir::Value kind = firBuilder->create(loc, i32Ty); + fir::runtime::genVerifyDescriptor( + *firBuilder, loc, resultBox, stringBox, setBox, backBox, kind); + checkCallOpFromResultBox(resultBox, "_FortranAVerify", 5); +} + +void checkGenVerify( + fir::FirOpBuilder &builder, llvm::StringRef fctName, unsigned kind) { + auto loc = builder.getUnknownLoc(); + mlir::Type charTy = fir::CharacterType::get(builder.getContext(), kind, 10); + mlir::Type boxTy = fir::BoxType::get(charTy); + mlir::Type i32Ty = IntegerType::get(builder.getContext(), 32); + mlir::Value stringBase = builder.create(loc, boxTy); + mlir::Value stringLen = builder.create(loc, i32Ty); + mlir::Value setBase = builder.create(loc, boxTy); + mlir::Value setLen = builder.create(loc, i32Ty); + mlir::Value back = builder.create(loc, i32Ty); + mlir::Value res = fir::runtime::genVerify( + builder, loc, kind, stringBase, stringLen, setBase, setLen, back); + checkCallOp(res.getDefiningOp(), fctName, 5, /*addLocArgs=*/false); +} + +TEST_F(RuntimeCallTest, genVerifyTest) { + checkGenVerify(*firBuilder, "_FortranAVerify1", 1); + checkGenVerify(*firBuilder, "_FortranAVerify2", 2); + checkGenVerify(*firBuilder, "_FortranAVerify4", 4); +} diff --git a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h --- a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h +++ b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h @@ -50,6 +50,7 @@ c16Ty = fir::ComplexType::get(firBuilder->getContext(), 16); seqTy10 = fir::SequenceType::get(fir::SequenceType::Shape(1, 10), i32Ty); + boxTy = fir::BoxType::get(mlir::NoneType::get(firBuilder->getContext())); } mlir::MLIRContext context; @@ -71,6 +72,7 @@ mlir::Type c10Ty; mlir::Type c16Ty; mlir::Type seqTy10; + mlir::Type boxTy; }; /// Check that the \p op is a `fir::CallOp` operation and its name matches diff --git a/flang/unittests/Optimizer/CMakeLists.txt b/flang/unittests/Optimizer/CMakeLists.txt --- a/flang/unittests/Optimizer/CMakeLists.txt +++ b/flang/unittests/Optimizer/CMakeLists.txt @@ -14,6 +14,7 @@ Builder/DoLoopHelperTest.cpp Builder/FIRBuilderTest.cpp Builder/Runtime/AssignTest.cpp + Builder/Runtime/CharacterTest.cpp Builder/Runtime/ReductionTest.cpp Builder/Runtime/TransformationalTest.cpp FIRContextTest.cpp