[Git][ghc/ghc][master] 2 commits: JS: testsuite: use req_c predicate instead of js_broken

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jul 6 16:13:32 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
41968fd6 by Sylvain Henry at 2023-07-06T12:13:02-04:00
JS: testsuite: use req_c predicate instead of js_broken

- - - - -
74a4dd2e by Sylvain Henry at 2023-07-06T12:13:02-04:00
JS: implement some file primitives (lstat,rmdir) (#22374)

- Implement lstat and rmdir.
- Implement base_c_s_is* functions (testing a file type)
- Enable passing tests

- - - - -


5 changed files:

- libraries/base/System/Posix/Internals.hs
- libraries/base/jsbits/base.js
- libraries/base/tests/IO/all.T
- + libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs
- testsuite/tests/ghci/linking/all.T


Changes:

=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -517,7 +517,7 @@ foreign import javascript unsafe "h$base_isatty"
     c_isatty :: CInt -> IO CInt
 foreign import javascript interruptible "h$base_lseek"
    c_lseek :: CInt -> COff -> CInt -> IO COff
-foreign import javascript interruptible "h$base_lstat" -- fixme wrong type
+foreign import javascript interruptible "h$base_lstat"
    lstat :: CFilePath -> Ptr CStat -> IO CInt
 foreign import javascript interruptible "h$base_open"
    c_open :: CFilePath -> CInt -> CMode -> IO CInt


=====================================
libraries/base/jsbits/base.js
=====================================
@@ -230,6 +230,40 @@ function h$base_lstat(file, file_off, stat, stat_off, c) {
 #endif
         h$unsupported(-1, c);
 }
+
+function h$lstat(file, file_off, stat, stat_off) {
+  TRACE_IO("lstat")
+#ifndef GHCJS_BROWSER
+  if(h$isNode()) {
+    try {
+      var fs = h$fs.lstatSync(h$decodeUtf8z(file, file_off));
+      h$base_fillStat(fs, stat, stat_off);
+      return 0;
+    } catch(e) {
+      h$setErrno(e);
+      return -1;
+    }
+  } else
+#endif
+    h$unsupported(-1);
+}
+
+function h$rmdir(file, file_off) {
+  TRACE_IO("rmdir")
+#ifndef GHCJS_BROWSER
+  if(h$isNode()) {
+    try {
+      var fs = h$fs.rmdirSync(h$decodeUtf8z(file, file_off));
+      return 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()) {
@@ -435,20 +469,26 @@ function h$base_waitpid(pid, stat, stat_off, options, c) {
 /** @const */ var h$base_o_nonblock = 0x00004;
 /** @const */ var h$base_o_binary   = 0x00000;
 
+function h$base_stat_check_mode(mode,p) {
+  // inspired by Node's checkModeProperty
+  var r = (mode & h$fs.constants.S_IFMT) === p;
+  return r ? 1 : 0;
+}
+
 function h$base_c_s_isreg(mode) {
-    return 1;
+  return h$base_stat_check_mode(mode,h$fs.constants.S_IFREG);
 }
 function h$base_c_s_ischr(mode) {
-    return 0;
+  return h$base_stat_check_mode(mode,h$fs.constants.S_IFCHR);
 }
 function h$base_c_s_isblk(mode) {
-    return 0;
+  return h$base_stat_check_mode(mode,h$fs.constants.S_IFBLK);
 }
 function h$base_c_s_isdir(mode) {
-    return 0; // fixme
+  return h$base_stat_check_mode(mode,h$fs.constants.S_IFDIR);
 }
 function h$base_c_s_isfifo(mode) {
-    return 0;
+  return h$base_stat_check_mode(mode,h$fs.constants.S_IFIFO);
 }
 function h$base_c_fcntl_read(fd,cmd) {
     return -1;


=====================================
libraries/base/tests/IO/all.T
=====================================
@@ -12,8 +12,7 @@ test('hClose001', [], compile_and_run, [''])
 test('hClose002', [normalise_win32_io_errors, js_broken(22261)], compile_and_run, [''])
 test('hFileSize001',    normal, compile_and_run, [''])
 test('hFileSize002',
-     [omit_ghci, # different output
-      js_broken(22261)],
+     [omit_ghci], # different output
      compile_and_run, [''])
 test('hFlush001', [], compile_and_run, [''])
 
@@ -71,12 +70,12 @@ test('misc001', [extra_run_opts('misc001.hs misc001.out')], compile_and_run,
 
 test('openFile001',  normal, compile_and_run, [''])
 test('openFile002',  [exit_code(1), normalise_win32_io_errors], compile_and_run, [''])
-test('openFile003', [normalise_win32_io_errors, js_broken(22362)], compile_and_run, [''])
+test('openFile003', normalise_win32_io_errors, compile_and_run, [''])
 test('openFile004', [], compile_and_run, [''])
 test('openFile005', js_broken(22261), compile_and_run, [''])
 test('openFile006', [], compile_and_run, [''])
 test('openFile007', js_broken(22261), compile_and_run, [''])
-test('openFile008', [js_broken(22349), cmd_prefix('ulimit -n 1024; ')], compile_and_run, [''])
+test('openFile008', [cmd_prefix('ulimit -n 1024; ')], compile_and_run, [''])
 test('openFile009', [when(arch('wasm32'), fragile(23284))], compile_and_run, [''])
 
 test('putStr001',    normal, compile_and_run, [''])


=====================================
libraries/base/tests/IO/openFile003.stdout-javascript-unknown-ghcjs
=====================================
@@ -0,0 +1,4 @@
+Left openFile003Dir: openFile: inappropriate type (is a directory)
+Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory)
+Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory)
+Left openFile003Dir: openFile: inappropriate type (Illegal operation on a directory)


=====================================
testsuite/tests/ghci/linking/all.T
=====================================
@@ -48,7 +48,7 @@ test('ghcilink006',
 test('T3333',
      [unless(doing_ghci, skip),
       when(unregisterised(), fragile(17018)),
-      js_broken(22359)],
+      req_c],
      makefile_test, ['T3333'])
 
 test('T11531',
@@ -69,7 +69,7 @@ test('T14708',
 test('T15729',
      [extra_files(['T15729.hs', 'T15729.c']),
       unless(doing_ghci, skip),
-      js_broken(22359)],
+      req_c],
      makefile_test, ['T15729'])
 
 test('big-obj', [extra_files(['big-obj-c.c', 'big-obj.hs']),



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fdcf969db85f3fe64123ba150e9226a0d2995cd...74a4dd2ec6e200b11a56b6f82907feb66e94c90b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fdcf969db85f3fe64123ba150e9226a0d2995cd...74a4dd2ec6e200b11a56b6f82907feb66e94c90b
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/20230706/f435cd85/attachment-0001.html>


More information about the ghc-commits mailing list