From 28295f7b074a351a4a27054509f0ba357888af1d Mon Sep 17 00:00:00 2001 From: David Binder Date: Mon, 27 Nov 2023 19:58:31 +0100 Subject: [PATCH] Remove tests/ subdirectory The tests in the `tests` subdirectory are only run by the GHC testsuite. Following https://gitlab.haskell.org/ghc/ghc/-/issues/22622 the tests will be moved from the git submodule to the `testsuite/tests` directory in GHC itself. --- tests/.gitignore | 31 -------- tests/Makefile | 15 ---- tests/T1780.hs | 19 ----- tests/T1780.stdout | 1 - tests/T3231.hs | 22 ------ tests/T3231.stdout | 1 - tests/T3994.hs | 22 ------ tests/T3994.stdout | 2 - tests/T3994app.hs | 10 --- tests/T4198.hs | 3 - tests/T4198.stdout | 1 - tests/T4198.stdout-mingw32 | 1 - tests/T4889.hs | 10 --- tests/T4889.stdout | 2 - tests/T8343.hs | 8 -- tests/T8343.stdout | 2 - tests/T9775/Makefile | 12 --- tests/T9775/T9775_fail.hs | 7 -- tests/T9775/T9775_fail.stdout | 2 - tests/T9775/T9775_good.hs | 7 -- tests/T9775/T9775_good.stdout | 2 - tests/T9775/all.T | 14 ---- tests/T9775/main.c | 6 -- tests/T9775/ok.c | 8 -- tests/all.T | 53 -------------- tests/exitminus1.c | 1 - tests/process001.hs | 10 --- tests/process002.hs | 9 --- tests/process003.hs | 24 ------ tests/process003.stdout | 4 - tests/process004.hs | 23 ------ tests/process004.stdout | 2 - ...process004.stdout-javascript-unknown-ghcjs | 2 - tests/process004.stdout-mingw32 | 2 - tests/process005.hs | 26 ------- tests/process005.stdin | 3 - tests/process005.stdout | 4 - tests/process006.hs | 15 ---- tests/process006.stderr | 1 - tests/process006.stdout | 4 - tests/process007.hs | 24 ------ tests/process007.stdout | 2 - tests/process007_fd.c | 41 ----------- tests/process008.hs | 9 --- tests/process008.stdout | 2 - tests/process009.hs | 24 ------ tests/process009.stdout | 3 - tests/process010.hs | 13 ---- tests/process010.stdout | 4 - tests/process010.stdout-i386-unknown-solaris2 | 4 - ...process010.stdout-javascript-unknown-ghcjs | 4 - tests/process010.stdout-mingw32 | 4 - tests/process011.hs | 73 ------------------- tests/process011.stdout | 12 --- tests/process011_c.c | 9 --- tests/processT251.hs | 39 ---------- tests/processT251.stdout | 6 -- 57 files changed, 664 deletions(-) delete mode 100644 tests/.gitignore delete mode 100644 tests/Makefile delete mode 100644 tests/T1780.hs delete mode 100644 tests/T1780.stdout delete mode 100644 tests/T3231.hs delete mode 100644 tests/T3231.stdout delete mode 100644 tests/T3994.hs delete mode 100644 tests/T3994.stdout delete mode 100644 tests/T3994app.hs delete mode 100644 tests/T4198.hs delete mode 100644 tests/T4198.stdout delete mode 100644 tests/T4198.stdout-mingw32 delete mode 100644 tests/T4889.hs delete mode 100644 tests/T4889.stdout delete mode 100644 tests/T8343.hs delete mode 100644 tests/T8343.stdout delete mode 100644 tests/T9775/Makefile delete mode 100644 tests/T9775/T9775_fail.hs delete mode 100644 tests/T9775/T9775_fail.stdout delete mode 100644 tests/T9775/T9775_good.hs delete mode 100644 tests/T9775/T9775_good.stdout delete mode 100644 tests/T9775/all.T delete mode 100644 tests/T9775/main.c delete mode 100644 tests/T9775/ok.c delete mode 100644 tests/all.T delete mode 100644 tests/exitminus1.c delete mode 100644 tests/process001.hs delete mode 100644 tests/process002.hs delete mode 100644 tests/process003.hs delete mode 100644 tests/process003.stdout delete mode 100644 tests/process004.hs delete mode 100644 tests/process004.stdout delete mode 100644 tests/process004.stdout-javascript-unknown-ghcjs delete mode 100644 tests/process004.stdout-mingw32 delete mode 100644 tests/process005.hs delete mode 100644 tests/process005.stdin delete mode 100644 tests/process005.stdout delete mode 100644 tests/process006.hs delete mode 100644 tests/process006.stderr delete mode 100644 tests/process006.stdout delete mode 100644 tests/process007.hs delete mode 100644 tests/process007.stdout delete mode 100644 tests/process007_fd.c delete mode 100644 tests/process008.hs delete mode 100644 tests/process008.stdout delete mode 100644 tests/process009.hs delete mode 100644 tests/process009.stdout delete mode 100644 tests/process010.hs delete mode 100644 tests/process010.stdout delete mode 100644 tests/process010.stdout-i386-unknown-solaris2 delete mode 100644 tests/process010.stdout-javascript-unknown-ghcjs delete mode 100644 tests/process010.stdout-mingw32 delete mode 100644 tests/process011.hs delete mode 100644 tests/process011.stdout delete mode 100644 tests/process011_c.c delete mode 100644 tests/processT251.hs delete mode 100644 tests/processT251.stdout diff --git a/tests/.gitignore b/tests/.gitignore deleted file mode 100644 index 73f38bb5..00000000 --- a/tests/.gitignore +++ /dev/null @@ -1,31 +0,0 @@ -.hpc*/ -*.o -*.hi -*.comp.std* -*.run.std* -*.eventlog -*.genscript -*.exe - -# specific files -/T1780 -/T3231 -/T3994 -/T4198 -/T4889 -/T8343 -/process001 -/process001.out -/process002 -/process002.out -/process003 -/process004 -/process005 -/process006 -/process007 -/process007.tmp -/process007_fd -/process008 -/process009 -/process010 -/process011 diff --git a/tests/Makefile b/tests/Makefile deleted file mode 100644 index 6d33dee9..00000000 --- a/tests/Makefile +++ /dev/null @@ -1,15 +0,0 @@ -# This Makefile runs the tests using GHC's testsuite framework. It -# assumes the package is part of a GHC build tree with the testsuite -# installed in ../../../testsuite. - -TOP=../../../testsuite -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -.PHONY: process007_fd -process007_fd: - '$(TEST_HC)' -optc='-Wall' -no-hs-main -no-auto-link-packages process007_fd.c -o process007_fd - -.PHONY: T3994app -T3994app: - '$(TEST_HC)' $(TEST_HC_OPTS) T3994app.hs -threaded diff --git a/tests/T1780.hs b/tests/T1780.hs deleted file mode 100644 index b56721fa..00000000 --- a/tests/T1780.hs +++ /dev/null @@ -1,19 +0,0 @@ -module Main where - -import Control.Concurrent -import System.IO -import System.Process - -launch :: String -> IO String -launch i = do (hin,hout,herr,ph) <- runInteractiveProcess "cat" [] Nothing Nothing - -- forkIO $ collect ph -- This doesn't seem to be relevant to the problem. - forkIO $ do hPutStr hin i - hClose hin - hGetContents hout - -main :: IO () -main = do o <- foldl (>>=) (return "foo") (replicate 5 launch) - t <- myThreadId - -- timeout - forkIO $ do threadDelay 5000000; killThread t - putStrLn o diff --git a/tests/T1780.stdout b/tests/T1780.stdout deleted file mode 100644 index 257cc564..00000000 --- a/tests/T1780.stdout +++ /dev/null @@ -1 +0,0 @@ -foo diff --git a/tests/T3231.hs b/tests/T3231.hs deleted file mode 100644 index 7440757d..00000000 --- a/tests/T3231.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main (main) where - -import Control.Concurrent -import System.IO -import System.Cmd -import System.Directory - -main = do - hSetBuffering stdout NoBuffering - forkIO $ f "foo1.txt" - forkIO $ f "foo2.txt" - threadDelay $ 2*1000000 - putStrLn "Finished successfully" - -f file = do - h <- openFile file WriteMode - hPutStrLn h "fjkladsf" - system "sleep 1" - -- putChar '.' - hClose h - removeFile file - f file diff --git a/tests/T3231.stdout b/tests/T3231.stdout deleted file mode 100644 index c34ed5b8..00000000 --- a/tests/T3231.stdout +++ /dev/null @@ -1 +0,0 @@ -Finished successfully diff --git a/tests/T3994.hs b/tests/T3994.hs deleted file mode 100644 index 78ba977c..00000000 --- a/tests/T3994.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Main where - -import Control.Concurrent -import System.IO -import System.Process - -main :: IO () -main = do (_,Just hout,_,p) <- createProcess (proc "./T3994app" ["start", "10000"]) - { std_out = CreatePipe, create_group = True } - start <- hGetLine hout - putStrLn start - interruptProcessGroupOf p - t <- myThreadId - -- timeout - forkIO $ do - threadDelay 5000000 - putStrLn "Interrupting a Running Process Failed" - hFlush stdout - killThread t - waitForProcess p - putStrLn "end" - return () diff --git a/tests/T3994.stdout b/tests/T3994.stdout deleted file mode 100644 index 5d0fb3b2..00000000 --- a/tests/T3994.stdout +++ /dev/null @@ -1,2 +0,0 @@ -start -end diff --git a/tests/T3994app.hs b/tests/T3994app.hs deleted file mode 100644 index 09e574ff..00000000 --- a/tests/T3994app.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -import Control.Concurrent -import System.Environment - -main :: IO () -main = do (str:time:_) <- getArgs - putStrLn str - threadDelay (read time) - return () diff --git a/tests/T4198.hs b/tests/T4198.hs deleted file mode 100644 index c48517f2..00000000 --- a/tests/T4198.hs +++ /dev/null @@ -1,3 +0,0 @@ -import System.Process -import System.FilePath -main = system ("." "exitminus1") >>= print diff --git a/tests/T4198.stdout b/tests/T4198.stdout deleted file mode 100644 index daf2f5f2..00000000 --- a/tests/T4198.stdout +++ /dev/null @@ -1 +0,0 @@ -ExitFailure 255 diff --git a/tests/T4198.stdout-mingw32 b/tests/T4198.stdout-mingw32 deleted file mode 100644 index 6af223b7..00000000 --- a/tests/T4198.stdout-mingw32 +++ /dev/null @@ -1 +0,0 @@ -ExitFailure (-1) diff --git a/tests/T4889.hs b/tests/T4889.hs deleted file mode 100644 index d8feb476..00000000 --- a/tests/T4889.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Main where - -import System.Process - -main :: IO () -main = do - let text = unlines . map show $ [1..10000 :: Int] - (code, out, _) <- readProcessWithExitCode "head" ["-n", "1"] text - print code - putStr out diff --git a/tests/T4889.stdout b/tests/T4889.stdout deleted file mode 100644 index d72cac55..00000000 --- a/tests/T4889.stdout +++ /dev/null @@ -1,2 +0,0 @@ -ExitSuccess -1 diff --git a/tests/T8343.hs b/tests/T8343.hs deleted file mode 100644 index 23363a50..00000000 --- a/tests/T8343.hs +++ /dev/null @@ -1,8 +0,0 @@ -import System.Process -import System.Timeout - -main = timeout 1000000 $ do -- The outer timeout shouldn't trigger - timeout 10000 $ print =<< readProcess "sleep" ["7200"] "" - putStrLn "Good!" - timeout 10000 $ print =<< readProcessWithExitCode "sleep" ["7200"] "" - putStrLn "Good!" diff --git a/tests/T8343.stdout b/tests/T8343.stdout deleted file mode 100644 index 75c573d5..00000000 --- a/tests/T8343.stdout +++ /dev/null @@ -1,2 +0,0 @@ -Good! -Good! diff --git a/tests/T9775/Makefile b/tests/T9775/Makefile deleted file mode 100644 index 8e1cd6e3..00000000 --- a/tests/T9775/Makefile +++ /dev/null @@ -1,12 +0,0 @@ -# This Makefile runs the tests using GHC's testsuite framework. It -# assumes the package is part of a GHC build tree with the testsuite -# installed in ../../../testsuite. - -TOP=../../../../testsuite -include $(TOP)/mk/boilerplate.mk -include $(TOP)/mk/test.mk - -.PHONY: T9775 -T9775: - '$(TEST_CC)' $(TEST_CC_OPTS) ok.c -o ok.exe - '$(TEST_CC)' $(TEST_CC_OPTS) main.c -o main.exe diff --git a/tests/T9775/T9775_fail.hs b/tests/T9775/T9775_fail.hs deleted file mode 100644 index b2cc020d..00000000 --- a/tests/T9775/T9775_fail.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import System.Process - -main - = do (_,_,_,p) <- createProcess (proc "main" []) - waitForProcess p >>= print diff --git a/tests/T9775/T9775_fail.stdout b/tests/T9775/T9775_fail.stdout deleted file mode 100644 index 7374c53f..00000000 --- a/tests/T9775/T9775_fail.stdout +++ /dev/null @@ -1,2 +0,0 @@ -ExitSuccess -bye bye diff --git a/tests/T9775/T9775_good.hs b/tests/T9775/T9775_good.hs deleted file mode 100644 index a66c3165..00000000 --- a/tests/T9775/T9775_good.hs +++ /dev/null @@ -1,7 +0,0 @@ -module Main where - -import System.Process - -main - = do (_,_,_,p) <- createProcess ((proc "main" []){ use_process_jobs = True }) - waitForProcess p >>= print diff --git a/tests/T9775/T9775_good.stdout b/tests/T9775/T9775_good.stdout deleted file mode 100644 index 14b2f72e..00000000 --- a/tests/T9775/T9775_good.stdout +++ /dev/null @@ -1,2 +0,0 @@ -bye bye -ExitSuccess diff --git a/tests/T9775/all.T b/tests/T9775/all.T deleted file mode 100644 index ae07e48a..00000000 --- a/tests/T9775/all.T +++ /dev/null @@ -1,14 +0,0 @@ - -test('T9775_fail', - [extra_files(['ok.c', 'main.c']), - unless(opsys('mingw32'),skip), - pre_cmd('$MAKE -s --no-print-directory T9775'), - req_process], - compile_and_run, ['']) - -test('T9775_good', - [unless(opsys('mingw32'),skip), - extra_files(['ok.c', 'main.c']), - pre_cmd('$MAKE -s --no-print-directory T9775'), - req_process], - compile_and_run, ['']) diff --git a/tests/T9775/main.c b/tests/T9775/main.c deleted file mode 100644 index 2c891b1a..00000000 --- a/tests/T9775/main.c +++ /dev/null @@ -1,6 +0,0 @@ -#include - -int main(int argc, char *argv[]) { - char * args[2] = { "ok", NULL }; - execv("./ok", args); -} diff --git a/tests/T9775/ok.c b/tests/T9775/ok.c deleted file mode 100644 index 50191dc0..00000000 --- a/tests/T9775/ok.c +++ /dev/null @@ -1,8 +0,0 @@ -#include -#include - -int main() { - Sleep(2000); - printf("bye bye\n"); - return 120; -} diff --git a/tests/all.T b/tests/all.T deleted file mode 100644 index afc0bb1a..00000000 --- a/tests/all.T +++ /dev/null @@ -1,53 +0,0 @@ -# some platforms use spawnp instead of exec in some cases, resulting -# in spurious error output changes. -normalise_exec = normalise_fun(lambda s: s.replace('posix_spawnp', 'exec')) - -test('process001', [req_process], compile_and_run, ['']) -test('process002', [fragile_for(16547, concurrent_ways), req_process], compile_and_run, ['']) -test('process003', [fragile_for(17245, concurrent_ways), req_process], compile_and_run, ['']) -test('process004', [normalise_exec, normalise_exe, req_process], compile_and_run, ['']) -test('T1780', [req_process], compile_and_run, ['']) -test('process005', [omit_ghci, req_process], compile_and_run, ['']) -test('process006', [req_process], compile_and_run, ['']) - -test('process007', - [when(opsys('mingw32'), skip), - pre_cmd('$MAKE -s --no-print-directory process007_fd'), - js_broken(22349), - req_process], - compile_and_run, ['']) -test('process008', [req_process], compile_and_run, ['']) - -# not the normal way: this test runs processes from multiple threads, and -# will get stuck without the threaded RTS. -test('T3231', - [only_ways(['threaded1','threaded2']), - req_process], - compile_and_run, - ['']) -test('T4198', - [pre_cmd('{compiler} exitminus1.c -no-hs-main -o exitminus1'), - js_broken(22349), - req_process], - compile_and_run, - ['']) - -test('T3994', [only_ways(['threaded1','threaded2']), - extra_files(['T3994app.hs']), - pre_cmd('$MAKE -s --no-print-directory T3994app'), - req_process], - compile_and_run, ['']) -test('T4889',[req_process], compile_and_run, ['']) - -test('process009', [when(opsys('mingw32'), skip), req_process], compile_and_run, ['']) -test('process010', [ - normalise_fun(lambda s: s.replace('illegal operation (Inappropriate ioctl for device)', 'does not exist (No such file or directory)')), - normalise_exec, - req_process -], compile_and_run, ['']) -test('process011', - [when(opsys('mingw32'), skip), pre_cmd('{compiler} -no-hs-main -o process011_c process011_c.c'), js_broken(22349), req_process], - compile_and_run, ['']) - -test('T8343', [req_process], compile_and_run, ['']) -test('processT251', [omit_ghci, req_process], compile_and_run, ['']) diff --git a/tests/exitminus1.c b/tests/exitminus1.c deleted file mode 100644 index b381c7fe..00000000 --- a/tests/exitminus1.c +++ /dev/null @@ -1 +0,0 @@ -int main() { return -1; } diff --git a/tests/process001.hs b/tests/process001.hs deleted file mode 100644 index 2ad5a465..00000000 --- a/tests/process001.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# OPTIONS -cpp #-} -import System.IO -import System.Process - -test = do - h <- openFile "process001.out" WriteMode - ph <- runProcess "ls" [] Nothing Nothing Nothing (Just h) Nothing - waitForProcess ph - -main = test >> test >> return () diff --git a/tests/process002.hs b/tests/process002.hs deleted file mode 100644 index bf681ad0..00000000 --- a/tests/process002.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# OPTIONS -cpp #-} -import System.Process -import System.IO - -main = do - h <- openFile "process002.out" WriteMode - ph <- runProcess "ls" [] Nothing Nothing Nothing (Just h) (Just h) - waitForProcess ph - return () diff --git a/tests/process003.hs b/tests/process003.hs deleted file mode 100644 index 9d8d7d24..00000000 --- a/tests/process003.hs +++ /dev/null @@ -1,24 +0,0 @@ --- [ ghc-Bugs-1249226 ] runInteractiveProcess and closed stdin. --- Fixed in rev 1.9 of fptools/libraries/base/cbits/runProcess.c - --- This test doesn't work in GHCi, because FD 0 gets re-allocated to --- the IO manager pipe, which isn't set to non-blocking mode, and the --- interactive prompt ends up blocking on a read from this descriptor. - -import System.IO -import Control.Concurrent -import System.Process - -main = do - hClose stdin -- everything works as expected if the handle isn't closed. - putStrLn "Running cat ..." - (inp, out, err, pid) <- runInteractiveProcess "cat" [] Nothing Nothing - forkIO (hPutStrLn inp "foo" >> hClose inp) - mout <- newEmptyMVar - merr <- newEmptyMVar - forkIO (hGetContents out >>= \s -> length s `seq` putMVar mout s) - forkIO (hGetContents err >>= \s -> length s `seq` putMVar merr s) - -- Don't want to deal with waitForProcess and -threaded right now. - takeMVar mout >>= putStrLn - takeMVar merr >>= putStrLn - return () diff --git a/tests/process003.stdout b/tests/process003.stdout deleted file mode 100644 index 12cd09d0..00000000 --- a/tests/process003.stdout +++ /dev/null @@ -1,4 +0,0 @@ -Running cat ... -foo - - diff --git a/tests/process004.hs b/tests/process004.hs deleted file mode 100644 index d72dc6db..00000000 --- a/tests/process004.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Main where - -import System.IO.Error -import System.Process - -main :: IO () -main = do test1 `catchIOError` \e -> putStrLn ("Exc: " ++ show e) - test2 `catchIOError` \e -> putStrLn ("Exc: " ++ show e) - -test1 :: IO () -test1 = do - (_, _, _, commhand) <- - runInteractiveProcess "true" [] (Just "/no/such/dir") Nothing - exitCode <- waitForProcess commhand - print exitCode - -test2 :: IO () -test2 = do - commhand <- runProcess "true" [] (Just "/no/such/dir") Nothing - Nothing Nothing Nothing - exitCode <- waitForProcess commhand - print exitCode - diff --git a/tests/process004.stdout b/tests/process004.stdout deleted file mode 100644 index e8220702..00000000 --- a/tests/process004.stdout +++ /dev/null @@ -1,2 +0,0 @@ -Exc: true: runInteractiveProcess: chdir: invalid argument (Bad file descriptor) -Exc: true: runProcess: chdir: does not exist (No such file or directory) diff --git a/tests/process004.stdout-javascript-unknown-ghcjs b/tests/process004.stdout-javascript-unknown-ghcjs deleted file mode 100644 index e90c998d..00000000 --- a/tests/process004.stdout-javascript-unknown-ghcjs +++ /dev/null @@ -1,2 +0,0 @@ -Exc: true: runInteractiveProcess: does not exist (No such file or directory) -Exc: true: runProcess: does not exist (No such file or directory) diff --git a/tests/process004.stdout-mingw32 b/tests/process004.stdout-mingw32 deleted file mode 100644 index e9e0e0cd..00000000 --- a/tests/process004.stdout-mingw32 +++ /dev/null @@ -1,2 +0,0 @@ -Exc: true: runInteractiveProcess: invalid argument (Invalid argument) -Exc: true: runProcess: invalid argument (Invalid argument) diff --git a/tests/process005.hs b/tests/process005.hs deleted file mode 100644 index adb18109..00000000 --- a/tests/process005.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Main where - -import Control.Concurrent -import System.IO -import System.Process - -main :: IO () -main = do p <- foldl (>>=) (return stdin) (replicate 10 docat) >>= docat0 - t <- myThreadId - -- timeout - forkIO $ do threadDelay 5000000; killThread t - waitForProcess p - putStrLn "end" - return () - -docat :: Handle -> IO Handle -docat hin = do - (_, Just hout, _, ph) <- - createProcess (proc "cat" []){ std_in = UseHandle hin, - std_out = CreatePipe } - return hout - -docat0 :: Handle -> IO ProcessHandle -docat0 hin = do - (_,_,_,ph) <- createProcess (proc "cat" []){ std_in = UseHandle hin } - return ph diff --git a/tests/process005.stdin b/tests/process005.stdin deleted file mode 100644 index d2b8b3d2..00000000 --- a/tests/process005.stdin +++ /dev/null @@ -1,3 +0,0 @@ -testing -testing -123 diff --git a/tests/process005.stdout b/tests/process005.stdout deleted file mode 100644 index e09696b2..00000000 --- a/tests/process005.stdout +++ /dev/null @@ -1,4 +0,0 @@ -testing -testing -123 -end diff --git a/tests/process006.hs b/tests/process006.hs deleted file mode 100644 index 63e13591..00000000 --- a/tests/process006.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Main where - -import Control.Concurrent -import System.IO -import System.Process -import Control.Monad -import Control.Exception - -main :: IO () -main = do - print =<< readProcess "cat" [] "yan\ntan\tether\n" - print =<< readProcessWithExitCode "cat" [] "yan\ntan\tether\n" - print =<< readProcessWithExitCode "sh" ["-c", "echo stdout; echo stderr 1>&2; exit 3"] "" - e <- (try $ readProcess "sh" ["-c", "echo stdout; echo stderr 1>&2; exit 3"] "") - print (e :: Either SomeException String) diff --git a/tests/process006.stderr b/tests/process006.stderr deleted file mode 100644 index af6415db..00000000 --- a/tests/process006.stderr +++ /dev/null @@ -1 +0,0 @@ -stderr diff --git a/tests/process006.stdout b/tests/process006.stdout deleted file mode 100644 index 1e1186b3..00000000 --- a/tests/process006.stdout +++ /dev/null @@ -1,4 +0,0 @@ -"yan\ntan\tether\n" -(ExitSuccess,"yan\ntan\tether\n","") -(ExitFailure 3,"stdout\n","stderr\n") -Left readCreateProcess: sh "-c" "echo stdout; echo stderr 1>&2; exit 3" (exit 3): failed diff --git a/tests/process007.hs b/tests/process007.hs deleted file mode 100644 index 506a0ca4..00000000 --- a/tests/process007.hs +++ /dev/null @@ -1,24 +0,0 @@ - -import System.Process -import System.IO -import System.Posix -import System.Exit - -tmpfile = "process007.tmp" - -main = do - writeFile tmpfile "You bad pie-rats!\n" - fd <- handleToFd =<< openFile tmpfile ReadMode - rawSystem "./process007_fd" [show fd] - closeFd fd - - fd <- handleToFd =<< openFile tmpfile ReadMode - nul <- openFile "/dev/null" WriteMode - (_,_,_,p) <- createProcess (shell ("./process007_fd " ++ show fd)) - { close_fds = True, - std_err = UseHandle nul } - e <- waitForProcess p - case e of - ExitSuccess -> putStrLn "eek!" - _ -> putStrLn "failed, as expected" - closeFd fd diff --git a/tests/process007.stdout b/tests/process007.stdout deleted file mode 100644 index 7a9b0bf1..00000000 --- a/tests/process007.stdout +++ /dev/null @@ -1,2 +0,0 @@ -You bad pie-rats! -failed, as expected diff --git a/tests/process007_fd.c b/tests/process007_fd.c deleted file mode 100644 index f62ec249..00000000 --- a/tests/process007_fd.c +++ /dev/null @@ -1,41 +0,0 @@ - -#include -#include -#include -#include - -#define SIZE 1024 - -int main(int argc, char **argv) { - int fd; - char buf[SIZE]; - int nRead, nWrite; - - if (argc != 2) { - printf("Bad arguments\n"); - exit(1); - } - - fd = atoi(argv[1]); - - while ((nRead = read(fd, buf, SIZE)) != 0) { - if (nRead > 0) { - ssize_t nWritten = 0; - while (nWritten < nRead) { - nWrite = write(STDOUT_FILENO, buf + nWritten, nRead - nWritten); - if (nWrite < 0) { - perror("printf failed"); - exit(1); - } - nWritten += nWrite; - } - } - else if (errno != EAGAIN && errno != EWOULDBLOCK && errno != EINTR) { - perror("read failed"); - exit(1); - } - } - - return 0; -} - diff --git a/tests/process008.hs b/tests/process008.hs deleted file mode 100644 index 712e7db1..00000000 --- a/tests/process008.hs +++ /dev/null @@ -1,9 +0,0 @@ -{-# OPTIONS -cpp #-} -import System.IO -import System.Cmd -import System.Environment - --- echo can't be run outside of the shell in MSYS, hence: -test = rawSystem "sh" ["-c","echo testing"] - -main = test >> test >> return () diff --git a/tests/process008.stdout b/tests/process008.stdout deleted file mode 100644 index 755cc82b..00000000 --- a/tests/process008.stdout +++ /dev/null @@ -1,2 +0,0 @@ -testing -testing diff --git a/tests/process009.hs b/tests/process009.hs deleted file mode 100644 index 7cffd335..00000000 --- a/tests/process009.hs +++ /dev/null @@ -1,24 +0,0 @@ -import Control.Monad -import System.Exit -import System.Process -import Data.Maybe -import Data.List (intercalate) - --- Test that we get the right exit code for processes that terminate --- with a signal (#7229) - -main = do - let script = intercalate " " - [ "exec python3 2>/dev/null" - , "-c" - , "'import os; os.kill(os.getpid(), 1)'" - ] - (_,_,_,p) <- createProcess (shell script) - waitForProcess p >>= print - getProcessExitCode p >>= print - - (_,_,_,p) <- createProcess (shell script) - forever $ do - r <- getProcessExitCode p - if (isJust r) then do print r; exitWith ExitSuccess else return () - diff --git a/tests/process009.stdout b/tests/process009.stdout deleted file mode 100644 index 751a73aa..00000000 --- a/tests/process009.stdout +++ /dev/null @@ -1,3 +0,0 @@ -ExitFailure (-1) -Just (ExitFailure (-1)) -Just (ExitFailure (-1)) diff --git a/tests/process010.hs b/tests/process010.hs deleted file mode 100644 index ea188eef..00000000 --- a/tests/process010.hs +++ /dev/null @@ -1,13 +0,0 @@ - -import System.IO.Error -import System.Process - -main :: IO () -main = do run "true" - run "false" - run "/non/existent" - putStrLn "Done" - -run :: FilePath -> IO () -run fp = (rawSystem fp [] >>= print) - `catchIOError` \e -> putStrLn ("Exc: " ++ show e) diff --git a/tests/process010.stdout b/tests/process010.stdout deleted file mode 100644 index 1c78052d..00000000 --- a/tests/process010.stdout +++ /dev/null @@ -1,4 +0,0 @@ -ExitSuccess -ExitFailure 1 -Exc: /non/existent: rawSystem: posix_spawnp: illegal operation (Inappropriate ioctl for device) -Done diff --git a/tests/process010.stdout-i386-unknown-solaris2 b/tests/process010.stdout-i386-unknown-solaris2 deleted file mode 100644 index 316b23c7..00000000 --- a/tests/process010.stdout-i386-unknown-solaris2 +++ /dev/null @@ -1,4 +0,0 @@ -ExitSuccess -ExitFailure 255 -Exc: /non/existent: rawSystem: runInteractiveProcess: exec: does not exist (No such file or directory) -Done diff --git a/tests/process010.stdout-javascript-unknown-ghcjs b/tests/process010.stdout-javascript-unknown-ghcjs deleted file mode 100644 index 17d996a8..00000000 --- a/tests/process010.stdout-javascript-unknown-ghcjs +++ /dev/null @@ -1,4 +0,0 @@ -ExitSuccess -ExitFailure 1 -Exc: /non/existent: rawSystem: does not exist (No such file or directory) -Done diff --git a/tests/process010.stdout-mingw32 b/tests/process010.stdout-mingw32 deleted file mode 100644 index 17d996a8..00000000 --- a/tests/process010.stdout-mingw32 +++ /dev/null @@ -1,4 +0,0 @@ -ExitSuccess -ExitFailure 1 -Exc: /non/existent: rawSystem: does not exist (No such file or directory) -Done diff --git a/tests/process011.hs b/tests/process011.hs deleted file mode 100644 index b711fe49..00000000 --- a/tests/process011.hs +++ /dev/null @@ -1,73 +0,0 @@ -import System.Process -import System.IO -import Control.Exception -import Control.Concurrent -import Data.List (intercalate) - --- Test control-C delegation (#2301) - -main :: IO () -main = do - hSetBuffering stdout LineBuffering - - putStrLn "===================== test 1" - - -- shell kills itself with SIGINT, - -- delegation off, exit code (death by signal) reported as normal - do let script = "./process011_c" - (_,_,_,p) <- createProcess (proc script []) { delegate_ctlc = False } - waitForProcess p >>= print - - putStrLn "===================== test 2" - - -- shell kills itself with SIGINT, - -- delegation on, so expect to throw UserInterrupt - do let script = "./process011_c" - (_,_,_,p) <- createProcess (proc script []) { delegate_ctlc = True } - (waitForProcess p >>= print) - `catchUserInterrupt` \e -> putStrLn $ "caught: " ++ show e - - putStrLn "===================== test 3" - - -- shell sends itself SIGINT but traps it, - -- delegation on, but the shell terminates normally so just normal exit code - do let script = intercalate "; " - [ "trap 'echo shell trapped SIGINT' INT" - , "kill -INT $$" - , "exit 42" ] - (_,_,_,p) <- createProcess (shell script) { delegate_ctlc = True } - waitForProcess p >>= print - - putStrLn "===================== test 4" - - -- shell sends us SIGINT. - -- delegation on, so we should not get the SIGINT ourselves - -- shell terminates normally so just normal exit code - do let script = intercalate "; " - [ "kill -INT $PPID" - , "kill -INT $PPID" - , "exit 42" ] - (_,_,_,p) <- createProcess (shell script) { delegate_ctlc = True } - waitForProcess p >>= print - - putStrLn "===================== test 5" - - -- shell sends us SIGINT. - -- delegation off, so we should get the SIGINT ourselves (async) - do let script = intercalate "; " - [ "kill -INT $PPID" - , "exit 42" ] - (_,_,_,p) <- createProcess (shell script) { delegate_ctlc = False } - exit <- waitForProcess p - -- need to allow for the async exception to arrive - threadDelay 1000000 - -- we should never make it to here... - putStrLn "never caught interrupt" - print exit - `catchUserInterrupt` \e -> putStrLn $ "caught: " ++ show e - - putStrLn "===================== done" - -catchUserInterrupt :: IO a -> (AsyncException -> IO a) -> IO a -catchUserInterrupt = - catchJust (\e -> case e of UserInterrupt -> Just e; _ -> Nothing) diff --git a/tests/process011.stdout b/tests/process011.stdout deleted file mode 100644 index 2c9a46fe..00000000 --- a/tests/process011.stdout +++ /dev/null @@ -1,12 +0,0 @@ -===================== test 1 -ExitFailure (-2) -===================== test 2 -caught: user interrupt -===================== test 3 -shell trapped SIGINT -ExitFailure 42 -===================== test 4 -ExitFailure 42 -===================== test 5 -caught: user interrupt -===================== done diff --git a/tests/process011_c.c b/tests/process011_c.c deleted file mode 100644 index 6e271c9c..00000000 --- a/tests/process011_c.c +++ /dev/null @@ -1,9 +0,0 @@ -#include -#include - -int main() { - kill(getpid(), SIGINT); - sleep(1); - return 0; -} - diff --git a/tests/processT251.hs b/tests/processT251.hs deleted file mode 100644 index 863b46e4..00000000 --- a/tests/processT251.hs +++ /dev/null @@ -1,39 +0,0 @@ -import Control.Exception -import GHC.IO.Exception -import System.Environment -import System.Exit -import System.Process - -main :: IO () -main = do - args <- getArgs - case args of - [] -> parent - ["child"] -> child - ["child2"] -> child2 - _ -> fail "unknown mode" - -parent :: IO () -parent = do - putStrLn "parent start" - (_, _, _, phdl) <- createProcess $ (proc "./processT251" ["child"]) { std_in = NoStream } - ExitSuccess <- waitForProcess phdl - putStrLn "parent done" - -child :: IO () -child = do - putStrLn "child start" - (_, _, _, phdl) <- createProcess $ (proc "./processT251" ["child2"]) { std_in = NoStream } - ExitSuccess <- waitForProcess phdl - putStrLn "child done" - -child2 :: IO () -child2 = do - putStrLn "child2 start" - -- Unfortunate, there isn't a reliable way to test that stdin has been closed. - -- Afterall, if any file is opened in the child, it may reuse the - -- supposedly-closed fd 0. In particular this tends to happen in the - -- threaded RTS, since the event manager's control pipe is opened during - -- RTS initialzation. - putStrLn "child2 done" - diff --git a/tests/processT251.stdout b/tests/processT251.stdout deleted file mode 100644 index 0f78e8ab..00000000 --- a/tests/processT251.stdout +++ /dev/null @@ -1,6 +0,0 @@ -child2 start -child2 done -child start -child done -parent start -parent done