diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index 977a69af52813..0e7219d856660 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -333,6 +333,8 @@ struct IntrinsicLibrary { llvm::ArrayRef); mlir::Value genScale(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genScan(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genSelectedCharKind(mlir::Type, + llvm::ArrayRef); mlir::Value genSelectedIntKind(mlir::Type, llvm::ArrayRef); mlir::Value genSelectedRealKind(mlir::Type, llvm::ArrayRef); mlir::Value genSetExponent(mlir::Type resultType, diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h b/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h index fec8c9906effe..8309f36815b81 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Numeric.h @@ -46,6 +46,10 @@ mlir::Value genRRSpacing(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value genScale(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value x, mlir::Value i); +/// Generate call to Selected_char_kind intrinsic runtime routine. +mlir::Value genSelectedCharKind(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value name, mlir::Value length); + /// Generate call to Selected_int_kind intrinsic runtime routine. mlir::Value genSelectedIntKind(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value x); diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index ae7e650987448..f7ec017708cd3 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -549,6 +549,10 @@ static constexpr IntrinsicHandler handlers[]{ {"back", asValue, handleDynamicOptional}, {"kind", asValue}}}, /*isElemental=*/true}, + {"selected_char_kind", + &I::genSelectedCharKind, + {{{"name", asAddr}}}, + /*isElemental=*/false}, {"selected_int_kind", &I::genSelectedIntKind, {{{"scalar", asAddr}}}, @@ -5873,6 +5877,18 @@ IntrinsicLibrary::genScan(mlir::Type resultType, return readAndAddCleanUp(resultMutableBox, resultType, "SCAN"); } +// SELECTED_CHAR_KIND +fir::ExtendedValue +IntrinsicLibrary::genSelectedCharKind(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + + return builder.createConvert( + loc, resultType, + fir::runtime::genSelectedCharKind(builder, loc, fir::getBase(args[0]), + fir::getLen(args[0]))); +} + // SELECTED_INT_KIND mlir::Value IntrinsicLibrary::genSelectedIntKind(mlir::Type resultType, diff --git a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp index 81d5d21ece7ae..aa39cc416159a 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Numeric.cpp @@ -468,6 +468,26 @@ mlir::Value fir::runtime::genScale(fir::FirOpBuilder &builder, return builder.create(loc, func, args).getResult(0); } +/// Generate call to Selected_char_kind intrinsic runtime routine. +mlir::Value fir::runtime::genSelectedCharKind(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value name, + mlir::Value length) { + mlir::func::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + auto fTy = func.getFunctionType(); + auto sourceFile = fir::factory::locationToFilename(builder, loc); + auto sourceLine = + fir::factory::locationToLineNo(builder, loc, fTy.getInput(1)); + if (!fir::isa_ref_type(name.getType())) + fir::emitFatalError(loc, "argument address for runtime not found"); + + auto args = fir::runtime::createArguments(builder, loc, fTy, sourceFile, + sourceLine, name, length); + + return builder.create(loc, func, args).getResult(0); +} + /// Generate call to Selected_int_kind intrinsic runtime routine. mlir::Value fir::runtime::genSelectedIntKind(fir::FirOpBuilder &builder, mlir::Location loc, diff --git a/flang/test/Lower/Intrinsics/selected_char_kind.f90 b/flang/test/Lower/Intrinsics/selected_char_kind.f90 new file mode 100644 index 0000000000000..4012591f22867 --- /dev/null +++ b/flang/test/Lower/Intrinsics/selected_char_kind.f90 @@ -0,0 +1,17 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +subroutine selected_char_kind_test(c) + character(*) :: c + integer :: res + res = selected_char_kind(c) +end + +! CHECK-LABEL: func.func @_QPselected_char_kind_test( +! CHECK-SAME: %[[ARG0:.*]]: !fir.boxchar<1> {fir.bindc_name = "c"}) +! CHECK: %[[UNBOXCHAR:.*]]:2 = fir.unboxchar %[[ARG0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[C:.*]]:2 = hlfir.declare %[[UNBOXCHAR]]#0 typeparams %[[UNBOXCHAR]]#1 dummy_scope %0 {uniq_name = "_QFselected_char_kind_testEc"} : (!fir.ref>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref>) +! CHECK: %[[RES_ALLOCA:.*]] = fir.alloca i32 {bindc_name = "res", uniq_name = "_QFselected_char_kind_testEres"} +! CHECK: %[[RES:.*]]:2 = hlfir.declare %[[RES_ALLOCA]] {uniq_name = "_QFselected_char_kind_testEres"} : (!fir.ref) -> (!fir.ref, !fir.ref) +! CHECK: %[[CHAR_PTR:.*]] = fir.convert %[[C]]#1 : (!fir.ref>) -> !fir.ref +! CHECK: %[[CHAR_LEN:.*]] = fir.convert %[[UNBOXCHAR]]#1 : (index) -> i64 +! CHECK: %{{.*}} = fir.call @_FortranASelectedCharKind(%{{.*}}, %{{.*}}, %[[CHAR_PTR]], %[[CHAR_LEN]]) fastmath : (!fir.ref, i32, !fir.ref, i64) -> i32