[Git][ghc/ghc][wip/js-exports] JS FFI: add tests for known broken uses

[Josh Meredith (@JoshMeredith)]

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


Commits:
4f8168d2 by Josh Meredith at 2023-03-14T15:25:01+00:00
JS FFI: add tests for known broken uses

- - - - -


7 changed files:

- testsuite/tests/javascript/all.T
- testsuite/tests/javascript/js-callback01.hs
- testsuite/tests/javascript/js-callback01.stdout
- + testsuite/tests/javascript/js-callback04.hs
- + testsuite/tests/javascript/js-callback04.stdout
- + testsuite/tests/javascript/js-callback05.hs
- + testsuite/tests/javascript/js-callback05.stdout


Changes:

=====================================
testsuite/tests/javascript/all.T
=====================================
@@ -13,3 +13,5 @@ test('js-ffi-array', normal, compile_and_run, [''])
 test('js-callback01', normal, compile_and_run, [''])
 test('js-callback02', normal, compile_and_run, [''])
 test('js-callback03', normal, compile_and_run, [''])
+test('js-callback04', js_skip, compile_and_run, [''])
+test('js-callback05', js_skip, compile_and_run, [''])


=====================================
testsuite/tests/javascript/js-callback01.hs
=====================================
@@ -2,7 +2,7 @@ import GHC.JS.Prim
 import GHC.JS.Foreign.Callback
 import Control.Concurrent
 
-foreign import javascript "(() => { console.log('test0'); })"
+foreign import javascript "(() => { console.log('test'); })"
   js_log0 :: IO ()
 
 foreign import javascript "((x) => { console.log(x); })"
@@ -28,7 +28,7 @@ foreign import javascript "((f,x,y,z) => { f(x,y,z); })"
 
 main :: IO ()
 main = do
-  log0  <- syncCallback  ThrowWouldBlock js_log0 -- (putStrLn "test0")
+  log0  <- syncCallback  ThrowWouldBlock js_log0
   log1  <- syncCallback1 ThrowWouldBlock js_log1
   log2  <- syncCallback2 ThrowWouldBlock js_log2
   log3  <- syncCallback3 ThrowWouldBlock js_log3
@@ -38,14 +38,14 @@ main = do
   js_apply2_ log2  (toJSString "test2x") (toJSString "test2y")
   js_apply3_ log3  (toJSString "test3x") (toJSString "test3y") (toJSString "test3z")
 
-  log0' <- asyncCallback  js_log0 -- (putStrLn "test0")
+  log0' <- asyncCallback  js_log0
   log1' <- asyncCallback1 js_log1
   log2' <- asyncCallback2 js_log2
   log3' <- asyncCallback3 js_log3
 
   js_apply0_ log0'
-  js_apply1_ log1' (toJSString "test1x")
-  js_apply2_ log2' (toJSString "test2x") (toJSString "test2y")
-  js_apply3_ log3' (toJSString "test3x") (toJSString "test3y") (toJSString "test3z")
+  js_apply1_ log1' (toJSString "test")
+  js_apply2_ log2' (toJSString "test") (toJSString "test")
+  js_apply3_ log3' (toJSString "test") (toJSString "test") (toJSString "test")
 
   threadDelay 1000000 -- Wait long enough for the async actions to complete


=====================================
testsuite/tests/javascript/js-callback01.stdout
=====================================
@@ -1,14 +1,14 @@
-test0
-test1x
-test2x
-test2y
-test3x
-test3y
-test3z
-test0
+test
 test1x
 test2x
 test2y
 test3x
 test3y
 test3z
+test
+test
+test
+test
+test
+test
+test


=====================================
testsuite/tests/javascript/js-callback04.hs
=====================================
@@ -0,0 +1,16 @@
+import GHC.JS.Prim
+import GHC.JS.Foreign.Callback
+
+foreign import javascript "(() => { console.log('javascript'); })"
+  js_log :: IO ()
+
+foreign import javascript "((f) => { f(); })"
+  js_apply0_ :: Callback (IO ()) -> IO ()
+
+main :: IO ()
+main = do
+  logH <- syncCallback ThrowWouldBlock (putStrLn "haskell")
+  logJ <- syncCallback ThrowWouldBlock js_log
+
+  js_apply0_ logH
+  js_apply0_ logJ


=====================================
testsuite/tests/javascript/js-callback04.stdout
=====================================
@@ -0,0 +1,2 @@
+haskell
+javascript


=====================================
testsuite/tests/javascript/js-callback05.hs
=====================================
@@ -0,0 +1,12 @@
+import GHC.JS.Prim
+import GHC.JS.Foreign.Callback
+import System.IO
+
+foreign import javascript "((f) => { f(); })"
+  js_apply0_ :: Callback (IO ()) -> IO ()
+
+main :: IO ()
+main = do
+  log <- syncCallback ThrowWouldBlock (putStrLn "test" >> hFlush stdout
+  js_apply0_ log
+  js_apply0_ log


=====================================
testsuite/tests/javascript/js-callback05.stdout
=====================================
@@ -0,0 +1,2 @@
+test
+test



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4f8168d259e6f884ae4f82fd139b03e818885dca
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/20230314/c5a86179/attachment-0001.html>