basis/io/launcher/unix/unix-tests.factor

   1 USING: accessors arrays bootstrap.image calendar
   2 concurrency.promises continuations debugger.unix destructors io
   3 io.backend.unix io.directories io.encodings.ascii
   4 io.encodings.binary io.encodings.utf8 io.files io.files.temp
   5 io.launcher io.launcher.unix io.pathnames io.streams.duplex
   6 io.timeouts kernel libc locals math namespaces sequences
   7 threads tools.test unix unix.process ;
   8 IN: io.launcher.unix.tests
   9
  10 : arch-temp-file ( str -- str' )
  11     "-" my-arch 3append temp-file ;
  12
  13 [ ] [
  14     [ "launcher-test-1" arch-temp-file delete-file ] ignore-errors
  15 ] unit-test
  16
  17 [ ] [
  18     "touch"
  19     "launcher-test-1" arch-temp-file
  20     2array
  21     try-process
  22 ] unit-test
  23
  24 [ t ] [ "launcher-test-1" arch-temp-file exists? ] unit-test
  25
  26 [ ] [
  27     [ "launcher-test-1" arch-temp-file delete-file ] ignore-errors
  28 ] unit-test
  29
  30 [ ] [
  31     <process>
  32         "echo Hello" >>command
  33         "launcher-test-1" arch-temp-file >>stdout
  34     try-process
  35 ] unit-test
  36
  37 [ "Hello\n" ] [
  38     "cat"
  39     "launcher-test-1" arch-temp-file
  40     2array
  41     ascii <process-reader> stream-contents
  42 ] unit-test
  43
  44 [ ] [
  45     [ "launcher-test-1" arch-temp-file delete-file ] ignore-errors
  46 ] unit-test
  47
  48 [ ] [
  49     <process>
  50         "cat" >>command
  51         +closed+ >>stdin
  52         "launcher-test-1" arch-temp-file >>stdout
  53     try-process
  54 ] unit-test
  55
  56 [ "" ] [
  57     "cat"
  58     "launcher-test-1" arch-temp-file
  59     2array
  60     ascii <process-reader> stream-contents
  61 ] unit-test
  62
  63 [ ] [
  64     2 [
  65         "launcher-test-1" arch-temp-file binary <file-appender> [
  66             <process>
  67                 swap >>stdout
  68                 "echo Hello" >>command
  69             try-process
  70         ] with-disposal
  71     ] times
  72 ] unit-test
  73
  74 [ "Hello\nHello\n" ] [
  75     "cat"
  76     "launcher-test-1" arch-temp-file
  77     2array
  78     ascii <process-reader> stream-contents
  79 ] unit-test
  80
  81 [ t ] [
  82     <process>
  83         "env" >>command
  84         { { "A" "B" } } >>environment
  85     ascii <process-reader> stream-lines
  86     "A=B" swap member?
  87 ] unit-test
  88
  89 [ { "A=B" } ] [
  90     <process>
  91         "env" >>command
  92         { { "A" "B" } } >>environment
  93         +replace-environment+ >>environment-mode
  94     ascii <process-reader> stream-lines
  95 ] unit-test
  96
  97 [ "hi\n" ] [
  98     temp-directory [
  99         [ "aloha" delete-file ] ignore-errors
 100         <process>
 101             { "echo" "hi" } >>command
 102             "aloha" >>stdout
 103         try-process
 104     ] with-directory
 105     temp-directory "aloha" append-path
 106     utf8 file-contents
 107 ] unit-test
 108
 109 [ "append-test" arch-temp-file delete-file ] ignore-errors
 110
 111 [ "hi\nhi\n" ] [
 112     2 [
 113         <process>
 114             "echo hi" >>command
 115             "append-test" arch-temp-file <appender> >>stdout
 116         try-process
 117     ] times
 118     "append-test" arch-temp-file utf8 file-contents
 119 ] unit-test
 120
 121 [ t ] [ "ls" utf8 <process-stream> stream-contents >boolean ] unit-test
 122
 123 [ "Hello world.\n" ] [
 124     "cat" utf8 <process-stream> [
 125         "Hello world.\n" write
 126         output-stream get dispose
 127         input-stream get stream-contents
 128     ] with-stream
 129 ] unit-test
 130
 131 ! Test process timeouts
 132 [
 133     <process>
 134         { "sleep" "10" } >>command
 135         1 seconds >>timeout
 136     run-process
 137 ] [ process-was-killed? ] must-fail-with
 138
 139 [
 140     <process>
 141         { "sleep" "10" } >>command
 142         1 seconds >>timeout
 143     try-process
 144 ] [ process-was-killed? ] must-fail-with
 145
 146 [
 147     <process>
 148         { "sleep" "10" } >>command
 149         1 seconds >>timeout
 150     try-output-process
 151 ] [ io-timeout? ] must-fail-with
 152
 153 ! Killed processes were exiting with code 0 on FreeBSD
 154 [ f ] [
 155     [let
 156         <promise> :> p
 157         <promise> :> s
 158
 159         [
 160             "sleep 1000" run-detached
 161             [ p fulfill ] [ wait-for-process s fulfill ] bi
 162         ] in-thread
 163
 164         p 1 seconds ?promise-timeout (kill-process)
 165         s 3 seconds ?promise-timeout 0 =
 166     ]
 167 ] unit-test
 168
 169 ! Make sure that subprocesses don't inherit our signal mask
 170
 171 ! First, ensure that the Factor VM ignores SIGPIPE
 172 : send-sigpipe ( pid -- )
 173     "SIGPIPE" signal-names index 1 +
 174     kill io-error ;
 175
 176 [ ] [ (current-process) send-sigpipe ] unit-test
 177
 178 ! Spawn a process
 179 [ T{ signal f 13 } ] [
 180     "sleep 1000" run-detached
 181     1 seconds sleep
 182     [ handle>> send-sigpipe ]
 183     [ 2 seconds swap set-timeout ]
 184     [ wait-for-process ]
 185     tri
 186 ] unit-test
 187
 188 ! Test priority
 189 [ 0 ] [
 190     <process>
 191         { "bash" "-c" "sleep 2&" } >>command
 192         +low-priority+ >>priority
 193     run-process status>>
 194 ] unit-test
 195
 196 ! Check that processes launched with the group option kill their children (or not)
 197 ! This test should leave two sleeps running for 30 seconds.
 198 [
 199     <process> { "bash" "-c" "sleep 30& sleep 30" } >>command
 200         +same-group+ >>group
 201         500 milliseconds >>timeout
 202     run-process
 203 ] [ process-was-killed? ] must-fail-with
 204
 205 ! This test should kill the sleep after 500ms.
 206 [
 207     <process> { "bash" "-c" "sleep 30& sleep 30" } >>command
 208         +new-group+ >>group
 209         500 milliseconds >>timeout
 210     run-process
 211 ] [ process-was-killed? ] must-fail-with
 212
 213 ! This test should kill the sleep after 500ms.
 214 [
 215     <process> { "bash" "-c" "sleep 30& sleep 30" } >>command
 216         +new-session+ >>group
 217         500 milliseconds >>timeout
 218     run-process
 219 ] [ process-was-killed? ] must-fail-with