--- /dev/null
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/should_run.mk
+
+HC_OPTS += -dcore-lint -syslib posix -syslib misc -fglasgow-exts
+
+# Posix007 is interactive, you'll have to issue a ^C on your tty.
+posix007_RUNTEST_OPTS += -i/dev/tty
+
+.PRECIOUS: %.o %.bin
+
+include $(TOP)/mk/target.mk
--- /dev/null
+module Main(main) where
+
+import Posix
+
+main :: IO ()
+main = do
+ ppid <- getParentProcessID
+ pid <- getProcessID
+ putStr "Parent Process ID: "
+ print ppid
+ putStr "Process ID: "
+ print pid
+ putStr "forking ps ux"
+ print ppid
+ child <- forkProcess
+ case child of
+ Nothing -> executeFile "ps" True ["ux" ++ show ppid] Nothing
+ Just x -> doParent x pid
+
+doParent cpid pid = do
+ getProcessStatus True False cpid
+ putStr "\nChild finished. Now exec'ing ps ux\n"
+ print pid
+ executeFile "ps" True ["ux" ++ show pid] Nothing
--- /dev/null
+USER PID %CPU %MEM SIZE RSS TTY STAT START TIME COMMAND
+sof 30160 0.0 0.2 1244 648 p0 S 15:09 0:00 /bin/sh -c ./posix001
+USER PID %CPU %MEM SIZE RSS TTY STAT START TIME COMMAND
+sof 30161 0.0 0.1 892 336 p0 R 15:09 0:00 ps ux30161
--- /dev/null
+import Posix
+
+main =
+ executeFile "printenv" True [] (Just [("ONE","1"),("TWO","2")])
--- /dev/null
+ONE=1
+TWO=2
--- /dev/null
+import IO
+import Posix
+
+main =
+ openFile "po003.out" WriteMode >>= \ h ->
+ runProcess "pwd" [] Nothing (Just "/usr/tmp") Nothing (Just h) Nothing
--- /dev/null
+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)")
+
--- /dev/null
+I'm happy.
--- /dev/null
+import Posix
+import IO
+main =
+ hSetBuffering stdout NoBuffering >>
+ getEnvVar "TERM" >>= \ term ->
+ putStrLn term >>
+ setEnvironment [("one","1"),("two","2")] >>
+ getEnvironment >>= \ env ->
+ print env >>
+ setEnvVar "foo" "bar" >>
+ getEnvironment >>= \ env ->
+ print env >>
+ setEnvVar "foo" "baz" >>
+ getEnvironment >>= \ env ->
+ print env >>
+ setEnvVar "fu" "bar" >>
+ getEnvironment >>= \ env ->
+ print env >>
+ removeEnvVar "foo" >>
+ getEnvironment >>= \ env ->
+ print env >>
+ setEnvironment [] >>
+ getEnvironment >>= \ env ->
+ print env
+
--- /dev/null
+emacs
+[("one","1"),("two","2")]
+[("one","1"),("two","2"),("foo","bar")]
+[("one","1"),("two","2"),("foo","baz")]
+[("one","1"),("two","2"),("foo","baz"),("fu","bar")]
+[("one","1"),("two","2"),("fu","bar")]
+[]
--- /dev/null
+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'
--- /dev/null
+Started: 902585354
+
+Slept: 5
+
+Finished: 902585359
+
--- /dev/null
+import Posix
+
+-- This test is an example of where something more sophisticated than runstdtest
+-- is required, as its interactive.
+
+main = do
+ installHandler keyboardSignal (Catch doCtrlC) Nothing
+ ta <- getTerminalAttributes stdInput
+ case (controlChar ta Interrupt) of
+ Nothing -> fixMe ta
+ Just x -> continue x
+
+fixMe ta = do
+ putStr "Oops...no interrupt character?\nI can fix that...\n"
+ setTerminalAttributes stdInput (withCC ta (Interrupt, '\ETX')) Immediately
+ ta <- getTerminalAttributes stdInput
+ 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 '@'))]
--- /dev/null
+Press '^C'.
+Caught an interrupt.
--- /dev/null
+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"
--- /dev/null
+Scheduling an alarm in 5 seconds...
+Sleeping one minute.
+The alarm went off.
--- /dev/null
+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 >>
+ putStrLn "Woken up" >>
+ getPendingSignals >>= \ ints ->
+ putStr "Checking pending interrupts for RealTimeAlarm\n" >>
+ print (inSignalSet realTimeAlarm ints) >>
+ putChar '\n'
+
--- /dev/null
+import Posix
+
+main =
+ getUserEntryForName "sof" >>= \ sof ->
+ getUserEntryForName "partain" >>= \ partain ->
+ putStr (ue2String sof) >>
+ putChar '\n' >>
+ putStr (ue2String partain) >>
+ putChar '\n' >>
+ getUserEntryForID (userID sof) >>= \ muid ->
+ getUserEntryForID (userID partain) >>= \ puid ->
+ putStr (ue2String muid) >>
+ putChar '\n' >>
+ putStr (ue2String puid) >>
+ putChar '\n'
+
+ue2String ue =
+ name ++ (':' : (show uid) ++ (':' : (show gid) ++ (':' : home ++ (':' : shell))))
+ where
+ name = userName ue
+ uid = userID ue
+ gid = userGroupID ue
+ home = homeDirectory ue
+ shell = userShell ue
--- /dev/null
+mattson:104:401:/users/fp/mattson:/bin/csh
+partain:184:401:/users/fp/partain:/usr/local/bin/tcsh
+mattson:104:401:/users/fp/mattson:/bin/csh
+partain:184:401:/users/fp/partain:/usr/local/bin/tcsh
--- /dev/null
+import Posix
+
+main =
+ getGroupEntryForName "grasp" >>= \ grasp ->
+ getGroupEntryForName "staff" >>= \ staff ->
+ putStr (ge2String grasp) >>
+ putChar '\n' >>
+ putStr (ge2String staff) >>
+ putChar '\n' >>
+ getGroupEntryForID (groupID grasp) >>= \ guid ->
+ getGroupEntryForID (groupID staff) >>= \ suid ->
+ putStr (ge2String guid) >>
+ putChar '\n' >>
+ putStr (ge2String suid) >>
+ putChar '\n'
+
+ge2String ge =
+ name ++ (':' : (show gid) ++ (':' : members))
+ where
+ name = groupName ge
+ gid = groupID ge
+ members = foldr (\x y -> x ++ (',' : y)) "" (groupMembers ge)
--- /dev/null
+grasp:401:andre,andy,ap,areid,cvh,dm,dnt,gnik,grasp,hwloidl,jan,johan,jonathan,jtod,kh,laszlo,mattson,partain,sansom,satnam,sewardj,sharpkm,simonm,simonpj,sof,trinder,wadler,
+staff:9:aileen,alexa,ali,alison,andy,anne,ansftp,aran,arthur,audit,bill,botech,bw,carol,carron,cathy,conftp,cs2head,cvh,dam,darryn,daw,dcg,debbie,del,deptlib,dkm,dlg,dm,dnt,ellen,f131mgr,fabio,fairouz,faxback,fido,finance,fiona,footsie,george,gilbert,gilles,gsm,handbook,harrismi,helen,hme,hmg,huw,iain,id,igr,iii,imis-doc,imm,inei,infoman,ingres,inventdb,irfest,isabel,jacksonn,jacqui,james,janice,jej,jim,jl,jmm,johnson,jon,jstack,jtod,jwp,keith,kempj,kh,kieran,kimb,kirsten,kmssys,laurent,lewis,lisa,lizbeth,logiej,love,lyons,maclib,macneisd,margaret,mark,mary,mattson,meurig,mjj,mmi,monica,mossin,mpa,muffy,nk,norman,partain,pd,pdg,pete,pp,ps,quintin,rab,ray,rdm,reh,replib,rff,rffingres,rich,rios,rjw,rn,ron,ruffin,rwi,sanderso,sandy,sansom,satnam,sheila,sid,simonm,simonpj,slurry,softlib,stephen,steve,stevem,stuart,support,susan,tania,tech,teresa,tfm,tommyk,tracy,trinder,types,typesftp,wadler,wf,xadmin,
+grasp:401:andre,andy,ap,areid,cvh,dm,dnt,gnik,grasp,hwloidl,jan,johan,jonathan,jtod,kh,laszlo,mattson,partain,sansom,satnam,sewardj,sharpkm,simonm,simonpj,sof,trinder,wadler,
+staff:9:aileen,alexa,ali,alison,andy,anne,ansftp,aran,arthur,audit,bill,botech,bw,carol,carron,cathy,conftp,cs2head,cvh,dam,darryn,daw,dcg,debbie,del,deptlib,dkm,dlg,dm,dnt,ellen,f131mgr,fabio,fairouz,faxback,fido,finance,fiona,footsie,george,gilbert,gilles,gsm,handbook,harrismi,helen,hme,hmg,huw,iain,id,igr,iii,imis-doc,imm,inei,infoman,ingres,inventdb,irfest,isabel,jacksonn,jacqui,james,janice,jej,jim,jl,jmm,johnson,jon,jstack,jtod,jwp,keith,kempj,kh,kieran,kimb,kirsten,kmssys,laurent,lewis,lisa,lizbeth,logiej,love,lyons,maclib,macneisd,margaret,mark,mary,mattson,meurig,mjj,mmi,monica,mossin,mpa,muffy,nk,norman,partain,pd,pdg,pete,pp,ps,quintin,rab,ray,rdm,reh,replib,rff,rffingres,rich,rios,rjw,rn,ron,ruffin,rwi,sanderso,sandy,sansom,satnam,sheila,sid,simonm,simonpj,slurry,softlib,stephen,steve,stevem,stuart,support,susan,tania,tech,teresa,tfm,tommyk,tracy,trinder,types,typesftp,wadler,wf,xadmin,
--- /dev/null
+import Posix
+import IO -- 1.3
+
+main =
+ createFile "po012.out" stdFileMode >>= \ fd ->
+ installHandler processStatusChanged (Catch (reap1 fd)) Nothing >>
+ ls >>
+ awaitSignal Nothing
+
+ls =
+ runProcess "ls" ["-l"] Nothing Nothing Nothing Nothing Nothing
+
+reap1 fd =
+ hPutStrLn stderr "Reaper1" >>
+ getAnyProcessStatus True False >>
+ installHandler processStatusChanged (Catch (reap2 fd)) Nothing >>
+ fdWrite fd (take 666 (repeat 'x')) >>
+ ls >>
+ awaitSignal Nothing
+
+reap2 fd =
+ hPutStrLn stderr "Reaper2" >>
+ getAnyProcessStatus True False >>
+ installHandler processStatusChanged (Catch (reap3 fd)) Nothing >>
+ setFileMode "po012.out"
+ (foldr1 unionFileModes [ownerReadMode,ownerWriteMode,groupReadMode,otherReadMode]) >>
+ ls >>
+ awaitSignal Nothing
+
+reap3 fd =
+ hPutStrLn stderr "Reaper3" >>
+ getAnyProcessStatus True False >>
+ installHandler processStatusChanged (Catch (reap4 fd)) Nothing >>
+ setFileTimes "po012.out" 0 0 >>
+ ls >>
+ awaitSignal Nothing
+
+reap4 fd =
+ hPutStrLn stderr "Reaper4" >>
+ getAnyProcessStatus True False >>
+ installHandler processStatusChanged (Catch (reap5 fd)) Nothing >>
+ --removeLink "po012.out" >>
+ ls >>
+ awaitSignal Nothing
+
+reap5 fd =
+ hPutStrLn stderr "Reaper5" >>
+ getAnyProcessStatus True False >>
+ fdSeek fd SeekFromEnd 0 >>= \ bytes ->
+ if bytes == 666 then
+ fdSeek fd AbsoluteSeek 0 >>
+ hPutStrLn stderr "Reaper5" >>
+ fdRead fd 666 >>= \ (str, _) ->
+ if str == (take 666 (repeat 'x')) then
+ putStr "Okay\n"
+ else
+ putStr "Read failed\n"
+ else
+ putStr "Seek returned wrong size\n"
--- /dev/null
+--!! Querying for system information.
+module Main(main) where
+
+import Posix
+
+main = do
+ sid <- getSystemID
+ let
+ info =
+ [ "Node Name: " , nodeName sid
+ , "OS: " , systemName sid
+ , "Arch: " , machine sid
+ , "Version: " , version sid
+ , "Release: " , release sid
+ ]
+ putStrLn2 info
+
+putStrLn2 :: [String] -> IO ()
+putStrLn2 [] = return ()
+putStrLn2 [x] = putStrLn x
+putStrLn2 (x1:x2:xs) = putStrLn (x1++x2) >> putStrLn2 xs
--- /dev/null
+--!! Basic pipe usage
+module Main(main) where
+
+import Posix
+
+main = do
+ str <- getEffectiveUserName
+ putStrLn str
+ (rd, wd) <- createPipe
+ n <- forkProcess
+ case n of
+ Nothing -> do
+ (str,_) <- fdRead rd 32
+ -- avoid them zombies
+ putStrLn str
+ Just pid -> do
+ fdWrite wd "Hi, there - forked child calling"
+-- getProcessStatus False True pid
+ return ()
projects / ghc-hetmet.git / commitdiff