basis/io/pipes/pipes-tests.factor

   1 USING: io io.pipes io.streams.string io.encodings.utf8
   2 io.encodings.binary io.streams.duplex io.encodings io.timeouts
   3 namespaces continuations tools.test kernel calendar destructors
   4 accessors debugger math sequences threads
   5 concurrency.count-downs fry ;
   6 IN: io.pipes.tests
   7
   8 [ "Hello" ] [
   9     utf8 <pipe> [
  10         "Hello" print flush
  11         readln
  12     ] with-stream
  13 ] unit-test
  14
  15 ! Test run-pipeline
  16 [ { } ] [ { } run-pipeline ] unit-test
  17 [ { f } ] [ { [ f ] } run-pipeline ] unit-test
  18 [ { "Hello" } ] [
  19     "Hello" [
  20         { [ input-stream [ utf8 <decoder> ] change readln ] } run-pipeline
  21     ] with-string-reader
  22 ] unit-test
  23
  24 [ { f "Hello" } ] [
  25     {
  26         [ output-stream [ utf8 <encoder> ] change "Hello" print flush f ]
  27         [ input-stream [ utf8 <decoder> ] change readln ]
  28     } run-pipeline
  29 ] unit-test
  30
  31 ! Test timeout
  32 [
  33     utf8 <pipe> [
  34         1 seconds over set-timeout
  35         stream-readln
  36     ] with-disposal
  37 ] must-fail
  38
  39 ! Test writing to a half-open pipe
  40 [ ] [
  41     1000 [
  42         utf8 <pipe> [
  43             [ in>> dispose ]
  44             [ out>> "hi" over stream-write dispose ]
  45             bi
  46         ] curry ignore-errors
  47     ] times
  48 ] unit-test
  49
  50 ! Test non-blocking operation
  51 [ ] [
  52     [
  53         2 <count-down> "count-down" set
  54
  55         utf8 <pipe> &dispose
  56         utf8 <pipe> &dispose
  57         [
  58             [
  59                 '[
  60                     _ stream-read1 drop
  61                     "count-down" get count-down
  62                 ] in-thread
  63             ] bi@
  64
  65             ! Give the threads enough time to start blocking on
  66             ! read
  67             1 seconds sleep
  68         ]
  69         ! At this point, two threads are blocking on read
  70         [ [ "Hi" over stream-write stream-flush ] bi@ ]
  71         ! At this point, both threads should wake up
  72         2bi
  73
  74         "count-down" get await
  75     ] with-destructors
  76 ] unit-test
  77
  78 ! 0 read should not block
  79 [ f ] [
  80     [
  81         binary <pipe> &dispose
  82         in>>
  83         [ 0 read ] with-input-stream
  84     ] with-destructors
  85 ] unit-test