From 2972fd66f91cb51426a1df86b8166a067015e231 Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Tue, 16 May 2023 12:28:37 +0200
Subject: 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 244e46f496..bd3d4db8ca 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 0000000000..4232c94d16
--- /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 0000000000..0ca95142bb
--- /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 10ddd7754f..b56d239b26 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, [''])
-- 
cgit v1.2.1