Various runtime fixes

CHANGES.md

@@ -17,6 +17,7 @@
 * Misc: import many test from the OCaml codebase
 * Runtime: support for float16 bigarrays
 * Runtime: support more Unix functions (#1823)
+* Runtime: various filesystem fixes (#1825)
 
 ## Bug fixes
 * Compiler: Fix small bug in global data flow analysis (#1768)

compiler/tests-io/dune

@@ -70,3 +70,17 @@
  (alias runtest)
  (action
   (diff cat.expected cat_nat.expected)))
+
+(rule
+ (with-stdout-to
+  "accentué"
+  (echo test)))
+
+(tests
+ (names non_ascii_filenames)
+ (deps "accentué")
+ (modes js)
+ (js_of_ocaml
+  (compilation_mode whole_program)
+  (flags
+   (:standard --file "accentué"))))

compiler/tests-io/non_ascii_filenames.expected

@@ -0,0 +1,11 @@
+opening files
+  /static/accentué: PASS
+  /static/accentu�: FAIL
+  accentué: PASS
+  accentu�: FAIL
+reading directories
+  .: PASS
+  /static: PASS
+current working directory
+  ./répertoire: PASS
+  /static/répertoire: PASS

compiler/tests-io/non_ascii_filenames.ml

@@ -0,0 +1,34 @@
+let test f v =
+  try
+    ignore (f v);
+    Printf.printf "  %s: PASS\n" v
+  with Sys_error _ | Not_found | Exit -> Printf.printf "  %s: FAIL\n" v
+
+let () =
+  Printf.printf "opening files\n";
+  test open_in "/static/accentué";
+  test open_in "/static/accentu�";
+  test open_in "accentué";
+  test open_in "accentu�";
+  Printf.printf "reading directories\n";
+  let check_file d =
+    let a = Sys.readdir d in
+    if
+      not
+        (Array.exists
+           (fun x ->
+             prerr_endline x;
+             x = "accentué")
+           a)
+    then raise Not_found
+  in
+  test check_file ".";
+  test check_file "/static";
+  Printf.printf "current working directory\n";
+  let test_chdir d =
+    Sys.mkdir d 0o777;
+    Sys.chdir d;
+    if Filename.basename (Sys.getcwd ()) <> "répertoire" then raise Exit
+  in
+  test test_chdir "./répertoire";
+  test test_chdir "/static/répertoire"

runtime/js/fs.js

@@ -130,12 +130,12 @@ jsoo_mount_point.push({
 });
 
 //Provides:caml_list_mount_point
-//Requires: jsoo_mount_point, caml_string_of_jsbytes
+//Requires: jsoo_mount_point, caml_string_of_jsstring
 function caml_list_mount_point() {
   var prev = 0;
   for (var i = 0; i < jsoo_mount_point.length; i++) {
     var old = prev;
-    prev = [0, caml_string_of_jsbytes(jsoo_mount_point[i].path), old];
+    prev = [0, caml_string_of_jsstring(jsoo_mount_point[i].path), old];
   }
   return prev;
 }
@@ -197,22 +197,26 @@ function caml_unmount(name) {
 }
 
 //Provides: caml_sys_getcwd
-//Requires: caml_current_dir, caml_string_of_jsbytes
+//Requires: caml_current_dir, caml_string_of_jsstring
 function caml_sys_getcwd() {
-  return caml_string_of_jsbytes(caml_current_dir);
+  return caml_string_of_jsstring(caml_current_dir);
 }
 
 //Provides: caml_sys_chdir
-//Requires: caml_current_dir, caml_raise_no_such_file, resolve_fs_device, caml_trailing_slash, caml_jsbytes_of_string
+//Requires: caml_current_dir, caml_raise_no_such_file, resolve_fs_device, caml_trailing_slash, caml_jsstring_of_string, caml_raise_sys_error
 function caml_sys_chdir(dir) {
   var root = resolve_fs_device(dir);
-  if (root.device.exists(root.rest)) {
+  if (root.device.is_dir(root.rest)) {
     if (root.rest)
       caml_current_dir = caml_trailing_slash(root.path + root.rest);
     else caml_current_dir = root.path;
     return 0;
+  } else if (root.device.exists(root.rest)) {
+    caml_raise_sys_error(
+      "ENOTDIR: not a directory, chdir '" + caml_jsstring_of_string(dir) + "'",
+    );
   } else {
-    caml_raise_no_such_file(caml_jsbytes_of_string(dir));
+    caml_raise_no_such_file(caml_jsstring_of_string(dir));
   }
 }
 
@@ -235,14 +239,14 @@ function caml_sys_file_exists(name) {
 }
 
 //Provides: caml_sys_read_directory
-//Requires: caml_string_of_jsbytes
+//Requires: caml_string_of_jsstring
 //Requires: resolve_fs_device
 function caml_sys_read_directory(name) {
   var root = resolve_fs_device(name);
   var a = root.device.readdir(root.rest);
   var l = new Array(a.length + 1);
   l[0] = 0;
-  for (var i = 0; i < a.length; i++) l[i + 1] = caml_string_of_jsbytes(a[i]);
+  for (var i = 0; i < a.length; i++) l[i + 1] = caml_string_of_jsstring(a[i]);
   return l;
 }
 
@@ -335,18 +339,18 @@ function caml_create_file(name, content) {
 }
 
 //Provides: jsoo_create_file
-//Requires: caml_create_file, caml_string_of_jsbytes
+//Requires: caml_create_file, caml_string_of_jsbytes, caml_string_of_jsstring
 function jsoo_create_file(name, content) {
-  var name = caml_string_of_jsbytes(name);
+  var name = caml_string_of_jsstring(name);
   var content = caml_string_of_jsbytes(content);
   return caml_create_file(name, content);
 }
 
 //Provides: caml_read_file_content
 //Requires: resolve_fs_device, caml_raise_no_such_file, caml_string_of_uint8_array
-//Requires: caml_string_of_jsbytes, caml_jsbytes_of_string
+//Requires: caml_string_of_jsstring, caml_jsstring_of_string
 function caml_read_file_content(name) {
-  var name = typeof name === "string" ? caml_string_of_jsbytes(name) : name;
+  var name = typeof name === "string" ? caml_string_of_jsstring(name) : name;
   var root = resolve_fs_device(name);
   if (root.device.exists(root.rest)) {
     var file = root.device.open(root.rest, { rdonly: 1 });
@@ -355,5 +359,5 @@ function caml_read_file_content(name) {
     file.read(buf, 0, len);
     return caml_string_of_uint8_array(buf);
   }
-  caml_raise_no_such_file(caml_jsbytes_of_string(name));
+  caml_raise_no_such_file(caml_jsstring_of_string(name));
 }

runtime/js/fs_fake.js

@@ -47,8 +47,8 @@ MlFakeDevice.prototype.slash = function (name) {
 MlFakeDevice.prototype.lookup = function (name) {
   if (!this.content[name] && this.lookupFun) {
     var res = this.lookupFun(
-      caml_string_of_jsbytes(this.root),
-      caml_string_of_jsbytes(name),
+      caml_string_of_jsstring(this.root),
+      caml_string_of_jsstring(name),
     );
     if (res !== 0) {
       this.create_dir_if_needed(name);
@@ -440,6 +440,7 @@ MlFakeFd.prototype.seek = function (offset, whence, raise_unix) {
   this.seeked = true;
 };
 MlFakeFd.prototype.close = function () {
+  if (!this.file) this.err_closed("close");
   this.file = undefined;
 };
 MlFakeFd.prototype.check_stream_semantics = function (cmd) {

runtime/js/fs_node.js

@@ -161,10 +161,6 @@ MlNodeDevice.prototype.open = function (name, f, perms, raise_unix) {
   }
   try {
     var fd = this.fs.openSync(this.nm(name), res, perms);
-    var isCharacterDevice = this.fs
-      .lstatSync(this.nm(name))
-      .isCharacterDevice();
-    f.isCharacterDevice = isCharacterDevice;
     return new MlNodeFd(fd, f);
   } catch (err) {
     caml_raise_nodejs_error(err, raise_unix);
@@ -233,9 +229,9 @@ MlNodeDevice.prototype.lstat = function (name, large, raise_unix) {
 MlNodeDevice.prototype.symlink = function (to_dir, target, path, raise_unix) {
   try {
     this.fs.symlinkSync(
-      this.nm(target),
+      target,
       this.nm(path),
-      to_dir ? "dir" : "file",
+      to_dir === 0 ? null : to_dir[1] ? "dir" : "file",
     );
     return 0;
   } catch (err) {
@@ -333,7 +329,10 @@ function MlNodeFd(fd, flags) {
   this.fs = require("node:fs");
   this.fd = fd;
   this.flags = flags;
-  this.offset = this.flags.append ? this.length() : 0;
+  var stats = this.fs.fstatSync(fd);
+  flags.noSeek =
+    stats.isCharacterDevice() || stats.isFIFO() || stats.isSocket();
+  this.offset = this.flags.append ? stats.size : 0;
   this.seeked = false;
 }
 MlNodeFd.prototype = new MlFile();
@@ -356,7 +355,7 @@ MlNodeFd.prototype.length = function () {
 };
 MlNodeFd.prototype.write = function (buf, buf_offset, len, raise_unix) {
   try {
-    if (this.flags.isCharacterDevice || !this.seeked)
+    if (this.flags.noSeek || !this.seeked)
       var written = this.fs.writeSync(this.fd, buf, buf_offset, len);
     else
       var written = this.fs.writeSync(
@@ -374,7 +373,7 @@ MlNodeFd.prototype.write = function (buf, buf_offset, len, raise_unix) {
 };
 MlNodeFd.prototype.read = function (a, buf_offset, len, raise_unix) {
   try {
-    if (this.flags.isCharacterDevice || !this.seeked)
+    if (this.flags.noSeek || !this.seeked)
       var read = this.fs.readSync(this.fd, a, buf_offset, len);
     else var read = this.fs.readSync(this.fd, a, buf_offset, len, this.offset);
     this.offset += read;
@@ -384,7 +383,7 @@ MlNodeFd.prototype.read = function (a, buf_offset, len, raise_unix) {
   }
 };
 MlNodeFd.prototype.seek = function (offset, whence, raise_unix) {
-  if (this.flags.isCharacterDevice)
+  if (this.flags.noSeek)
     caml_raise_system_error(raise_unix, "ESPIPE", "lseek", "illegal seek");
   switch (whence) {
     case 0:

runtime/js/io.js

@@ -42,7 +42,6 @@ function MlChanid(id) {
 //Requires: caml_raise_sys_error
 //Requires: MlFakeFd_out
 //Requires: resolve_fs_device
-//Requires: caml_jsbytes_of_string
 //Requires: fs_node_supported
 //Requires: caml_sys_fds
 //Requires: caml_sys_open_for_node
@@ -93,16 +92,6 @@ function caml_sys_open(name, flags, perms) {
     }
     flags = flags[2];
   }
-  if (f.rdonly && f.wronly)
-    caml_raise_sys_error(
-      caml_jsbytes_of_string(name) +
-        " : flags Open_rdonly and Open_wronly are not compatible",
-    );
-  if (f.text && f.binary)
-    caml_raise_sys_error(
-      caml_jsbytes_of_string(name) +
-        " : flags Open_text and Open_binary are not compatible",
-    );
   var root = resolve_fs_device(name);
   var file = root.device.open(root.rest, f, perms);
   return caml_sys_open_internal(file, undefined);
@@ -572,7 +561,9 @@ function caml_ml_flush(chanid) {
       caml_sub_uint8_array_to_jsbytes(chan.buffer, 0, chan.buffer_curr),
     );
   } else {
-    chan.file.write(chan.buffer, 0, chan.buffer_curr);
+    for (var pos = 0; pos < chan.buffer_curr; ) {
+      pos += chan.file.write(chan.buffer, pos, chan.buffer_curr - pos);
+    }
   }
   chan.offset += chan.buffer_curr;
   chan.buffer_curr = 0;

runtime/js/sys.js

@@ -18,9 +18,9 @@
 ///////////// Sys
 
 //Provides: caml_raise_sys_error (const)
-//Requires: caml_raise_with_string, caml_global_data
+//Requires: caml_raise_with_arg, caml_global_data, caml_string_of_jsstring
 function caml_raise_sys_error(msg) {
-  caml_raise_with_string(caml_global_data.Sys_error, msg);
+  caml_raise_with_arg(caml_global_data.Sys_error, caml_string_of_jsstring(msg));
 }
 
 //Provides: caml_sys_exit

runtime/js/unix.js

@@ -188,7 +188,8 @@ function make_unix_err_args(code, syscall, path, errno) {
       errno = -9999;
     }
     // If none of the above variants, fallback to EUNKNOWNERR(int)
-    variant = BLOCK(0, errno);
+    // errno is expected to be positive
+    variant = BLOCK(0, -errno);
   }
   var args = [
     variant,
@@ -219,7 +220,7 @@ function caml_unix_stat(name) {
 function caml_unix_stat_64(name) {
   var root = resolve_fs_device(name);
   if (!root.device.stat) {
-    caml_failwith("caml_unix_stat: not implemented");
+    caml_failwith("caml_unix_stat_64: not implemented");
   }
   return root.device.stat(
     root.rest,
@@ -249,7 +250,7 @@ function caml_unix_lstat(name) {
 function caml_unix_lstat_64(name) {
   var root = resolve_fs_device(name);
   if (!root.device.lstat) {
-    caml_failwith("caml_unix_lstat: not implemented");
+    caml_failwith("caml_unix_lstat_64: not implemented");
   }
   return root.device.lstat(
     root.rest,
@@ -294,19 +295,16 @@ function caml_unix_rmdir(name) {
 }
 
 //Provides: caml_unix_symlink
-//Requires: resolve_fs_device, caml_failwith
+//Requires: resolve_fs_device, caml_failwith, caml_jsstring_of_string
 //Alias: unix_symlink
 function caml_unix_symlink(to_dir, src, dst) {
-  var src_root = resolve_fs_device(src);
   var dst_root = resolve_fs_device(dst);
-  if (src_root.device !== dst_root.device)
-    caml_failwith("caml_unix_symlink: cannot symlink between two filesystems");
-  if (!src_root.device.symlink) {
+  if (!dst_root.device.symlink) {
     caml_failwith("caml_unix_symlink: not implemented");
   }
-  return src_root.device.symlink(
+  return dst_root.device.symlink(
     to_dir,
-    src_root.rest,
+    caml_jsstring_of_string(src),
     dst_root.rest,
     /* raise Unix_error */ true,
   );
@@ -365,7 +363,7 @@ function caml_unix_truncate(name, len) {
 function caml_unix_truncate_64(name, len) {
   var root = resolve_fs_device(name);
   if (!root.device.truncate) {
-    caml_failwith("caml_unix_truncate: not implemented");
+    caml_failwith("caml_unix_truncate_64: not implemented");
   }
   root.device.truncate(
     root.rest,
@@ -583,13 +581,12 @@ function caml_unix_outchannel_of_filedescr(fd) {
 }
 
 //Provides: caml_unix_getuid
-//Requires: caml_raise_not_found
 //Alias: unix_getuid
 function caml_unix_getuid(unit) {
   if (globalThis.process && globalThis.process.getuid) {
     return globalThis.process.getuid();
   }
-  caml_raise_not_found();
+  return 1;
 }
 
 //Provides: caml_unix_getpwuid