Skip to content

Commit 6841321

Browse files
authored
[flang] Add GETCWD runtime and lowering intrinsics implementation (#92746)
This patch add support of intrinsics GNU extension GETCWD #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 |
1 parent 8c452d0 commit 6841321

File tree

14 files changed

+264
-1
lines changed

14 files changed

+264
-1
lines changed

flang/docs/Intrinsics.md

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -967,4 +967,35 @@ program test_etime
967967
print *, tarray(1)
968968
print *, tarray(2)
969969
end program test_etime
970+
```
971+
972+
### Non-Standard Intrinsics: GETCWD
973+
974+
#### Description
975+
`GETCWD(C, STATUS)` returns current working directory.
976+
977+
This intrinsic is provided in both subroutine and function forms; however, only one form can be used in any given program unit.
978+
979+
*C* and *STATUS* are `INTENT(OUT)` and provide the following:
980+
981+
| | |
982+
|------------|---------------------------------------------------------------------------------------------------|
983+
| `C` | Current work directory. The type shall be `CHARACTER` and of default kind. |
984+
| `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. |
985+
986+
#### Usage and Info
987+
988+
- **Standard:** GNU extension
989+
- **Class:** Subroutine, function
990+
- **Syntax:** `CALL GETCWD(C, STATUS)`, `STATUS = GETCWD(C)`
991+
992+
#### Example
993+
```Fortran
994+
PROGRAM example_getcwd
995+
CHARACTER(len=255) :: cwd
996+
INTEGER :: status
997+
CALL getcwd(cwd, status)
998+
PRINT *, cwd
999+
PRINT *, status
1000+
END PROGRAM
9701001
```

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -232,6 +232,8 @@ struct IntrinsicLibrary {
232232
mlir::Value genFloor(mlir::Type, llvm::ArrayRef<mlir::Value>);
233233
mlir::Value genFraction(mlir::Type resultType,
234234
mlir::ArrayRef<mlir::Value> args);
235+
fir::ExtendedValue genGetCwd(std::optional<mlir::Type> resultType,
236+
llvm::ArrayRef<fir::ExtendedValue> args);
235237
void genGetCommand(mlir::ArrayRef<fir::ExtendedValue> args);
236238
mlir::Value genGetPID(mlir::Type resultType,
237239
llvm::ArrayRef<mlir::Value> args);

flang/include/flang/Optimizer/Builder/Runtime/Command.h

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -53,5 +53,10 @@ mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location,
5353
mlir::Value length, mlir::Value trimName,
5454
mlir::Value errmsg);
5555

56+
/// Generate a call to the GetCwd runtime function which implements
57+
/// the GETCWD intrinsic.
58+
mlir::Value genGetCwd(fir::FirOpBuilder &builder, mlir::Location loc,
59+
mlir::Value c);
60+
5661
} // namespace fir::runtime
5762
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H

flang/include/flang/Runtime/command.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,10 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
5555
const Descriptor *value = nullptr, const Descriptor *length = nullptr,
5656
bool trim_name = true, const Descriptor *errmsg = nullptr,
5757
const char *sourceFile = nullptr, int line = 0);
58+
59+
// Calls getcwd()
60+
std::int32_t RTNAME(GetCwd)(
61+
const Descriptor &cwd, const char *sourceFile, int line);
5862
}
5963
} // namespace Fortran::runtime
6064

flang/include/flang/Runtime/magic-numbers.h

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -68,6 +68,11 @@ Additional status code for a bad pointer DEALLOCATE.
6868
#endif
6969
#define FORTRAN_RUNTIME_STAT_BAD_POINTER_DEALLOCATION 110
7070

