[Git][ghc/ghc][wip/js-rename-getcwd] JS: Implement missing C functions `rename`, `realpath`, and `getcwd` (#23806)

Josh Meredith (@JoshMeredith) gitlab at gitlab.haskell.org
Wed Aug 30 08:52:27 UTC 2023



Josh Meredith pushed to branch wip/js-rename-getcwd at Glasgow Haskell Compiler / GHC


Commits:
db0d44e0 by Josh Meredith at 2023-08-30T18:52:15+10:00
JS: Implement missing C functions `rename`, `realpath`, and `getcwd` (#23806)

- - - - -


3 changed files:

- libraries/base/jsbits/base.js
- testsuite/tests/ghc-api/downsweep/all.T
- testsuite/tests/rename/prog006/all.T


Changes:

=====================================
libraries/base/jsbits/base.js
=====================================
@@ -264,6 +264,59 @@ function h$rmdir(file, file_off) {
     h$unsupported(-1);
 }
 
+function h$rename(old_path, old_path_off, new_path, new_path_off) {
+  TRACE_IO("rename")
+#ifndef GHCJS_BROWSER
+  if (h$isNode()) {
+    try {
+      fs.renameSync(h$decodeUtf8z(old_path, old_path_off), h$decodeUtf8z(new_path, new_path_off));
+      return 0;
+    } catch(e) {
+      h$setErrno(e);
+      return -1;
+    }
+  } else
+#endif
+    h$unsupported(-1);
+}
+
+function h$getcwd(buf, off, buf_size) {
+  TRACE_IO("getcwd")
+#ifndef GHCJS_BROWSER
+  if (h$isNode()) {
+    try {
+      var cwd = h$encodeUtf8(process.cwd());
+      h$copyMutableByteArray(cwd, 0, buf, off, cwd.len);
+      RETURN_UBX_TUP2(cwd, 0);
+    } catch (e) {
+      h$setErrno(e);
+      return -1;
+    }
+  } else
+#endif
+    h$unsupported(-1);
+}
+
+function h$realpath(path,off,resolved,resolved_off) {
+  TRACE_IO("realpath")
+#ifndef GHCJS_BROWSER
+  if (h$isNode()) {
+    try {
+      var rp = h$encodeUtf8(fs.realpathSync(h$decodeUtf8z(path,off)));
+      if (resolved !== null) {
+        h$copyMutableByteArray(rp, 0, resolved, resolved_off, Math.min(resolved.len - resolved_off, rp.len));
+        RETURN_UBX_TUP2(resolved, resolved_off);
+      }
+      RETURN_UBX_TUP2(rp, 0);
+    } catch (e) {
+      h$setErrno(e);
+      return -1;
+    }
+  } else
+#endif
+    h$unsupported(-1);
+}
+
 function h$base_open(file, file_off, how, mode, c) {
 #ifndef GHCJS_BROWSER
     if(h$isNode()) {


=====================================
testsuite/tests/ghc-api/downsweep/all.T
=====================================
@@ -8,7 +8,6 @@ test('PartialDownsweep',
 
 test('OldModLocation',
      [ extra_run_opts('"' + config.libdir + '"')
-     , js_broken(22362)
      , when(opsys('mingw32'), expect_broken(16772))
      ],
      compile_and_run,


=====================================
testsuite/tests/rename/prog006/all.T
=====================================
@@ -1 +1 @@
-test('rn.prog006', [extra_files(['A.hs', 'B/', 'Main.hs', 'pwd.hs']), js_broken(22261)], makefile_test, [])
+test('rn.prog006', [extra_files(['A.hs', 'B/', 'Main.hs', 'pwd.hs'])], makefile_test, [])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db0d44e04b2f6d8a9465d4768d014d63e3b9d5d7

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/db0d44e04b2f6d8a9465d4768d014d63e3b9d5d7
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230830/e487093c/attachment-0001.html>


More information about the ghc-commits mailing list