[flang-commits] [flang] [flang] Add GETCWD runtime and lowering intrinsics implementation (PR #92746)
jiajie zhang via flang-commits
flang-commits at lists.llvm.org
Mon May 20 06:24:57 PDT 2024
https://github.com/JumpMasterJJ updated https://github.com/llvm/llvm-project/pull/92746
>From bc93acf9e2041018f51b607d4bc4585a670dee43 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 19 May 2024 16:49:14 +0800
Subject: [PATCH 01/10] add getcwd intrinsic
---
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../flang/Optimizer/Builder/Runtime/Command.h | 6 ++++
flang/include/flang/Runtime/command.h | 3 ++
flang/include/flang/Runtime/magic-numbers.h | 5 +++
flang/lib/Evaluate/intrinsics.cpp | 12 ++++++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 36 +++++++++++++++++++
.../lib/Optimizer/Builder/Runtime/Command.cpp | 13 +++++++
flang/runtime/command.cpp | 19 ++++++++++
flang/runtime/stat.h | 1 +
9 files changed, 95 insertions(+), 1 deletion(-)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 977a69af52813..209fb0994af0b 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -232,6 +232,7 @@ struct IntrinsicLibrary {
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genFraction(mlir::Type resultType,
mlir::ArrayRef<mlir::Value> args);
+ fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType, llvm::ArrayRef<fir::ExtendedValue> args);
void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genGetPID(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 976fb3aa0b6fb..24790f7ec55fd 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -53,5 +53,11 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
mlir::Value length, mlir::Value trimName,
mlir::Value errmsg);
+
+/// Generate a call to the GetCwd runtime function which implements
+/// the GETCWD intrinsic.
+mlir::Value genGetCwd(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value c);
+
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index c67d171c8e2f1..996a71af22089 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -55,6 +55,9 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
const Descriptor *value = nullptr, const Descriptor *length = nullptr,
bool trim_name = true, const Descriptor *errmsg = nullptr,
const char *sourceFile = nullptr, int line = 0);
+
+// Calls getcwd()
+std::int32_t RTNAME(GetCwd)(const Descriptor &cwd, const char *sourceFile, int line);
}
} // namespace Fortran::runtime
diff --git a/flang/include/flang/Runtime/magic-numbers.h b/flang/include/flang/Runtime/magic-numbers.h
index 38ccc5e7d3df6..1cded1fd63238 100644
--- a/flang/include/flang/Runtime/magic-numbers.h
+++ b/flang/include/flang/Runtime/magic-numbers.h
@@ -68,6 +68,11 @@ Additional status code for a bad pointer DEALLOCATE.
#endif
#define FORTRAN_RUNTIME_STAT_BAD_POINTER_DEALLOCATION 110
+#if 0
+Status codes for GETCWD.
+#endif
+#define FORTRAN_RUNTIME_STAT_MISSING_CWD 111
+
#if 0
ieee_class_type values
The sequence is that of F18 Clause 17.2p3, but nothing depends on that.
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index ded277877f49d..8a1044d917f67 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -509,6 +509,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"gamma", {{"x", SameReal}}, SameReal},
{"get_team", {{"level", DefaultInt, Rank::scalar, Optionality::optional}},
TeamType, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"getcwd",
+ {{"c", DefaultChar, Rank::scalar, Optionality::required,
+ common::Intent::Out}},
+ AnyInt, Rank::scalar},
{"getpid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
@@ -1398,6 +1402,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
+ {"getcwd",
+ {{"c", DefaultChar, Rank::scalar, Optionality::required,
+ common::Intent::Out},
+ {"status", DefaultInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"move_alloc",
{{"from", SameType, Rank::known, Optionality::required,
common::Intent::InOut},
@@ -2560,7 +2570,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
const std::string &name) const {
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
- static const std::string dualIntrinsic[]{{"etime"}};
+ static const std::string dualIntrinsic[]{{"etime"}, {"getcwd"}};
return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
[&name](const std::string &dualName) {
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index ae7e650987448..1cdd45240df8b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -280,6 +280,10 @@ static constexpr IntrinsicHandler handlers[]{
{"trim_name", asAddr, handleDynamicOptional},
{"errmsg", asBox, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"getcwd",
+ &I::genGetCwd,
+ {{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"getpid", &I::genGetPID},
{"iachar", &I::genIchar},
{"iall",
@@ -3465,6 +3469,38 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
}
+// GETCWD
+fir::ExtendedValue
+IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((args.size() == 1 && resultType.has_value()) ||
+ (args.size() >= 1 && !resultType.has_value()));
+
+ auto cwd = fir::getBase(args[0]);
+ const fir::ExtendedValue &status = args[1];
+
+ auto statusValue = fir::runtime::genGetCwd(builder, loc, cwd);
+
+ // Handle optional status argument.
+ if (!isStaticallyAbsent(status)) {
+ mlir::Value statusAddr = fir::getBase(status);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen(
+ [&]() { builder.createStoreWithConvert(loc, statusValue, statusAddr); })
+ .end();
+ }
+
+ // Function form, return status.
+ if (resultType.has_value()) {
+ return statusValue;
+ }
+
+ // Subroutine form, return none.
+ return {};
+}
+
// GET_COMMAND
void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 4);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 1d719e7bbd9a2..8320d89493b33 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -88,3 +88,16 @@ mlir::Value fir::runtime::genGetEnvVariable(fir::FirOpBuilder &builder,
sourceFile, sourceLine);
return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
}
+
+mlir::Value fir::runtime::genGetCwd(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value cwd) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(GetCwd)>(loc, builder);
+ auto runtimeFuncTy = func.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b573c5dfd797b..b0e7e338717c1 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -239,4 +239,23 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
return StatOk;
}
+std::int32_t RTNAME(GetCwd)(
+ const Descriptor &cwd, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd));
+
+ char *buf = (char *)std::malloc(FILENAME_MAX);
+ if (!buf) {
+ return StatMemAllocation;
+ }
+
+ if (!getcwd(buf, FILENAME_MAX)) {
+ return StatMissingCurrentWorkDirectory;
+ }
+
+ std::int64_t strLen = StringLength(buf);
+ return CopyCharsToDescriptor(cwd, buf, strLen);
+}
+
} // namespace Fortran::runtime
diff --git a/flang/runtime/stat.h b/flang/runtime/stat.h
index 4f46f52ecb294..71faeb027d908 100644
--- a/flang/runtime/stat.h
+++ b/flang/runtime/stat.h
@@ -41,6 +41,7 @@ enum Stat {
StatLocked = FORTRAN_RUNTIME_STAT_LOCKED,
StatLockedOtherImage = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE,
StatMissingEnvVariable = FORTRAN_RUNTIME_STAT_MISSING_ENV_VAR,
+ StatMissingCurrentWorkDirectory = FORTRAN_RUNTIME_STAT_MISSING_CWD,
StatStoppedImage = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE,
StatUnlocked = FORTRAN_RUNTIME_STAT_UNLOCKED,
StatUnlockedFailedImage = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE,
>From 3d2899b55806b9e70560a5c01d24b26ead193997 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 19 May 2024 22:47:54 +0800
Subject: [PATCH 02/10] fix type pattern of getcwd's result
---
flang/lib/Evaluate/intrinsics.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 8a1044d917f67..2613e12f8aa65 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -512,7 +512,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getcwd",
{{"c", DefaultChar, Rank::scalar, Optionality::required,
common::Intent::Out}},
- AnyInt, Rank::scalar},
+ DefaultInt},
{"getpid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
>From c1ab6dff851877f72b501b2a4bc5f4fa814071be Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 19 May 2024 22:48:34 +0800
Subject: [PATCH 03/10] fix out of bound error in getcwd's lowering
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 29 +++++++++----------
1 file changed, 14 insertions(+), 15 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 1cdd45240df8b..b5f228a8f71a8 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -3477,27 +3477,26 @@ IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
(args.size() >= 1 && !resultType.has_value()));
auto cwd = fir::getBase(args[0]);
- const fir::ExtendedValue &status = args[1];
-
auto statusValue = fir::runtime::genGetCwd(builder, loc, cwd);
- // Handle optional status argument.
- if (!isStaticallyAbsent(status)) {
- mlir::Value statusAddr = fir::getBase(status);
- mlir::Value statusIsPresentAtRuntime =
- builder.genIsNotNullAddr(loc, statusAddr);
- builder.genIfThen(loc, statusIsPresentAtRuntime)
- .genThen(
- [&]() { builder.createStoreWithConvert(loc, statusValue, statusAddr); })
- .end();
- }
-
- // Function form, return status.
if (resultType.has_value()) {
+ // Function form, return status.
return statusValue;
+ } else {
+ // Subroutine form, store status and return none.
+ const fir::ExtendedValue &status = args[1];
+ if (!isStaticallyAbsent(status)) {
+ mlir::Value statusAddr = fir::getBase(status);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, statusValue, statusAddr);
+ })
+ .end();
+ }
}
- // Subroutine form, return none.
return {};
}
>From c51519b0216c4791ce412b0136bb9c3a3f9068f2 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Sun, 19 May 2024 23:02:35 +0800
Subject: [PATCH 04/10] add test of getcwd
---
.../test/Lower/Intrinsics/getcwd-function.f90 | 23 ++++++++++
.../test/Lower/Intrinsics/getcwd-optional.f90 | 29 ++++++++++++
flang/test/Lower/Intrinsics/getcwd.f90 | 44 +++++++++++++++++++
3 files changed, 96 insertions(+)
create mode 100644 flang/test/Lower/Intrinsics/getcwd-function.f90
create mode 100644 flang/test/Lower/Intrinsics/getcwd-optional.f90
create mode 100644 flang/test/Lower/Intrinsics/getcwd.f90
diff --git a/flang/test/Lower/Intrinsics/getcwd-function.f90 b/flang/test/Lower/Intrinsics/getcwd-function.f90
new file mode 100644
index 0000000000000..50b64729294fe
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/getcwd-function.f90
@@ -0,0 +1,23 @@
+! Test GETCWD with dynamically optional arguments.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest(
+! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"}) -> i32 {
+integer function test(cwd)
+ CHARACTER(len=255) :: cwd
+ test = getcwd(cwd)
+ ! CHECK-NEXT: %[[c8:.*]] = arith.constant 8 : i32
+ ! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
+ ! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[cwdDeclare:.*]] = fir.declare %[[cwdCast]] typeparams %[[c255]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtestEcwd"} : (!fir.ref<!fir.char<1,255>>, index, !fir.dscope) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[test:.*]] = fir.alloca i32 {bindc_name = "test", uniq_name = "_QFtestEtest"}
+ ! CHECK-NEXT: %[[testAddr:.*]] = fir.declare %[[test]] {uniq_name = "_QFtestEtest"} : (!fir.ref<i32>) -> !fir.ref<i32>
+ ! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
+ ! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
+ ! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_9:.*]], %[[c8]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK-NEXT: fir.store %[[statusValue]] to %[[testAddr]] : !fir.ref<i32>
+ ! CHECK-NEXT: %[[returnValue:.*]] = fir.load %[[testAddr]] : !fir.ref<i32>
+ ! CHECK-NEXT: return %[[returnValue]] : i32
+end function
diff --git a/flang/test/Lower/Intrinsics/getcwd-optional.f90 b/flang/test/Lower/Intrinsics/getcwd-optional.f90
new file mode 100644
index 0000000000000..3e2a221f0c3f9
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/getcwd-optional.f90
@@ -0,0 +1,29 @@
+! Test GETCWD with dynamically optional arguments.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+
+! CHECK-LABEL: func.func @_QPtest(
+! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"},
+! CHECK-SAME: %[[statusArg:.*]]: !fir.ref<i32> {fir.bindc_name = "status", fir.optional}) {
+subroutine test(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER, OPTIONAL :: status
+ call getcwd(cwd, status)
+ ! CHECK-NEXT: %[[c0:.*]] = arith.constant 0 : i64
+ ! CHECK-NEXT: %[[c11:.*]] = arith.constant 11 : i32
+ ! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
+ ! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[cwdDeclare:.*]] = fir.declare %[[cwdCast]] typeparams %[[c255]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFtestEcwd"} : (!fir.ref<!fir.char<1,255>>, index, !fir.dscope) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[statusAddr:.*]] = fir.declare %[[statusArg]] dummy_scope %[[DSCOPE]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFtestEstatus"} : (!fir.ref<i32>, !fir.dscope) -> !fir.ref<i32>
+ ! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
+ ! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
+ ! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_8:.*]], %[[c11]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK-NEXT: %[[statusCast:.*]] = fir.convert %[[statusAddr]] : (!fir.ref<i32>) -> i64
+ ! CHECK-NEXT: %[[isPresent:.*]] = arith.cmpi ne, %[[statusCast]], %[[c0]] : i64
+ ! CHECK-NEXT: fir.if %[[isPresent]] {
+ ! CHECK-NEXT: fir.store %[[statusValue]] to %[[statusAddr]] : !fir.ref<i32>
+ ! CHECK-NEXT: }
+ ! CHECK-NEXT: return
+end subroutine
diff --git a/flang/test/Lower/Intrinsics/getcwd.f90 b/flang/test/Lower/Intrinsics/getcwd.f90
new file mode 100644
index 0000000000000..fe207854aff0a
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/getcwd.f90
@@ -0,0 +1,44 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPcwd_only(
+! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"}) {
+subroutine cwd_only(cwd)
+ CHARACTER(len=255) :: cwd
+ call getcwd(cwd)
+ ! CHECK-NEXT: %[[c7:.*]] = arith.constant 7 : i32
+ ! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
+ ! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[cwdDeclare:.*]] = fir.declare %[[cwdCast]] typeparams %[[c255]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFcwd_onlyEcwd"} : (!fir.ref<!fir.char<1,255>>, index, !fir.dscope) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
+ ! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
+ ! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_7:.*]], %[[c7]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK-NEXT: return
+end subroutine cwd_only
+
+! CHECK-LABEL: func.func @_QPall_arguments(
+! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"},
+! CHECK-SAME: %[[statusArg:.*]]: !fir.ref<i32> {fir.bindc_name = "status"}) {
+subroutine all_arguments(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ call getcwd(cwd, status)
+ ! CHECK-NEXT: %[[c0:.*]] = arith.constant 0 : i64
+ ! CHECK-NEXT: %[[c26:.*]] = arith.constant 26 : i32
+ ! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
+ ! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
+ ! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ ! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[cwdDeclare:.*]] = fir.declare %[[cwdCast]] typeparams %[[c255]] dummy_scope %[[DSCOPE]] {uniq_name = "_QFall_argumentsEcwd"} : (!fir.ref<!fir.char<1,255>>, index, !fir.dscope) -> !fir.ref<!fir.char<1,255>>
+ ! CHECK-NEXT: %[[statusAddr:.*]] = fir.declare %[[statusArg]] dummy_scope %0 {uniq_name = "_QFall_argumentsEstatus"} : (!fir.ref<i32>, !fir.dscope) -> !fir.ref<i32>
+ ! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
+ ! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
+ ! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_8:.*]], %[[c26]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
+ ! CHECK-NEXT: %[[statusCast:.*]] = fir.convert %[[statusAddr]] : (!fir.ref<i32>) -> i64
+ ! CHECK-NEXT: %[[isPresent:.*]] = arith.cmpi ne, %[[statusCast]], %[[c0]] : i64
+ ! CHECK-NEXT: fir.if %[[isPresent]] {
+ ! CHECK-NEXT: fir.store %[[statusValue]] to %[[statusAddr]] : !fir.ref<i32>
+ ! CHECK-NEXT: }
+ ! CHECK-NEXT: return
+end subroutine all_arguments
\ No newline at end of file
>From c0238d15d0ec6b996e0e31c04923bf2605ed152f Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 14:54:40 +0800
Subject: [PATCH 05/10] add sema test of getcwd
---
flang/test/Semantics/getcwd.f90 | 35 +++++++++++++++++++++++++++++++++
1 file changed, 35 insertions(+)
create mode 100644 flang/test/Semantics/getcwd.f90
diff --git a/flang/test/Semantics/getcwd.f90 b/flang/test/Semantics/getcwd.f90
new file mode 100644
index 0000000000000..b6ff16eeec5ac
--- /dev/null
+++ b/flang/test/Semantics/getcwd.f90
@@ -0,0 +1,35 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Tests for the GETCWD intrinsics
+
+subroutine bad_kind_error(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER(2) :: status
+ !ERROR: Actual argument for 'status=' has bad type or kind 'INTEGER(2)'
+ call getcwd(cwd, status)
+end subroutine bad_kind_error
+
+subroutine bad_args_error()
+ !ERROR: missing mandatory 'c=' argument
+ call getcwd()
+end subroutine bad_args_error
+
+subroutine bad_apply_form(cwd)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ !Declaration of 'getcwd'
+ call getcwd(cwd, status)
+ !ERROR: Cannot call subroutine 'getcwd' like a function
+ status = getcwd(cwd)
+end subroutine bad_apply_form
+
+subroutine good_subroutine(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ call getcwd(cwd, status)
+end subroutine good_subroutine
+
+subroutine good_function(cwd, status)
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ status = getcwd(cwd)
+end subroutine good_function
\ No newline at end of file
>From 90832eae446ad61d0aac873714c52acf110d1045 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 17:39:00 +0800
Subject: [PATCH 06/10] add support of getcwd on Windows
---
flang/runtime/command.cpp | 13 +++++++------
1 file changed, 7 insertions(+), 6 deletions(-)
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b0e7e338717c1..dfd078d7ffb7b 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -17,6 +17,8 @@
#ifdef _WIN32
#include "flang/Common/windows-include.h"
+#include <direct.h>
+#define getcwd _getcwd
// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
#include <processthreadsapi.h>
@@ -245,17 +247,16 @@ std::int32_t RTNAME(GetCwd)(
RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd));
- char *buf = (char *)std::malloc(FILENAME_MAX);
+ char *buf = getcwd(nullptr, 0);
if (!buf) {
- return StatMemAllocation;
- }
-
- if (!getcwd(buf, FILENAME_MAX)) {
return StatMissingCurrentWorkDirectory;
}
std::int64_t strLen = StringLength(buf);
- return CopyCharsToDescriptor(cwd, buf, strLen);
+ std::int32_t status = CopyCharsToDescriptor(cwd, buf, strLen);
+
+ std::free(buf);
+ return status;
}
} // namespace Fortran::runtime
>From 3ef423cb5b93ec9f274b658fc38ea62d25977d2a Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 20:36:36 +0800
Subject: [PATCH 07/10] add doc of getcwd
---
flang/docs/Intrinsics.md | 30 ++++++++++++++++++++++++++++++
1 file changed, 30 insertions(+)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 41129b10083b1..e741d99b3559d 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -967,4 +967,34 @@ program test_etime
print *, tarray(1)
print *, tarray(2)
end program test_etime
+```
+
+### Non-Standard Intrinsics: GETCWD
+
+#### Description
+`GETCWD(C, STATUS)` returns current working directory.
+
+This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
+
+*C* and *STATUS* are `INTENT(OUT)` and provide the following:
+
+| | |
+|------------|---------------------------------------------------------------------------------------------------|
+| `C` | Current work directory. The type shall be `CHARACTER` and of default kind. |
+| `STATUS` | (Optional) status flag. Returns 0 on success, a system specific and nonzero error code otherwise. The type shall be `INTEGER` and of a kind that greater or equal to 4. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL GETCWD(C, STATUS)`, `STATUS = GETCWD(C)`
+
+#### Example
+Here is an example usage from [Gfortran GETCWD](https://gcc.gnu.org/onlinedocs/gfortran/GETCWD.html)
+```Fortran
+PROGRAM test_getcwd
+ CHARACTER(len=255) :: cwd
+ CALL getcwd(cwd)
+ WRITE(*,*) TRIM(cwd)
+END PROGRAM
```
\ No newline at end of file
>From 125efa682b4fe3a678373cac2d95c30568242e51 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 21:02:23 +0800
Subject: [PATCH 08/10] fix type pattern of 'status' in getcwd
---
flang/lib/Evaluate/intrinsics.cpp | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 2613e12f8aa65..2c420ad4cce71 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -512,7 +512,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getcwd",
{{"c", DefaultChar, Rank::scalar, Optionality::required,
common::Intent::Out}},
- DefaultInt},
+ TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
{"getpid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
@@ -1405,8 +1405,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{"getcwd",
{{"c", DefaultChar, Rank::scalar, Optionality::required,
common::Intent::Out},
- {"status", DefaultInt, Rank::scalar, Optionality::optional,
- common::Intent::Out}},
+ {"status", TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
+ Rank::scalar, Optionality::optional, common::Intent::Out}},
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"move_alloc",
{{"from", SameType, Rank::known, Optionality::required,
>From b3523cb919bd5cb883730016de0d6896d0b0dfc3 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 21:17:08 +0800
Subject: [PATCH 09/10] format code
---
flang/include/flang/Optimizer/Builder/IntrinsicCall.h | 3 ++-
flang/include/flang/Optimizer/Builder/Runtime/Command.h | 4 ++--
flang/include/flang/Runtime/command.h | 3 ++-
3 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 209fb0994af0b..ac87c757c7922 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -232,7 +232,8 @@ struct IntrinsicLibrary {
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genFraction(mlir::Type resultType,
mlir::ArrayRef<mlir::Value> args);
- fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType, llvm::ArrayRef<fir::ExtendedValue> args);
+ fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args);
void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genGetPID(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 24790f7ec55fd..5234e49908ad3 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -56,8 +56,8 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
/// Generate a call to the GetCwd runtime function which implements
/// the GETCWD intrinsic.
-mlir::Value genGetCwd(fir::FirOpBuilder &builder,
- mlir::Location loc, mlir::Value c);
+mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value c);
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index 996a71af22089..7ab3f6442dcf9 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -57,7 +57,8 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
const char *sourceFile = nullptr, int line = 0);
// Calls getcwd()
-std::int32_t RTNAME(GetCwd)(const Descriptor &cwd, const char *sourceFile, int line);
+std::int32_t RTNAME(GetCwd)(
+ const Descriptor &cwd, const char *sourceFile, int line);
}
} // namespace Fortran::runtime
>From fee5c480f716659f4d5ed47cc459964f48b0ffb7 Mon Sep 17 00:00:00 2001
From: JumpMasterJJ <1336724109 at qq.com>
Date: Mon, 20 May 2024 21:24:09 +0800
Subject: [PATCH 10/10] format code
---
flang/include/flang/Optimizer/Builder/Runtime/Command.h | 1 -
1 file changed, 1 deletion(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 5234e49908ad3..0d60a367d9998 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -53,7 +53,6 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
mlir::Value length, mlir::Value trimName,
mlir::Value errmsg);
-
/// Generate a call to the GetCwd runtime function which implements
/// the GETCWD intrinsic.
mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
More information about the flang-commits
mailing list