basis/ui/tools/listener/listener-tests.factor

   1 USING: continuations documents
   2 ui.tools.listener hashtables kernel namespaces parser sequences
   3 tools.test ui.commands ui.gadgets ui.gadgets.editors
   4 ui.gadgets.panes vocabs words tools.test.ui slots.private
   5 threads arrays generic threads accessors listener math
   6 calendar concurrency.promises io ui.tools.common ;
   7 IN: ui.tools.listener.tests
   8
   9 \ <interactor> must-infer
  10
  11 [
  12     [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
  13
  14     [ ] [ "interactor" get register-self ] unit-test
  15
  16     [ ] [ "[ 1 2 3" "interactor" get set-editor-string ] unit-test
  17
  18     [ ] [ <promise> "promise" set ] unit-test
  19
  20     [
  21         self "interactor" get (>>thread)
  22         "interactor" get stream-read-quot "promise" get fulfill
  23     ] "Interactor test" spawn drop
  24
  25     ! This should not throw an exception
  26     [ ] [ "interactor" get evaluate-input ] unit-test
  27
  28     [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
  29
  30     [ ] [ "[ 1 2 3 ]" "interactor" get set-editor-string ] unit-test
  31
  32     [ ] [ "interactor" get evaluate-input ] unit-test
  33
  34     [ [ [ 1 2 3 ] ] ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
  35 ] with-interactive-vocabs
  36
  37 [
  38     [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
  39
  40     [ ] [ "interactor" get register-self ] unit-test
  41
  42     [ ] [ <promise> "promise" set ] unit-test
  43
  44     [
  45         self "interactor" get (>>thread)
  46         "interactor" get stream-readln "promise" get fulfill
  47     ] "Interactor test" spawn drop
  48
  49     [ ] [ "hi" "interactor" get set-editor-string ] unit-test
  50
  51     [ ] [ [ "interactor" get interactor-busy? ] [ yield ] [ ] while ] unit-test
  52
  53     [ ] [ "interactor" get evaluate-input ] unit-test
  54
  55     [ "hi" ] [ "promise" get 5 seconds ?promise-timeout ] unit-test
  56 ] with-interactive-vocabs
  57
  58 ! Hang
  59 [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
  60
  61 [ ] [ [ "interactor" get stream-read-quot drop ] "A" spawn drop ] unit-test
  62
  63 [ ] [ [ "interactor" get stream-read-quot drop ] "B" spawn drop ] unit-test
  64
  65 [ ] [ 1 seconds sleep ] unit-test
  66
  67 [ ] [ "interactor" get interactor-eof ] unit-test
  68
  69 [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
  70
  71 : text "Hello world.\nThis is a test." ;
  72
  73 [ ] [ text "interactor" get set-editor-string ] unit-test
  74
  75 [ ] [ <promise> "promise" set ] unit-test
  76
  77 [ ] [
  78     [
  79         "interactor" get register-self
  80         "interactor" get contents "promise" get fulfill
  81     ] in-thread
  82 ] unit-test
  83
  84 [ ] [ 100 milliseconds sleep ] unit-test
  85
  86 [ ] [ "interactor" get evaluate-input ] unit-test
  87
  88 [ ] [ 100 milliseconds sleep ] unit-test
  89
  90 [ ] [ "interactor" get interactor-eof ] unit-test
  91
  92 [ t ] [ "promise" get 2 seconds ?promise-timeout text = ] unit-test
  93
  94 [ ] [ <pane> <pane-stream> <interactor> "interactor" set ] unit-test
  95
  96 [ ] [ text "interactor" get set-editor-string ] unit-test
  97
  98 [ ] [ <promise> "promise" set ] unit-test
  99
 100 [ ] [
 101     [
 102         "interactor" get register-self
 103         "interactor" get stream-read1 "promise" get fulfill
 104     ] in-thread
 105 ] unit-test
 106
 107 [ ] [ 100 milliseconds sleep ] unit-test
 108
 109 [ ] [ "interactor" get evaluate-input ] unit-test
 110
 111 [ CHAR: H ] [ "promise" get 2 seconds ?promise-timeout ] unit-test
 112
 113 [ ] [ <listener-gadget> [ ] with-grafted-gadget ] unit-test
 114
 115 [ ] [ <listener-gadget> "listener" set ] unit-test
 116
 117 "listener" get [
 118     <pane> <interactor> "i" set
 119
 120     [ t ] [ "i" get interactor? ] unit-test
 121
 122     [ ] [ "SYMBOL:" "i" get set-editor-string ] unit-test
 123
 124     [ ] [
 125         "i" get [ { "SYMBOL:" } parse-lines ] [ go-to-error ] recover
 126     ] unit-test
 127
 128     [ t ] [
 129         "i" get model>> doc-end
 130         "i" get editor-caret =
 131     ] unit-test
 132
 133     ! Race condition discovered by SimonRC
 134     [ ] [
 135         [
 136             "listener" get input>>
 137             [ stream-read-quot drop ]
 138             [ stream-read-quot drop ] bi
 139         ] "OH, HAI" spawn drop
 140     ] unit-test
 141
 142     [ ] [ "listener" get clear-output ] unit-test
 143
 144     [ ] [ "listener" get restart-listener ] unit-test
 145
 146     [ ] [ 1 seconds sleep ] unit-test
 147
 148     [ ] [ "listener" get com-end ] unit-test
 149 ] with-grafted-gadget
 150
 151 [ ] [ \ + <pane> <interactor> interactor-use use-if-necessary ] unit-test
 152
 153 [ ] [ <listener-gadget> "l" set ] unit-test
 154 [ ] [ "l" get com-scroll-up ] unit-test
 155 [ ] [ "l" get com-scroll-down ] unit-test
 156 [ ] [ "l" get hide-popup ] unit-test
 157 [ ] [ <gadget> "l" get show-popup ] unit-test
 158 [ ] [ "l" get hide-popup ] unit-test
 159
 160 [ ] [
 161     <gadget> "l" get show-popup
 162     <gadget> "l" get show-popup
 163     "l" get hide-popup
 164 ] unit-test