diff --git a/libraries/base/jsbits/base.js b/libraries/base/jsbits/base.js
index 587fda0e9f74fc064e3c4d169b37b77cd11c63bd..3cd79fde2851d6bfdb4cb5be97827d9265a4a61d 100644
--- a/libraries/base/jsbits/base.js
+++ b/libraries/base/jsbits/base.js
@@ -39,7 +39,13 @@ function h$base_chmod(file, file_off, mode, c) {
}
function h$base_close(fd, c) {
- TRACE_IO("base_close fd: " + fd)
+ TRACE_IO("base_close fd: " + fd)
+ return h$close(fd,c);
+}
+
+function h$close(fd,c) {
+ if (c) {
+ //asynchronous
var fdo = h$base_fds[fd];
if(fdo) {
delete h$base_fds[fd];
@@ -59,6 +65,16 @@ function h$base_close(fd, c) {
h$errno = CONST_EINVAL;
c(-1);
}
+ } else {
+ //synchronous
+ try {
+ h$fs.closeSync(fd);
+ return 0;
+ } catch(err) {
+ h$setErrno(err);
+ return (-1);
+ }
+ }
}
function h$base_dup(fd, c) {
@@ -265,11 +281,25 @@ function h$rmdir(file, file_off) {
}
function h$base_open(file, file_off, how, mode, c) {
+ return h$open(file,file_off,how,mode,c);
+}
+
+function h$openat(dirfd, file, file_off, how, mode) {
+ if (dirfd != h$base_at_fdcwd) {
+ // we only support AT_FDWCD (open) until NodeJS provides "openat"
+ return h$unsupported(-1);
+ }
+ else {
+ return h$open(file,file_off,how,mode,undefined);
+ }
+}
+
+function h$open(file, file_off, how, mode,c) {
#ifndef GHCJS_BROWSER
if(h$isNode()) {
var flags, off;
var fp = h$decodeUtf8z(file, file_off);
- TRACE_IO("base_open: " + fp)
+ TRACE_IO("open: " + fp)
var acc = how & h$base_o_accmode;
// passing a number lets node.js use it directly as the flags (undocumented)
if(acc === h$base_o_rdonly) {
@@ -284,34 +314,64 @@ function h$base_open(file, file_off, how, mode, c) {
| ((how & h$base_o_creat) ? h$processConstants['fs']['O_CREAT'] : 0)
| ((how & h$base_o_excl) ? h$processConstants['fs']['O_EXCL'] : 0)
| ((how & h$base_o_append) ? h$processConstants['fs']['O_APPEND'] : 0);
- h$fs.open(fp, flags, mode, function(err, fd) {
- if(err) {
- h$handleErrnoC(err, -1, 0, c);
+ if (c) {
+ // asynchronous
+ h$fs.open(fp, flags, mode, function(err, fd) {
+ if(err) {
+ h$handleErrnoC(err, -1, 0, c);
+ } else {
+ var f = function(p) {
+ h$base_fds[fd] = { read: h$base_readFile
+ , write: h$base_writeFile
+ , close: h$base_closeFile
+ , fd: fd
+ , pos: p
+ , refs: 1
+ };
+ TRACE_IO("base_open: " + fp + " -> " + fd)
+ c(fd);
+ }
+ if(off === -1) {
+ h$fs.stat(fp, function(err, fs) {
+ if(err) h$handleErrnoC(err, -1, 0, c); else f(fs.size);
+ });
+ } else {
+ f(0);
+ }
+ }
+ });
+ }
+ else {
+ // synchronous
+ try {
+ var fd = h$fs.openSync(fp, flags, mode);
+ var f = function(p) {
+ h$base_fds[fd] = { read: h$base_readFile
+ , write: h$base_writeFile
+ , close: h$base_closeFile
+ , fd: fd
+ , pos: p
+ , refs: 1
+ };
+ TRACE_IO("open: " + fp + " -> " + fd)
+ }
+ if(off === -1) {
+ var fs = h$fs.statSync(fp);
+ f(fs.size);
} else {
- var f = function(p) {
- h$base_fds[fd] = { read: h$base_readFile
- , write: h$base_writeFile
- , close: h$base_closeFile
- , fd: fd
- , pos: p
- , refs: 1
- };
- TRACE_IO("base_open: " + fp + " -> " + fd)
- c(fd);
- }
- if(off === -1) {
- h$fs.stat(fp, function(err, fs) {
- if(err) h$handleErrnoC(err, -1, 0, c); else f(fs.size);
- });
- } else {
- f(0);
- }
+ f(0);
}
- });
+ return fd;
+ } catch(err) {
+ h$setErrno(err);
+ return -1;
+ }
+ }
} else
#endif
- h$unsupported(-1, c);
+ return h$unsupported(-1,c);
}
+
function h$base_read(fd, buf, buf_off, n, c) {
TRACE_IO("base_read: " + fd)
var fdo = h$base_fds[fd];
@@ -353,16 +413,30 @@ function h$base_write(fd, buf, buf_off, n, c) {
// buf_off: offset in the buffer
// n: number of bytes to write
// c: continuation
- TRACE_IO("base_write: " + fd)
+ TRACE_IO("base_write: " + fd)
+ return h$write(fd,buf,buf_off,n,c);
+}
- var fdo = h$base_fds[fd];
+function h$write(fd, buf, buf_off, n, c) {
- if(fdo && fdo.write) {
- fdo.write(fd, fdo, buf, buf_off, n, c);
+ if (c) {
+ var fdo = h$base_fds[fd];
+ // asynchronous
+ if(fdo && fdo.write) {
+ fdo.write(fd, fdo, buf, buf_off, n, c);
+ } else {
+ h$fs.write(fd, buf.u8, buf_off, n, function(err, bytesWritten, buf0) {
+ h$handleErrnoC(err, -1, bytesWritten, c);
+ });
+ }
} else {
- h$fs.write(fd, buf.u8, buf_off, n, function(err, bytesWritten, buf0) {
- h$handleErrnoC(err, -1, bytesWritten, c);
- });
+ //synchronous
+ try {
+ return h$fs.writeSync(fd, buf.u8, buf_off, n);
+ } catch(err) {
+ h$setErrno(err);
+ return (-1);
+ }
}
}
@@ -447,17 +521,19 @@ function h$base_utime(file, file_off, timbuf, timbuf_off, c) {
function h$base_waitpid(pid, stat, stat_off, options, c) {
throw "h$base_waitpid";
}
-/** @const */ var h$base_o_rdonly = 0x00000;
-/** @const */ var h$base_o_wronly = 0x00001;
-/** @const */ var h$base_o_rdwr = 0x00002;
-/** @const */ var h$base_o_accmode = 0x00003;
-/** @const */ var h$base_o_append = 0x00008;
-/** @const */ var h$base_o_creat = 0x00200;
-/** @const */ var h$base_o_trunc = 0x00400;
-/** @const */ var h$base_o_excl = 0x00800;
-/** @const */ var h$base_o_noctty = 0x20000;
-/** @const */ var h$base_o_nonblock = 0x00004;
-/** @const */ var h$base_o_binary = 0x00000;
+const h$base_o_rdonly = 0x00000;
+const h$base_o_wronly = 0x00001;
+const h$base_o_rdwr = 0x00002;
+const h$base_o_accmode = 0x00003;
+const h$base_o_append = 0x00008;
+const h$base_o_creat = 0x00200;
+const h$base_o_trunc = 0x00400;
+const h$base_o_excl = 0x00800;
+const h$base_o_noctty = 0x20000;
+const h$base_o_nonblock = 0x00004;
+const h$base_o_binary = 0x00000;
+const h$base_at_fdcwd = -100;
+
function h$base_stat_check_mode(mode,p) {
// inspired by Node's checkModeProperty
diff --git a/libraries/base/jsbits/errno.js b/libraries/base/jsbits/errno.js
index 30401d9156281094075ea954954dadeea7913266..b7ea1fb9ae01610d8f862908e28d6feaae3e2b2a 100644
--- a/libraries/base/jsbits/errno.js
+++ b/libraries/base/jsbits/errno.js
@@ -51,6 +51,7 @@ function h$setErrno(e) {
if(es.indexOf('ESPIPE') !== -1) return CONST_ESPIPE;
if(es.indexOf('EBADF') !== -1) return CONST_EBADF;
if(es.indexOf('ENOSPC') !== -1) return CONST_ENOSPC;
+ if(es.indexOf('EACCES') !== -1) return CONST_EACCES;
if(es.indexOf('Bad argument') !== -1) return CONST_ENOENT; // fixme?
throw ("setErrno not yet implemented for: " + e);
diff --git a/libraries/base/tests/Makefile b/libraries/base/tests/Makefile
index 6a0abcf1cf7f79f47ac3db01eec1eb9ff6ff7b45..443ce1363a3c6b33e5e4870dc0cc5ed04966057d 100644
--- a/libraries/base/tests/Makefile
+++ b/libraries/base/tests/Makefile
@@ -5,3 +5,9 @@
TOP=../../../testsuite
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
+
+.PHONY: T23697
+T23697:
+ '$(HSC2HS)' T23697.hsc
+ '$(TEST_HC)' $(TEST_HC_OPTS) $(WAY_FLAGS) -v0 T23697.hs
+ ./T23697
diff --git a/libraries/base/tests/T23697.hsc b/libraries/base/tests/T23697.hsc
new file mode 100644
index 0000000000000000000000000000000000000000..b9becb638d3999ad17ec81c7f5b40462184cbe17
--- /dev/null
+++ b/libraries/base/tests/T23697.hsc
@@ -0,0 +1,37 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NegativeLiterals #-}
+
+module Main (main) where
+
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Ptr
+import GHC.Ptr
+import System.Posix.Internals
+import Data.Bits
+
+#include<fcntl.h>
+
+main :: IO ()
+main = do
+
+ let
+ checkErr :: (Num a, Eq a) => a -> a
+ checkErr = \case
+ (-1) -> error "Returned (-1)"
+ x -> x
+
+ fname = "foo"
+
+ -- test: openat(AT_FDCWD...), write, close
+ withCString fname $ \cstr -> do
+ fd <- checkErr <$> openat (#const AT_FDCWD) cstr (o_WRONLY .|. o_CREAT) 0o666
+ checkErr <$> write fd (Ptr "123456"##) 6
+ checkErr <$> close fd
+
+ putStrLn =<< readFile fname
+
+foreign import ccall openat :: CInt -> CString -> CInt -> CUInt -> IO CInt
+foreign import ccall write :: CInt -> Ptr () -> CSize -> IO CInt
+foreign import ccall close :: CInt -> IO CInt
diff --git a/libraries/base/tests/T23697.stdout b/libraries/base/tests/T23697.stdout
new file mode 100644
index 0000000000000000000000000000000000000000..9f358a4addefcab294b83e4282bfef1f9625a249
--- /dev/null
+++ b/libraries/base/tests/T23697.stdout
@@ -0,0 +1 @@
+123456
diff --git a/libraries/base/tests/all.T b/libraries/base/tests/all.T
index dfeb95a8f0edb7b1f1064fd0fed3daf13b2abae5..538018ae32d6f1720fc696c82bc297dddbf284bf 100644
--- a/libraries/base/tests/all.T
+++ b/libraries/base/tests/all.T
@@ -313,3 +313,7 @@ test('AtomicModifyIORef', normal, compile_and_run, [''])
test('AtomicSwapIORef', normal, compile_and_run, [''])
test('T23454', normal, compile_fail, [''])
test('T23687', normal, compile_and_run, [''])
+test('T23697',
+ [ when(opsys('mingw32'), skip) # header not found
+ , when(opsys('darwin'), skip) # permission denied
+ ], makefile_test, ['T23697'])