[flang-commits] [flang] 6841321 - [flang] Add GETCWD runtime and lowering intrinsics implementation (#92746)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 5 21:28:06 PDT 2024
Author: jiajie zhang
Date: 2024-06-06T12:28:02+08:00
New Revision: 68413219dba47104fef388364a9973b584126f42
URL: https://github.com/llvm/llvm-project/commit/68413219dba47104fef388364a9973b584126f42
DIFF: https://github.com/llvm/llvm-project/commit/68413219dba47104fef388364a9973b584126f42.diff
LOG: [flang] Add GETCWD runtime and lowering intrinsics implementation (#92746)
This patch add support of intrinsics GNU extension GETCWD
https://github.com/llvm/llvm-project/issues/84203. Some usage info and
example has been added to `flang/docs/Intrinsics.md`. The patch contains
both the lowering and the runtime code and works on both Windows and
Linux.
| System | Implmentation |
|-----------|--------------------|
| Windows | _getcwd |
| Linux |getcwd |
Added:
flang/test/Lower/Intrinsics/getcwd-function.f90
flang/test/Lower/Intrinsics/getcwd-optional.f90
flang/test/Lower/Intrinsics/getcwd.f90
flang/test/Semantics/getcwd.f90
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Optimizer/Builder/IntrinsicCall.h
flang/include/flang/Optimizer/Builder/Runtime/Command.h
flang/include/flang/Runtime/command.h
flang/include/flang/Runtime/magic-numbers.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Optimizer/Builder/IntrinsicCall.cpp
flang/lib/Optimizer/Builder/Runtime/Command.cpp
flang/runtime/command.cpp
flang/runtime/stat.h
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 41129b10083b1..8853d4d9e1c79 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -967,4 +967,35 @@ 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 greater or equal to 4. |
+
+#### Usage and Info
+
+- **Standard:** GNU extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL GETCWD(C, STATUS)`, `STATUS = GETCWD(C)`
+
+#### Example
+```Fortran
+PROGRAM example_getcwd
+ CHARACTER(len=255) :: cwd
+ INTEGER :: status
+ CALL getcwd(cwd, status)
+ PRINT *, cwd
+ PRINT *, status
+END PROGRAM
```
\ No newline at end of file
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index c47e41eab18b2..8ef5d59b92f0c 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -232,6 +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);
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..0d60a367d9998 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -53,5 +53,10 @@ 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..7ab3f6442dcf9 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -55,6 +55,10 @@ 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 12d13422574b5..58c1b6989f495 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -514,6 +514,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}},
+ TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
{"getpid", {}, DefaultInt},
{"huge",
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
@@ -1406,6 +1410,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", TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
+ Rank::scalar, Optionality::optional, common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"move_alloc",
{{"from", SameType, Rank::known, Optionality::required,
common::Intent::InOut},
@@ -2574,7 +2584,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 072899751bc8a..d3f6fa16ac801 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",
@@ -3476,6 +3480,37 @@ 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()));
+
+ mlir::Value cwd = fir::getBase(args[0]);
+ mlir::Value statusValue = fir::runtime::genGetCwd(builder, loc, cwd);
+
+ 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();
+ }
+ }
+
+ 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..e642248a25e68 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -17,12 +17,19 @@
#ifdef _WIN32
#include "flang/Common/windows-include.h"
+#include <direct.h>
+#define getcwd _getcwd
+#define PATH_MAX MAX_PATH
// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
#include <processthreadsapi.h>
inline pid_t getpid() { return GetCurrentProcessId(); }
#else
#include <unistd.h> //getpid()
+
+#ifndef PATH_MAX
+#define PATH_MAX 4096
+#endif
#endif
namespace Fortran::runtime {
@@ -239,4 +246,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 *)AllocateMemoryOrCrash(terminator, PATH_MAX)};
+
+ if (!getcwd(buf, PATH_MAX)) {
+ return StatMissingCurrentWorkDirectory;
+ }
+
+ std::int64_t strLen{StringLength(buf)};
+ std::int32_t status{CopyCharsToDescriptor(cwd, buf, strLen)};
+
+ std::free(buf);
+ return status;
+}
+
} // 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,
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
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
More information about the flang-commits
mailing list