ghc/tests/io/should_run/po012.hs

   1 import Posix
   2 import IO -- 1.3
   3
   4 main =
   5     createFile "po012.out" stdFileMode >>= \ fd ->
   6     installHandler processStatusChanged (Catch (reap1 fd)) Nothing >>
   7     ls >>
   8     awaitSignal Nothing
   9
  10 ls =
  11     runProcess "ls" ["-l"] Nothing Nothing Nothing Nothing Nothing
  12
  13 reap1 fd =
  14     hPutStrLn stderr "Reaper1"         >>
  15     getAnyProcessStatus True False     >>
  16     installHandler processStatusChanged (Catch (reap2 fd)) Nothing >>
  17     fdWrite fd (take 666 (repeat 'x')) >>
  18     ls                                 >>
  19     awaitSignal Nothing
  20
  21 reap2 fd =
  22     hPutStrLn stderr "Reaper2"     >>
  23     getAnyProcessStatus True False >>
  24     installHandler processStatusChanged (Catch (reap3 fd)) Nothing >>
  25     setFileMode "po012.out"
  26         (foldr1 unionFileModes [ownerReadMode,ownerWriteMode,groupReadMode,otherReadMode]) >>
  27     ls >>
  28     awaitSignal Nothing
  29
  30 reap3 fd =
  31     hPutStrLn stderr "Reaper3"     >>
  32     getAnyProcessStatus True False >>
  33     installHandler processStatusChanged (Catch (reap4 fd)) Nothing >>
  34     setFileTimes "po012.out" 0 0 >>
  35     ls >>
  36     awaitSignal Nothing
  37
  38 reap4 fd =
  39     hPutStrLn stderr "Reaper4"     >>
  40     getAnyProcessStatus True False >>
  41     installHandler processStatusChanged (Catch (reap5 fd)) Nothing >>
  42     --removeLink "po012.out" >>
  43     ls >>
  44     awaitSignal Nothing
  45
  46 reap5 fd =
  47     hPutStrLn stderr "Reaper5"     >>
  48     getAnyProcessStatus True False >>
  49     fdSeek fd SeekFromEnd 0        >>= \ bytes ->
  50     if bytes == 666 then
  51         fdSeek fd AbsoluteSeek 0   >>
  52         hPutStrLn stderr "Reaper5"     >>
  53         fdRead fd 666             >>= \ (str, _) ->
  54         if str == (take 666 (repeat 'x')) then
  55             putStr "Okay\n"
  56         else
  57             putStr "Read failed\n"
  58     else
  59         putStr "Seek returned wrong size\n"