From cbb7e8abe5890d3baf366151a548cd6b3b57073e Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Tue, 16 May 2023 12:28:37 +0200
Subject: [PATCH] JS: fix getpid (fix #23399)
---
libraries/base/System/Posix/Internals.hs | 2 +-
libraries/base/tests/System/T23399.hs | 9 +++++++++
libraries/base/tests/System/T23399.stdout | 1 +
libraries/base/tests/System/all.T | 1 +
4 files changed, 12 insertions(+), 1 deletion(-)
create mode 100644 libraries/base/tests/System/T23399.hs
create mode 100644 libraries/base/tests/System/T23399.stdout
diff --git a/libraries/base/System/Posix/Internals.hs b/libraries/base/System/Posix/Internals.hs
index 244e46f496c..bd3d4db8cac 100644
--- a/libraries/base/System/Posix/Internals.hs
+++ b/libraries/base/System/Posix/Internals.hs
@@ -499,7 +499,7 @@ foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_f
c_ftruncate :: CInt -> FileOffset -> IO CInt
foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })"
c_unlink :: CString -> IO CInt
-foreign import javascript unsafe "(() => { return h$base_getpid; })"
+foreign import javascript unsafe "h$base_getpid"
c_getpid :: IO CPid
-- foreign import ccall unsafe "HsBase.h fork"
-- c_fork :: IO CPid
diff --git a/libraries/base/tests/System/T23399.hs b/libraries/base/tests/System/T23399.hs
new file mode 100644
index 00000000000..4232c94d163
--- /dev/null
+++ b/libraries/base/tests/System/T23399.hs
@@ -0,0 +1,9 @@
+module Main where
+
+import System.Posix.Internals
+
+main = do
+ r <- c_getpid
+ -- #23399: JS backend wasn't returning a valid JS number as a CPid hence
+ -- "read" would fail because the string was "0\0" (not a number, NUL byte)
+ print ((read (show r) :: Int) /= -1)
diff --git a/libraries/base/tests/System/T23399.stdout b/libraries/base/tests/System/T23399.stdout
new file mode 100644
index 00000000000..0ca95142bb7
--- /dev/null
+++ b/libraries/base/tests/System/T23399.stdout
@@ -0,0 +1 @@
+True
diff --git a/libraries/base/tests/System/all.T b/libraries/base/tests/System/all.T
index 10ddd7754fb..b56d239b26a 100644
--- a/libraries/base/tests/System/all.T
+++ b/libraries/base/tests/System/all.T
@@ -8,3 +8,4 @@ test('system001', [js_broken(22349), when(opsys("mingw32"), skip), req_process],
compile_and_run, [''])
test('Timeout001', js_broken(22261), compile_and_run, [''])
test('T16466', normal, compile_and_run, [''])
+test('T23399', normal, compile_and_run, [''])
--
GitLab