Skip to content

Commit 668a58b

Browse files
authored
[flang][runtime] Add ACCESS library procedure (#88517)
Re-land #88395 Two build-bots were broken by the old version: - https://lab.llvm.org/buildbot/#/builders/285/builds/245 - https://lab.llvm.org/buildbot/#/builders/21/builds/96988 The problem in both cases was that the compiler did not support `std::filesystem` (which I use in the unit test). I have removed the dependency upon std::filesystem because there isn't an easy way to add the right linker options so that this is supported correctly in all build environments [1] [1] https://gitlab.kitware.com/cmake/cmake/-/issues/17834 --- This is a GNU extension: https://gcc.gnu.org/onlinedocs/gfortran/ACCESS.html Used in SALMON: https://salmon-tddft.jp/download.html Unfortunately the intrinsic takes a file path to operate on so there isn't an easy way to make the test robust. The unit test expects to be able to create, set read write and execute permissions, and delete files called std::filesystem::temp_directory_path() / <test_name>.<pid> The test will fail if a file already exists with that name. I have not implemented the intrinsic on Windows because this is wrapping a POSIX system call and Windows doesn't support all of the permission bits tested by the intrinsic. I don't have a Windows machine easily available to check if Gfortran implements this intrinsic on Windows.
1 parent 70fe6ad commit 668a58b

File tree

5 files changed

+511
-0
lines changed

5 files changed

+511
-0
lines changed

flang/docs/Intrinsics.md

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -657,6 +657,14 @@ CALL CO_REDUCE
657657
CALL CO_SUM
658658
```
659659

660+
### Inquiry Functions
661+
ACCESS (GNU extension) is not supported on Windows. Otherwise:
662+
```
663+
CHARACTER(LEN=*) :: path = 'path/to/file'
664+
IF (ACCESS(path, 'rwx')) &
665+
...
666+
```
667+
660668
## Non-standard intrinsics
661669
### PGI
662670
```

flang/include/flang/Runtime/extensions.h

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,5 +44,12 @@ std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));
4444
// GNU extension subroutine SLEEP(SECONDS)
4545
void RTNAME(Sleep)(std::int64_t seconds);
4646

47+
// GNU extension function ACCESS(NAME, MODE)
48+
// TODO: not supported on Windows
49+
#ifndef _WIN32
50+
std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
51+
std::int64_t nameLength, const char *mode, std::int64_t modeLength);
52+
#endif
53+
4754
} // extern "C"
4855
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_

flang/runtime/extensions.cpp

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@
1717
#include "flang/Runtime/entry-names.h"
1818
#include "flang/Runtime/io-api.h"
1919
#include <chrono>
20+
#include <cstring>
2021
#include <ctime>
2122
#include <signal.h>
2223
#include <thread>
@@ -138,5 +139,77 @@ void RTNAME(Sleep)(std::int64_t seconds) {
138139
std::this_thread::sleep_for(std::chrono::seconds(seconds));
139140
}
140141

142+
// TODO: not supported on Windows
143+
#ifndef _WIN32
144+
std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
145+
std::int64_t nameLength, const char *mode, std::int64_t modeLength) {
146+
std::int64_t ret{-1};
147+
if (nameLength <= 0 || modeLength <= 0 || !name || !mode) {
148+
return ret;
149+
}
150+
151+
// ensure name is null terminated
152+
char *newName{nullptr};
153+
if (name[nameLength - 1] != '\0') {
154+
newName = static_cast<char *>(std::malloc(nameLength + 1));
155+
std::memcpy(newName, name, nameLength);
156+
newName[nameLength] = '\0';
157+
name = newName;
158+
}
159+
160+
// calculate mode
161+
bool read{false};
162+
bool write{false};
163+
bool execute{false};
164+
bool exists{false};
165+
int imode{0};
166+
167+
for (std::int64_t i = 0; i < modeLength; ++i) {
168+
switch (mode[i]) {
169+
case 'r':
170+
read = true;
171+
break;
172+
case 'w':
173+
write = true;
174+
break;
175+
case 'x':
176+
execute = true;
177+
break;
178+
case ' ':
179+
exists = true;
180+
break;
181+
default:
182+
// invalid mode
183+
goto cleanup;
184+
}
185+
}
186+
if (!read && !write && !execute && !exists) {
187+
// invalid mode
188+
goto cleanup;
189+
}
190+
191+
if (!read && !write && !execute) {
192+
imode = F_OK;
193+
} else {
194+
if (read) {
195+
imode |= R_OK;
196+
}
197+
if (write) {
198+
imode |= W_OK;
199+
}
200+
if (execute) {
201+
imode |= X_OK;
202+
}
203+
}
204+
ret = access(name, imode);
205+
206+
cleanup:
207+
if (newName) {
208+
free(newName);
209+
}
210+
return ret;
211+
}
212+
#endif
213+
141214
} // namespace Fortran::runtime
142215
} // extern "C"

0 commit comments

Comments
 (0)