71+
#if 0
72+
Status codes for GETCWD.
73+
#endif
74+
#define FORTRAN_RUNTIME_STAT_MISSING_CWD 111
75+
7176
#if 0
7277
ieee_class_type values
7378
The sequence is that of F18 Clause 17.2p3, but nothing depends on that.

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -514,6 +514,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
514514
{"gamma", {{"x", SameReal}}, SameReal},
515515
{"get_team", {{"level", DefaultInt, Rank::scalar, Optionality::optional}},
516516
TeamType, Rank::scalar, IntrinsicClass::transformationalFunction},
517+
{"getcwd",
518+
{{"c", DefaultChar, Rank::scalar, Optionality::required,
519+
common::Intent::Out}},
520+
TypePattern{IntType, KindCode::greaterOrEqualToKind, 4}},
517521
{"getpid", {}, DefaultInt},
518522
{"huge",
519523
{{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
@@ -1406,6 +1410,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
14061410
{"errmsg", DefaultChar, Rank::scalar, Optionality::optional,
14071411
common::Intent::InOut}},
14081412
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
1413+
{"getcwd",
1414+
{{"c", DefaultChar, Rank::scalar, Optionality::required,
1415+
common::Intent::Out},
1416+
{"status", TypePattern{IntType, KindCode::greaterOrEqualToKind, 4},
1417+
Rank::scalar, Optionality::optional, common::Intent::Out}},
1418+
{}, Rank::elemental, IntrinsicClass::impureSubroutine},
14091419
{"move_alloc",
14101420
{{"from", SameType, Rank::known, Optionality::required,
14111421
common::Intent::InOut},
@@ -2574,7 +2584,7 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
25742584
const std::string &name) const {
25752585
// Collection for some intrinsics with function and subroutine form,
25762586
// in order to pass the semantic check.
2577-
static const std::string dualIntrinsic[]{{"etime"}};
2587+
static const std::string dualIntrinsic[]{{"etime"}, {"getcwd"}};
25782588

25792589
return std::find_if(std::begin(dualIntrinsic), std::end(dualIntrinsic),
25802590
[&name](const std::string &dualName) {

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -280,6 +280,10 @@ static constexpr IntrinsicHandler handlers[]{
280280
{"trim_name", asAddr, handleDynamicOptional},
281281
{"errmsg", asBox, handleDynamicOptional}}},
282282
/*isElemental=*/false},
283+
{"getcwd",
284+
&I::genGetCwd,
285+
{{{"c", asBox}, {"status", asAddr, handleDynamicOptional}}},
286+
/*isElemental=*/false},
283287
{"getpid", &I::genGetPID},
284288
{"iachar", &I::genIchar},
285289
{"iall",
@@ -3476,6 +3480,37 @@ mlir::Value IntrinsicLibrary::genFraction(mlir::Type resultType,
34763480
fir::runtime::genFraction(builder, loc, fir::getBase(args[0])));
34773481
}
34783482

3483+
// GETCWD
3484+
fir::ExtendedValue
3485+
IntrinsicLibrary::genGetCwd(std::optional<mlir::Type> resultType,
3486+
llvm::ArrayRef<fir::ExtendedValue> args) {
3487+
assert((args.size() == 1 && resultType.has_value()) ||
3488+
(args.size() >= 1 && !resultType.has_value()));
3489+
3490+
mlir::Value cwd = fir::getBase(args[0]);
3491+
mlir::Value statusValue = fir::runtime::genGetCwd(builder, loc, cwd);
3492+
3493+
if (resultType.has_value()) {
3494+
// Function form, return status.
3495+
return statusValue;
3496+
} else {
3497+
// Subroutine form, store status and return none.
3498+
const fir::ExtendedValue &status = args[1];
3499+
if (!isStaticallyAbsent(status)) {
3500+
mlir::Value statusAddr = fir::getBase(status);
3501+
mlir::Value statusIsPresentAtRuntime =
3502+
builder.genIsNotNullAddr(loc, statusAddr);
3503+
builder.genIfThen(loc, statusIsPresentAtRuntime)
3504+
.genThen([&]() {
3505+
builder.createStoreWithConvert(loc, statusValue, statusAddr);
3506+
})
3507+
.end();
3508+
}
3509+
}
3510+
3511+
return {};
3512+
}
3513+
34793514
// GET_COMMAND
34803515
void IntrinsicLibrary::genGetCommand(llvm::ArrayRef<fir::ExtendedValue> args) {
34813516
assert(args.size() == 4);

flang/lib/Optimizer/Builder/Runtime/Command.cpp

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -88,3 +88,16 @@ mlir::Value fir::runtime::genGetEnvVariable(fir::FirOpBuilder &builder,
8888
sourceFile, sourceLine);
8989
return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
9090
}
91+
92+
mlir::Value fir::runtime::genGetCwd(fir::FirOpBuilder &builder,
93+
mlir::Location loc, mlir::Value cwd) {
94+
mlir::func::FuncOp func =
95+
fir::runtime::getRuntimeFunc<mkRTKey(GetCwd)>(loc, builder);
96+
auto runtimeFuncTy = func.getFunctionType();
97+
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
98+
mlir::Value sourceLine =
99+
fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
100+
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
101+
builder, loc, runtimeFuncTy, cwd, sourceFile, sourceLine);
102+
return builder.create<fir::CallOp>(loc, func, args).getResult(0);
103+
}

flang/runtime/command.cpp

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,12 +17,19 @@
1717

1818
#ifdef _WIN32
1919
#include "flang/Common/windows-include.h"
20+
#include <direct.h>
21+
#define getcwd _getcwd
22+
#define PATH_MAX MAX_PATH
2023

2124
// On Windows GetCurrentProcessId returns a DWORD aka uint32_t
2225
#include <processthreadsapi.h>
2326
inline pid_t getpid() { return GetCurrentProcessId(); }
2427
#else
2528
#include <unistd.h> //getpid()
29+
30+
#ifndef PATH_MAX
31+
#define PATH_MAX 4096
32+
#endif
2633
#endif
2734

2835
namespace Fortran::runtime {
@@ -239,4 +246,23 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
239246
return StatOk;
240247
}
241248

249+
std::int32_t RTNAME(GetCwd)(
250+
const Descriptor &cwd, const char *sourceFile, int line) {
251+
Terminator terminator{sourceFile, line};
252+
253+
RUNTIME_CHECK(terminator, IsValidCharDescriptor(&cwd));
254+
255+
char *buf{(char *)AllocateMemoryOrCrash(terminator, PATH_MAX)};
256+
257+
if (!getcwd(buf, PATH_MAX)) {
258+
return StatMissingCurrentWorkDirectory;
259+
}
260+
261+
std::int64_t strLen{StringLength(buf)};
262+
std::int32_t status{CopyCharsToDescriptor(cwd, buf, strLen)};
263+
264+
std::free(buf);
265+
return status;
266+
}
267+
242268
} // namespace Fortran::runtime

flang/runtime/stat.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ enum Stat {
4141
StatLocked = FORTRAN_RUNTIME_STAT_LOCKED,
4242
StatLockedOtherImage = FORTRAN_RUNTIME_STAT_LOCKED_OTHER_IMAGE,
4343
StatMissingEnvVariable = FORTRAN_RUNTIME_STAT_MISSING_ENV_VAR,
44+
StatMissingCurrentWorkDirectory = FORTRAN_RUNTIME_STAT_MISSING_CWD,
4445
StatStoppedImage = FORTRAN_RUNTIME_STAT_STOPPED_IMAGE,
4546
StatUnlocked = FORTRAN_RUNTIME_STAT_UNLOCKED,
4647
StatUnlockedFailedImage = FORTRAN_RUNTIME_STAT_UNLOCKED_FAILED_IMAGE,
Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
! Test GETCWD with dynamically optional arguments.
2+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
3+
4+
! CHECK-LABEL: func.func @_QPtest(
5+
! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"}) -> i32 {
6+
integer function test(cwd)
7+
CHARACTER(len=255) :: cwd
8+
test = getcwd(cwd)
9+
! CHECK-NEXT: %[[c8:.*]] = arith.constant 8 : i32
10+
! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
11+
! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
12+
! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
13+
! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
14+
! 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>>
15+
! CHECK-NEXT: %[[test:.*]] = fir.alloca i32 {bindc_name = "test", uniq_name = "_QFtestEtest"}
16+
! CHECK-NEXT: %[[testAddr:.*]] = fir.declare %[[test]] {uniq_name = "_QFtestEtest"} : (!fir.ref<i32>) -> !fir.ref<i32>
17+
! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
18+
! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
19+
! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_9:.*]], %[[c8]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
20+
! CHECK-NEXT: fir.store %[[statusValue]] to %[[testAddr]] : !fir.ref<i32>
21+
! CHECK-NEXT: %[[returnValue:.*]] = fir.load %[[testAddr]] : !fir.ref<i32>
22+
! CHECK-NEXT: return %[[returnValue]] : i32
23+
end function
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
! Test GETCWD with dynamically optional arguments.
2+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
3+
4+
5+
! CHECK-LABEL: func.func @_QPtest(
6+
! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"},
7+
! CHECK-SAME: %[[statusArg:.*]]: !fir.ref<i32> {fir.bindc_name = "status", fir.optional}) {
8+
subroutine test(cwd, status)
9+
CHARACTER(len=255) :: cwd
10+
INTEGER, OPTIONAL :: status
11+
call getcwd(cwd, status)
12+
! CHECK-NEXT: %[[c0:.*]] = arith.constant 0 : i64
13+
! CHECK-NEXT: %[[c11:.*]] = arith.constant 11 : i32
14+
! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
15+
! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
16+
! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
17+
! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
18+
! 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>>
19+
! 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>
20+
! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
21+
! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
22+
! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_8:.*]], %[[c11]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
23+
! CHECK-NEXT: %[[statusCast:.*]] = fir.convert %[[statusAddr]] : (!fir.ref<i32>) -> i64
24+
! CHECK-NEXT: %[[isPresent:.*]] = arith.cmpi ne, %[[statusCast]], %[[c0]] : i64
25+
! CHECK-NEXT: fir.if %[[isPresent]] {
26+
! CHECK-NEXT: fir.store %[[statusValue]] to %[[statusAddr]] : !fir.ref<i32>
27+
! CHECK-NEXT: }
28+
! CHECK-NEXT: return
29+
end subroutine
Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
! RUN: bbc -emit-fir %s -o - | FileCheck %s
2+
3+
! CHECK-LABEL: func.func @_QPcwd_only(
4+
! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"}) {
5+
subroutine cwd_only(cwd)
6+
CHARACTER(len=255) :: cwd
7+
call getcwd(cwd)
8+
! CHECK-NEXT: %[[c7:.*]] = arith.constant 7 : i32
9+
! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
10+
! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
11+
! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
12+
! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
13+
! 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>>
14+
! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
15+
! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
16+
! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_7:.*]], %[[c7]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
17+
! CHECK-NEXT: return
18+
end subroutine cwd_only
19+
20+
! CHECK-LABEL: func.func @_QPall_arguments(
21+
! CHECK-SAME: %[[cwdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "cwd"},
22+
! CHECK-SAME: %[[statusArg:.*]]: !fir.ref<i32> {fir.bindc_name = "status"}) {
23+
subroutine all_arguments(cwd, status)
24+
CHARACTER(len=255) :: cwd
25+
INTEGER :: status
26+
call getcwd(cwd, status)
27+
! CHECK-NEXT: %[[c0:.*]] = arith.constant 0 : i64
28+
! CHECK-NEXT: %[[c26:.*]] = arith.constant 26 : i32
29+
! CHECK-NEXT: %[[c255:.*]] = arith.constant 255 : index
30+
! CHECK-NEXT: %[[DSCOPE:.*]] = fir.dummy_scope : !fir.dscope
31+
! CHECK-NEXT: %[[cwdUnbox:.*]]:2 = fir.unboxchar %[[cwdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
32+
! CHECK-NEXT: %[[cwdCast:.*]] = fir.convert %[[cwdUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,255>>
33+
! 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>>
34+
! CHECK-NEXT: %[[statusAddr:.*]] = fir.declare %[[statusArg]] dummy_scope %0 {uniq_name = "_QFall_argumentsEstatus"} : (!fir.ref<i32>, !fir.dscope) -> !fir.ref<i32>
35+
! CHECK-NEXT: %[[cwdBox:.*]] = fir.embox %[[cwdDeclare]] : (!fir.ref<!fir.char<1,255>>) -> !fir.box<!fir.char<1,255>>
36+
! CHECK: %[[cwd:.*]] = fir.convert %[[cwdBox]] : (!fir.box<!fir.char<1,255>>) -> !fir.box<none>
37+
! CHECK: %[[statusValue:.*]] = fir.call @_FortranAGetCwd(%[[cwd]], %[[VAL_8:.*]], %[[c26]]) fastmath<contract> : (!fir.box<none>, !fir.ref<i8>, i32) -> i32
38+
! CHECK-NEXT: %[[statusCast:.*]] = fir.convert %[[statusAddr]] : (!fir.ref<i32>) -> i64
39+
! CHECK-NEXT: %[[isPresent:.*]] = arith.cmpi ne, %[[statusCast]], %[[c0]] : i64
40+
! CHECK-NEXT: fir.if %[[isPresent]] {
41+
! CHECK-NEXT: fir.store %[[statusValue]] to %[[statusAddr]] : !fir.ref<i32>
42+
! CHECK-NEXT: }
43+
! CHECK-NEXT: return
44+
end subroutine all_arguments

flang/test/Semantics/getcwd.f90

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2+
! Tests for the GETCWD intrinsics
3+
4+
subroutine bad_kind_error(cwd, status)
5+
CHARACTER(len=255) :: cwd
6+
INTEGER(2) :: status
7+
!ERROR: Actual argument for 'status=' has bad type or kind 'INTEGER(2)'
8+
call getcwd(cwd, status)
9+
end subroutine bad_kind_error
10+
11+
subroutine bad_args_error()
12+
!ERROR: missing mandatory 'c=' argument
13+
call getcwd()
14+
end subroutine bad_args_error
15+
16+
subroutine bad_apply_form(cwd)
17+
CHARACTER(len=255) :: cwd
18+
INTEGER :: status
19+
!Declaration of 'getcwd'
20+
call getcwd(cwd, status)
21+
!ERROR: Cannot call subroutine 'getcwd' like a function
22+
status = getcwd(cwd)
23+
end subroutine bad_apply_form
24+
25+
subroutine good_subroutine(cwd, status)
26+
CHARACTER(len=255) :: cwd
27+
INTEGER :: status
28+
call getcwd(cwd, status)
29+
end subroutine good_subroutine
30+
31+
subroutine good_function(cwd, status)
32+
CHARACTER(len=255) :: cwd
33+
INTEGER :: status
34+
status = getcwd(cwd)
35+
end subroutine good_function

0 commit comments

Comments
 (0)