diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -427,6 +427,10 @@ /// if the argument is an integer, into llvm intrinsics if the argument is /// real and to the `hypot` math routine if the argument is of complex type. mlir::Value genAbs(mlir::Type, llvm::ArrayRef); + template + fir::ExtendedValue genAdjustRtCall(mlir::Type, + llvm::ArrayRef); mlir::Value genAimag(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAll(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genAllocated(mlir::Type, @@ -562,6 +566,14 @@ /// should be provided for all the intrinsic arguments for completeness. static constexpr IntrinsicHandler handlers[]{ {"abs", &I::genAbs}, + {"adjustl", + &I::genAdjustRtCall, + {{{"string", asAddr}}}, + /*isElemental=*/true}, + {"adjustr", + &I::genAdjustRtCall, + {{{"string", asAddr}}}, + /*isElemental=*/true}, {"aimag", &I::genAimag}, {"all", &I::genAll, @@ -1430,6 +1442,37 @@ llvm_unreachable("unexpected type in ABS argument"); } +// ADJUSTL & ADJUSTR +template +fir::ExtendedValue +IntrinsicLibrary::genAdjustRtCall(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1); + mlir::Value string = builder.createBox(loc, args[0]); + // Create a mutable fir.box to be passed to the runtime for the result. + fir::MutableBoxValue resultMutableBox = + fir::factory::createTempMutableBox(builder, loc, resultType); + mlir::Value resultIrBox = + fir::factory::getMutableIRBox(builder, loc, resultMutableBox); + + // Call the runtime -- the runtime will allocate the result. + CallRuntime(builder, loc, resultIrBox, string); + + // Read result from mutable fir.box and add it to the list of temps to be + // finalized by the StatementContext. + fir::ExtendedValue res = + fir::factory::genMutableBoxRead(builder, loc, resultMutableBox); + return res.match( + [&](const fir::CharBoxValue &box) -> fir::ExtendedValue { + addCleanUpForTemp(loc, fir::getBase(box)); + return box; + }, + [&](const auto &) -> fir::ExtendedValue { + fir::emitFatalError(loc, "result of ADJUSTL is not a scalar character"); + }); +} + // AIMAG mlir::Value IntrinsicLibrary::genAimag(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/Intrinsics/adjustl.f90 b/flang/test/Lower/Intrinsics/adjustl.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/adjustl.f90 @@ -0,0 +1,19 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABLE: adjustl_test +subroutine adjustl_test + character(len=12) :: adjust_str = ' 0123456789' + ! CHECK: %[[strBox:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[addr0:.*]] = fir.address_of(@_QFadjustl{{.*}}) : !fir.ref> + ! CHECK: %[[eBox:.*]] = fir.embox %[[addr0]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[r0:.*]] = fir.zero_bits !fir.heap> + ! CHECK: %[[r1:.*]] = fir.embox %[[r0]] typeparams %{{.*}} : (!fir.heap>, index) -> !fir.box>> + ! CHECK: fir.store %[[r1]] to %[[strBox]] : !fir.ref>>> + ! CHECK: %[[r2:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[r3:.*]] = fir.convert %[[strBox]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: %[[r4:.*]] = fir.convert %[[eBox]] : (!fir.box>) -> !fir.box + ! CHECK: %[[r5:.*]] = fir.convert %[[r2]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[r6:.*]] = fir.call @_FortranAAdjustl(%[[r3]], %[[r4]], %[[r5]], %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + adjust_str = adjustl(adjust_str) + end subroutine + \ No newline at end of file diff --git a/flang/test/Lower/Intrinsics/adjustr.f90 b/flang/test/Lower/Intrinsics/adjustr.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/adjustr.f90 @@ -0,0 +1,19 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s + +! CHECK-LABLE: adjustr_test +subroutine adjustr_test + character(len=12) :: adjust_str = '0123456789 ' + ! CHECK: %[[strBox:.*]] = fir.alloca !fir.box>> + ! CHECK: %[[addr0:.*]] = fir.address_of(@_QFadjustr{{.*}}) : !fir.ref> + ! CHECK: %[[eBox:.*]] = fir.embox %[[addr0]] : (!fir.ref>) -> !fir.box> + ! CHECK: %[[r0:.*]] = fir.zero_bits !fir.heap> + ! CHECK: %[[r1:.*]] = fir.embox %[[r0]] typeparams %{{.*}} : (!fir.heap>, index) -> !fir.box>> + ! CHECK: fir.store %[[r1]] to %[[strBox]] : !fir.ref>>> + ! CHECK: %[[r2:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[r3:.*]] = fir.convert %[[strBox]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK: %[[r4:.*]] = fir.convert %[[eBox]] : (!fir.box>) -> !fir.box + ! CHECK: %[[r5:.*]] = fir.convert %[[r2]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[r6:.*]] = fir.call @_FortranAAdjustr(%[[r3]], %[[r4]], %[[r5]], %{{.*}}) : (!fir.ref>, !fir.box, !fir.ref, i32) -> none + adjust_str = adjustr(adjust_str) + end subroutine + \ No newline at end of file