Skip to content

Commit

Permalink
[flang][runtime] Add ACCESS library procedure (#88395)
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
tblah committed Apr 12, 2024
1 parent 6ec4672 commit f220d26
Show file tree
Hide file tree
Showing 5 changed files with 479 additions and 0 deletions.
8 changes: 8 additions & 0 deletions flang/docs/Intrinsics.md
Original file line number Diff line number Diff line change
Expand Up @@ -657,6 +657,14 @@ CALL CO_REDUCE
CALL CO_SUM
```

### Inquiry Functions
ACCESS (GNU extension) is not supported on Windows. Otherwise:
```
CHARACTER(LEN=*) :: path = 'path/to/file'
IF (ACCESS(path, 'rwx')) &
...
```

## Non-standard intrinsics
### PGI
```
Expand Down
7 changes: 7 additions & 0 deletions flang/include/flang/Runtime/extensions.h
Original file line number Diff line number Diff line change
Expand Up @@ -44,5 +44,12 @@ std::int64_t RTNAME(Signal)(std::int64_t number, void (*handler)(int));
// GNU extension subroutine SLEEP(SECONDS)
void RTNAME(Sleep)(std::int64_t seconds);

// GNU extension function ACCESS(NAME, MODE)
// TODO: not supported on Windows
#ifndef _WIN32
std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
std::int64_t nameLength, const char *mode, std::int64_t modeLength);
#endif

} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_
73 changes: 73 additions & 0 deletions flang/runtime/extensions.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@
#include "flang/Runtime/entry-names.h"
#include "flang/Runtime/io-api.h"
#include <chrono>
#include <cstring>
#include <ctime>
#include <signal.h>
#include <thread>
Expand Down Expand Up @@ -138,5 +139,77 @@ void RTNAME(Sleep)(std::int64_t seconds) {
std::this_thread::sleep_for(std::chrono::seconds(seconds));
}

// TODO: not supported on Windows
#ifndef _WIN32
std::int64_t FORTRAN_PROCEDURE_NAME(access)(const char *name,
std::int64_t nameLength, const char *mode, std::int64_t modeLength) {
std::int64_t ret{-1};
if (nameLength <= 0 || modeLength <= 0 || !name || !mode) {
return ret;
}

// ensure name is null terminated
char *newName{nullptr};
if (name[nameLength - 1] != '\0') {
newName = static_cast<char *>(std::malloc(nameLength + 1));
std::memcpy(newName, name, nameLength);
newName[nameLength] = '\0';
name = newName;
}

// calculate mode
bool read{false};
bool write{false};
bool execute{false};
bool exists{false};
int imode{0};

for (std::int64_t i = 0; i < modeLength; ++i) {
switch (mode[i]) {
case 'r':
read = true;
break;
case 'w':
write = true;
break;
case 'x':
execute = true;
break;
case ' ':
exists = true;
break;
default:
// invalid mode
goto cleanup;
}
}
if (!read && !write && !execute && !exists) {
// invalid mode
goto cleanup;
}

if (!read && !write && !execute) {
imode = F_OK;
} else {
if (read) {
imode |= R_OK;
}
if (write) {
imode |= W_OK;
}
if (execute) {
imode |= X_OK;
}
}
ret = access(name, imode);

cleanup:
if (newName) {
free(newName);
}
return ret;
}
#endif

} // namespace Fortran::runtime
} // extern "C"

0 comments on commit f220d26

Please sign in to comment.