1: ;;
    2: ;; test for listener
    3: ;; $Id: listener.scm,v 1.5 2007/08/24 23:56:30 shirok Exp $
    4: 
    5: (use gauche.test)
    6: 
    7: (test-start "listener")
    8: 
    9: (use gauche.listener)
   10: (test-module 'gauche.listener)
   11: 
   12: (test-section "complete-sexp?")
   13: 
   14: (define-syntax sexp-tester
   15:   (syntax-rules ()
   16:     ((_ result str)
   17:      (test* (format #f "complete-sexp? ~,,,,40:a" str)
   18:             result
   19:             (complete-sexp? str)))
   20:     ))
   21: 
   22: (sexp-tester #t "")
   23: (sexp-tester #t "a")
   24: (sexp-tester #t "abc")
   25: (sexp-tester #t "123")
   26: (sexp-tester #t "  3/4  ")
   27: (sexp-tester #t "  3/4")
   28: (sexp-tester #t "()")
   29: (sexp-tester #t "(abc)")
   30: (sexp-tester #t " ( a ) ")
   31: (sexp-tester #t " (a) ")
   32: (sexp-tester #t "(a . b)")
   33: (sexp-tester #t " ((((a)))) ")
   34: (sexp-tester #f " ((((a))) ")
   35: (sexp-tester #f " (((( a ))) ")
   36: (sexp-tester #t "(ab cd ef (guhr janr) ((airugn jenr) (bjn unrg)) () )")
   37: (sexp-tester #t "(ab cd ef [guhr janr] {[airugn jenr] (bjn unrg)} () )")
   38: (sexp-tester #f "(ab cd ef [guhr janr] {[airugn jenr} (bjn unrg)] () )")
   39: (sexp-tester #t " \"rugier\"")
   40: (sexp-tester #t " \"rugi \\\"er\\\" unga\"")
   41: (sexp-tester #t " \"\\\"\\\"\"")
   42: (sexp-tester #f " \"\\\"er\\\"")
   43: (sexp-tester #t " \"\\\"er\"")
   44: (sexp-tester #t " \"\\\"(\"")
   45: (sexp-tester #t "#\\a")
   46: (sexp-tester #f "#\\")
   47: (sexp-tester #t "#\\abunaga")
   48: (sexp-tester #t "#\\abunaga'(boogaz)")
   49: (sexp-tester #f "#\\abunaga'(boogaz")
   50: (sexp-tester #t "#\\(")
   51: (sexp-tester #t "(#\\( )")
   52: (sexp-tester #t "(#\\(gunar)")
   53: (sexp-tester #t "(#\\(gunar)")
   54: (sexp-tester #t "#(bunga bunga)")
   55: (sexp-tester #t "[#(bunga bunga)]")
   56: (sexp-tester #t "#x#d3242(bunar)")
   57: (sexp-tester #t "|buna(-|")
   58: (sexp-tester #f "|buna(-")
   59: (sexp-tester #t "|buna(-\\|zuppe|")
   60: (sexp-tester #t "|buna(-\\|zu[p\"e|")
   61: (sexp-tester #t "(|buna(-| . a)")
   62: (sexp-tester #t "#,(bunga bunga bunga)")
   63: (sexp-tester #t "#,()")
   64: (sexp-tester #f "#,(yop")
   65: (sexp-tester #t "(#,( () ) . a)")
   66: (sexp-tester #t "#[a-z]")
   67: (sexp-tester #t "#[[:alpha:]]")
   68: (sexp-tester #t "#[\\]]")
   69: (sexp-tester #f "#[1234")
   70: (sexp-tester #f "(#[1234 . )")
   71: (sexp-tester #t "(#[1234] . a)")
   72: (sexp-tester #t "[#[1234] . a]")
   73: (sexp-tester #t "#/reg(exp)fofofo[\\s\\d]/")
   74: (sexp-tester #t "#/(/")
   75: (sexp-tester #t "#/\\(/")
   76: (sexp-tester #t "#/\\/usr\\/bin/")
   77: (sexp-tester #f "#/\\/usr\\/bin  ")
   78: (sexp-tester #t "(#/(/ . a)")
   79: (sexp-tester *test-error* "(ibanr #<booba> )")
   80: 
   81: (test-section "listener")
   82: 
   83: (define-values (ipipe-in ipipe-out) (sys-pipe))
   84: (define-values (opipe-in opipe-out) (sys-pipe))
   85: (define-values (epipe-in epipe-out) (sys-pipe))
   86: 
   87: (set! (port-buffering ipipe-in) :none)
   88: (set! (port-buffering ipipe-out) :none)
   89: (set! (port-buffering opipe-in) :none)
   90: (set! (port-buffering opipe-out) :none)
   91: 
   92: (define *fatal* #f)
   93: 
   94: (define (fatal x) (set! *fatal* x) #t)
   95: 
   96: (define listener
   97:   (make <listener>
   98:     :input-port ipipe-in
   99:     :output-port opipe-out
  100:     :error-port epipe-out
  101:     :prompter (lambda () (display "<<<\n"))
  102:     :fatal-handler fatal))
  103: 
  104: (define handler (listener-read-handler listener))
  105: 
  106: (test* "prompter" "<<<"
  107:        (begin
  108:          (listener-show-prompt listener)
  109:          (read-line opipe-in)))
  110: 
  111: (define (send-expr expr)
  112:   (display expr ipipe-out) (flush ipipe-out))
  113: 
  114: (define (read-results)
  115:   (let loop ((l (read-line opipe-in))
  116:              (r '()))
  117:     (if (equal? l "<<<")
  118:         (reverse r)
  119:         (loop (read-line opipe-in) (cons l r)))))
  120: 
  121: ;; NB: at this moment, the tests don't work on windows because of
  122: ;; some buffering weirdness.  We omit tests on them.
  123: (cond-expand
  124:  (gauche.os.windows)
  125:  (else
  126: 
  127: (test* "listener" '("3")
  128:        (begin
  129:          (send-expr "(+ 1 2)\n")
  130:          (handler)
  131:          (read-results)))
  132: 
  133: (test* "listener" '("1" "2" "3")
  134:        (begin
  135:          (send-expr "(values 1 2 3)\n")
  136:          (handler)
  137:          (read-results)))
  138: 
  139: (test* "listener" '(("1") ("2"))
  140:        (begin
  141:          (send-expr "1 2\n")
  142:          (handler)
  143:          (let* ((r0 (read-results))
  144:                 (r1 (read-results)))
  145:            (list r0 r1))))
  146: 
  147: (test* "listener" '("3")
  148:        (begin
  149:          (send-expr "(+ 1 \n")
  150:          (handler)
  151:          (send-expr "2")
  152:          (handler)
  153:          (send-expr ")")
  154:          (handler)
  155:          (read-results)))
  156: 
  157: (test* "listener" '(("#\\a") ("3"))
  158:        (begin
  159:          (send-expr "#\\")
  160:          (handler)
  161:          (send-expr "a (+")
  162:          (handler)
  163:          (send-expr " 1 2)")
  164:          (handler)
  165:          (let* ((r0 (read-results))
  166:                 (r1 (read-results)))
  167:            (list r0 r1))))
  168: 
  169: ;(test* "listener (error)" "*** ERROR: unbound variable: zzz"
  170: ;       (begin
  171: ;         (send-expr "zzz")
  172: ;         (handler)
  173: ;         (read-line epipe-in)))
  174: 
  175: (test* "listener (fatal error)" <unhandled-signal-error>
  176:        (begin
  177:          (close-input-port opipe-in)
  178:          (send-expr "(+ 1 2)")
  179:          (handler)
  180:          (class-of *fatal*)))
  181: 
  182: )) ;; (not gauche.os.windows)
  183: 
  184: (test-end)