[commit: ghc] master: Fix testcase T12903 on OS X (aa123f4)

git at git.haskell.org git at git.haskell.org
Tue Dec 13 21:24:01 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/aa123f445338c2980fcee87a09c01d14a83bf409/ghc

>---------------------------------------------------------------

commit aa123f445338c2980fcee87a09c01d14a83bf409
Author: Alexander Vershilov <alexander.vershilov at gmail.com>
Date:   Tue Dec 13 14:54:36 2016 -0500

    Fix testcase T12903 on OS X
    
    Old test used timeouts that leads to the various sporadic errors.
    Tet was rewritten to not use timeouts.
    
    Reviewers: austin, erikd, simonmar, bgamari
    
    Reviewed By: simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2827
    
    GHC Trac Issues: #12956


>---------------------------------------------------------------

aa123f445338c2980fcee87a09c01d14a83bf409
 testsuite/tests/rts/T12903.hs | 17 ++++++++++++++---
 testsuite/tests/rts/all.T     |  6 +-----
 2 files changed, 15 insertions(+), 8 deletions(-)

diff --git a/testsuite/tests/rts/T12903.hs b/testsuite/tests/rts/T12903.hs
index ddaf8b9..e4a8486 100644
--- a/testsuite/tests/rts/T12903.hs
+++ b/testsuite/tests/rts/T12903.hs
@@ -1,10 +1,21 @@
 import Control.Concurrent
 import Control.Exception
+import System.IO
 import System.Posix
+import System.Posix.IO
 
 main = do
+  (pout1, pin1) <- createPipe
+  (pout2, _) <- createPipe
   pid <- forkProcess $ do
-           handle (\UserInterrupt{} -> putStrLn "caught")
-                  $ threadDelay 2000000
+           hdl <- fdToHandle pin1
+           hSetBuffering hdl LineBuffering
+           handle (\UserInterrupt{} -> hPutStrLn hdl "caught")
+                  $ do hPutStrLn hdl "registered"
+                       hdl2 <- fdToHandle pout2
+                       putStrLn =<< hGetLine hdl2
+  hdl <- fdToHandle pout1
+  hSetBuffering hdl LineBuffering
+  "registered" <- hGetLine hdl
   signalProcess sigINT pid
-  threadDelay 2000000
+  putStrLn =<< hGetLine hdl
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index c44ec04..a645ad3 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -376,9 +376,5 @@ test('T12497', [ unless(opsys('mingw32'), skip)
                ],
                run_command, ['$MAKE -s --no-print-directory T12497'])
 
-# Test is being skipped on darwin due to it's flakiness.
-# See 12956
-test('T12903', [when(opsys('mingw32'), skip),
-                when(opsys('darwin'), skip)],
-     compile_and_run, [''])
+test('T12903', [when(opsys('mingw32'), skip)], compile_and_run, [''])
 



More information about the ghc-commits mailing list