Remove posix deps on two tests, pointed out by <shelarcy@capella.freemail.ne.jp>
This commit is contained in:
parent
a1529d9003
commit
389c1ce711
@ -5,10 +5,7 @@
|
|||||||
--
|
--
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Posix.Types ( ProcessID, Fd )
|
import System.Process
|
||||||
import System.Posix.Process ( forkProcess, executeFile, getProcessID )
|
|
||||||
import System.Posix.IO ( createPipe, stdInput,
|
|
||||||
stdOutput, fdToHandle, closeFd, dupTo )
|
|
||||||
|
|
||||||
resource = testio { field = date }
|
resource = testio { field = date }
|
||||||
|
|
||||||
@ -16,61 +13,5 @@ resource = testio { field = date }
|
|||||||
-- call a shell command , returning it's output
|
-- call a shell command , returning it's output
|
||||||
--
|
--
|
||||||
date :: IO String
|
date :: IO String
|
||||||
date = do (hdl,_,_) <- catch (popen "/bin/date") (\_->error "popen failed")
|
date = do (_,out,_,_) <- catch (runInteractiveCommand "/bin/date") (\_->error "popen failed")
|
||||||
hGetLine hdl
|
hGetLine out
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
|
||||||
--
|
|
||||||
-- my implementation of $val = `cmd`; (if this was perl)
|
|
||||||
--
|
|
||||||
-- provide similar functionality to popen(3),
|
|
||||||
-- along with bidirectional ipc via pipes
|
|
||||||
-- return's the pid of the child process
|
|
||||||
--
|
|
||||||
-- there are two different forkProcess functions. the pre-620 was a
|
|
||||||
-- unix-fork style function, and the modern function has semantics more
|
|
||||||
-- like the Awkward-Squad paper. We provide implementations of popen
|
|
||||||
-- using both versions, depending on which GHC the user wants to try.
|
|
||||||
--
|
|
||||||
|
|
||||||
popen :: FilePath -> IO (Handle, Handle, ProcessID)
|
|
||||||
popen cmd = do
|
|
||||||
(pr, pw) <- createPipe
|
|
||||||
(cr, cw) <- createPipe
|
|
||||||
|
|
||||||
-- parent --
|
|
||||||
let parent = do closeFd cw
|
|
||||||
closeFd pr
|
|
||||||
-- child --
|
|
||||||
let child = do closeFd pw
|
|
||||||
closeFd cr
|
|
||||||
exec cmd (pr,cw)
|
|
||||||
error "exec cmd failed!" -- typing only
|
|
||||||
|
|
||||||
-- if the parser front end understood cpp, this would work
|
|
||||||
-- #if __GLASGOW_HASKELL__ >= 601
|
|
||||||
pid <- forkProcess child -- fork child
|
|
||||||
parent -- and run parent code
|
|
||||||
-- #else
|
|
||||||
-- p <- forkProcess
|
|
||||||
-- pid <- case p of
|
|
||||||
-- Just pid -> parent >> return pid
|
|
||||||
-- Nothing -> child
|
|
||||||
-- #endif
|
|
||||||
|
|
||||||
hcr <- fdToHandle cr
|
|
||||||
hpw <- fdToHandle pw
|
|
||||||
|
|
||||||
return (hcr,hpw,pid)
|
|
||||||
|
|
||||||
--
|
|
||||||
-- execve cmd in the child process, dup'ing the file descriptors passed
|
|
||||||
-- as arguments to become the child's stdin and stdout.
|
|
||||||
--
|
|
||||||
exec :: FilePath -> (Fd,Fd) -> IO ()
|
|
||||||
exec cmd (pr,cw) = do
|
|
||||||
dupTo pr stdInput
|
|
||||||
dupTo cw stdOutput
|
|
||||||
executeFile cmd False [] Nothing
|
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# GLOBALOPTIONS -package posix #-}
|
{-# GLOBALOPTIONS -package mtl #-}
|
||||||
-- illustrates the use of static options in pragmas
|
-- illustrates the use of static options in pragmas
|
||||||
|
|
||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
|
Loading…
x
Reference in New Issue
Block a user