1 files changed, 73 insertions, 0 deletions
diff --git a/flang/runtime/extensions.cpp b/flang/runtime/extensions.cpp
index 3ac9800..12498b5 100644
--- a/flang/runtime/extensions.cpp
+++ b/flang/runtime/extensions.cpp
@@ -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>
@@ -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"