From: sof Date: Sat, 8 Aug 1998 19:14:27 +0000 (+0000) Subject: [project @ 1998-08-08 19:14:10 by sof] X-Git-Tag: Approx_2487_patches~469 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=01cc3f2fa8626441bef802f9c12ec883fed31672;p=ghc-hetmet.git [project @ 1998-08-08 19:14:10 by sof] Moved into sep directory --- diff --git a/ghc/tests/io/should_run/po001.hs b/ghc/tests/io/should_run/po001.hs deleted file mode 100644 index 31c32ba..0000000 --- a/ghc/tests/io/should_run/po001.hs +++ /dev/null @@ -1,23 +0,0 @@ -import Posix - -main = - getParentProcessID >>= \ ppid -> - getProcessID >>= \ pid -> - putStr "Parent Process ID: " >> - print ppid >> - putStr "\nProcess ID: " >> - print pid >> - putStr "\nforking ps uxww" >> - print ppid >> - putChar '\n' >> - forkProcess >>= \ child -> - case child of - Nothing -> executeFile "ps" True ["uxww" ++ show ppid] Nothing - Just x -> doParent x pid - -doParent cpid pid = - getProcessStatus True False cpid >> - putStr "\nChild finished. Now exec'ing ps uxww" >> - print pid >> - putChar '\n' >> - executeFile "ps" True ["uxww" ++ show pid] Nothing diff --git a/ghc/tests/io/should_run/po001.stdout b/ghc/tests/io/should_run/po001.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po002.hs b/ghc/tests/io/should_run/po002.hs deleted file mode 100644 index 8d01e8b..0000000 --- a/ghc/tests/io/should_run/po002.hs +++ /dev/null @@ -1,4 +0,0 @@ -import Posix - -main = - executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")]) diff --git a/ghc/tests/io/should_run/po002.stdout b/ghc/tests/io/should_run/po002.stdout deleted file mode 100644 index 5e17a60..0000000 --- a/ghc/tests/io/should_run/po002.stdout +++ /dev/null @@ -1,2 +0,0 @@ -ONE=1 -TWO=2 diff --git a/ghc/tests/io/should_run/po003.hs b/ghc/tests/io/should_run/po003.hs deleted file mode 100644 index dbea5e1..0000000 --- a/ghc/tests/io/should_run/po003.hs +++ /dev/null @@ -1,6 +0,0 @@ -import IO -import Posix - -main = - openFile "po003.out" WriteMode >>= \ h -> - runProcess "pwd" [] Nothing (Just "/usr/tmp") Nothing (Just h) Nothing diff --git a/ghc/tests/io/should_run/po003.stdout b/ghc/tests/io/should_run/po003.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po004.hs b/ghc/tests/io/should_run/po004.hs deleted file mode 100644 index 2423f3f..0000000 --- a/ghc/tests/io/should_run/po004.hs +++ /dev/null @@ -1,58 +0,0 @@ -import Posix -import System(ExitCode(..), exitWith) - -main = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> raiseSignal floatingPointException - _ -> doParent - -doParent = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Terminated sig | sig == floatingPointException -> forkChild2 - _ -> fail (userError "unexpected termination cause") - -forkChild2 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> exitImmediately (ExitFailure 42) - _ -> doParent2 - -doParent2 = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Exited (ExitFailure 42) -> forkChild3 - _ -> fail (userError "unexpected termination cause (2)") - -forkChild3 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> exitImmediately (ExitSuccess) - _ -> doParent3 - -doParent3 = - getAnyProcessStatus True False >>= \ (Just (pid, tc)) -> - case tc of - Exited ExitSuccess -> forkChild4 - _ -> fail (userError "unexpected termination cause (3)") - -forkChild4 = - forkProcess >>= \ maybe_pid -> - case maybe_pid of - Nothing -> raiseSignal softwareStop - _ -> doParent4 - -doParent4 = - getAnyProcessStatus True True >>= \ (Just (pid, tc)) -> - case tc of - Stopped sig | sig == softwareStop -> enoughAlready pid - _ -> fail (userError "unexpected termination cause (4)") - -enoughAlready pid = - signalProcess killProcess pid >> - getAnyProcessStatus True True >>= \ (Just (pid, tc)) -> - case tc of - Terminated sig | sig == killProcess -> putStr "I'm happy.\n" - _ -> fail (userError "unexpected termination cause (5)") - diff --git a/ghc/tests/io/should_run/po004.stdout b/ghc/tests/io/should_run/po004.stdout deleted file mode 100644 index 8ed7ee5..0000000 --- a/ghc/tests/io/should_run/po004.stdout +++ /dev/null @@ -1 +0,0 @@ -I'm happy. diff --git a/ghc/tests/io/should_run/po005.hs b/ghc/tests/io/should_run/po005.hs deleted file mode 100644 index 81dce3a..0000000 --- a/ghc/tests/io/should_run/po005.hs +++ /dev/null @@ -1,30 +0,0 @@ -import Posix - -main = - getEnvVar "TERM" >>= \ term -> - putStr term >> - putChar '\n' >> - setEnvironment [("one","1"),("two","2")] >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "foo" "bar" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "foo" "baz" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvVar "fu" "bar" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - removeEnvVar "foo" >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' >> - setEnvironment [] >> - getEnvironment >>= \ env -> - print env >> - putChar '\n' diff --git a/ghc/tests/io/should_run/po005.stdout b/ghc/tests/io/should_run/po005.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po006.hs b/ghc/tests/io/should_run/po006.hs deleted file mode 100644 index eb6451d..0000000 --- a/ghc/tests/io/should_run/po006.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Posix - -main = - epochTime >>= \ start -> - sleep 5 >> - let timeleft = 0 in - epochTime >>= \ finish -> - putStr "Started: " >> - print start >> - putStr "\nSlept: " >> - print (5 - timeleft) >> - putStr "\nFinished: " >> - print finish >> - putChar '\n' diff --git a/ghc/tests/io/should_run/po006.stdout b/ghc/tests/io/should_run/po006.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po007.hs b/ghc/tests/io/should_run/po007.hs deleted file mode 100644 index 3a37dc7..0000000 --- a/ghc/tests/io/should_run/po007.hs +++ /dev/null @@ -1,31 +0,0 @@ -import Posix - -main = - installHandler keyboardSignal (Catch doCtrlC) Nothing >> - getTerminalAttributes stdInput >>= \ ta -> - case (controlChar ta Interrupt) of - Nothing -> fixMe ta - Just x -> continue x - -fixMe ta = - putStr "Oops...no interrupt character?\nI can fix that...\n" >> - setTerminalAttributes stdInput (withCC ta (Interrupt, '\ETX')) Immediately >> - getTerminalAttributes stdInput >>= \ ta -> - case (controlChar ta Interrupt) of - Nothing -> putStr "...Then again, maybe I can't\n" - Just x -> continue x - -continue x = - putStr "Press '" >> - putStr (ccStr x) >> - putStr "'.\n" >> - awaitSignal Nothing >> - putStr "How did I get here?\n" - -doCtrlC = - putStr "Caught an interrupt.\n" - -ccStr '\DEL' = "^?" -ccStr x - | x >= ' ' = [x] - | otherwise = ['^', (toEnum (fromEnum x + fromEnum '@'))] diff --git a/ghc/tests/io/should_run/po007.stdout b/ghc/tests/io/should_run/po007.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po008.hs b/ghc/tests/io/should_run/po008.hs deleted file mode 100644 index 249e58e..0000000 --- a/ghc/tests/io/should_run/po008.hs +++ /dev/null @@ -1,12 +0,0 @@ -import Posix - -main = - installHandler realTimeAlarm (Catch alarmclock) Nothing >> - putStr "Scheduling an alarm in 5 seconds...\n" >> - scheduleAlarm 5 >> - putStr "Sleeping one minute.\n" >> - sleep 60 >> - putStr "How did I get here?\n" - -alarmclock = - putStr "The alarm went off.\n" diff --git a/ghc/tests/io/should_run/po008.stdout b/ghc/tests/io/should_run/po008.stdout deleted file mode 100644 index e69de29..0000000 diff --git a/ghc/tests/io/should_run/po009.hs b/ghc/tests/io/should_run/po009.hs deleted file mode 100644 index a1f284f..0000000 --- a/ghc/tests/io/should_run/po009.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Posix - -main = - putStr "Blocking real time alarms.\n" >> - blockSignals (addSignal realTimeAlarm emptySignalSet) >> - putStr "Scheduling an alarm in 2 seconds...\n" >> - scheduleAlarm 2 >> - putStr "Sleeping 5 seconds.\n" >> - sleep 5 >> - getPendingSignals >>= \ ints -> - putStr "Checking pending interrupts for RealTimeAlarm\n" >> - print (inSignalSet realTimeAlarm ints) >> - putChar '\n' - diff --git a/ghc/tests/io/should_run/po009.stdout b/ghc/tests/io/should_run/po009.stdout deleted file mode 100644 index e69de29..0000000