;; test gauche.selector
(unless (global-variable-bound? 'gauche 'sys-select)
;; they don't work on the platform that doesn't have sys-select.
(exit 0))
(use gauche.test)
(test-start "selector")
(use gauche.selector)
(test-module 'gauche.selector)
(define *sel* #f)
(define-values (*p0* *p1*) (sys-pipe))
(define-values (*q0* *q1*) (sys-pipe))
(define *x* #f)
(define *y* #f)
(define (set-x port flags)
(case flags
((r) (set! *x* (read port)))
((w) (write '(xxx) port) (flush port))))
(define (set-y port flags)
(case flags
((r) (set! *y* (read port)))
((w) (write '(yyy) port) (flush port))))
(test* "make" #t
(begin (set! *sel* (make <selector>))
(is-a? *sel* <selector>)))
(test* "selector-add!" #f
(begin
(selector-add! *sel* *p0* set-x '(r))
*x*))
(test* "selector-select" '(foo)
(begin
(write '(foo) *p1*)
(flush *p1*)
(selector-select *sel*)
*x*))
(test* "selector-add!" #f
(begin
(selector-add! *sel* *q0* set-y '(r))
*y*))
(test* "selector-select" '(bar baz)
(begin
(write '(bar baz) *q1*)
(flush *q1*)
(selector-select *sel* '(1 0))
*y*))
(test* "selector-delete! (by port)" '(foo)
(begin
(selector-delete! *sel* *p0* #f #f)
(write '(zzz) *p1*)
(flush *p1*)
(selector-select *sel* 0)
*x*))
(test* "selector-delete! (by proc)" '(bar baz)
(begin
(selector-delete! *sel* #f set-y #f)
(write '(yyy) *q1*)
(flush *q1*)
(selector-select *sel* 0)
*y*))
(test* "selector-select (flags)" '(((zzz) (yyy))
((xxx) (yyy)))
(begin
(selector-add! *sel* *p0* set-x '(r))
(selector-add! *sel* *q0* set-y '(r))
(selector-add! *sel* *p1* set-x '(w))
(selector-add! *sel* *q1* set-y '(w))
(selector-select *sel*)
(let ((a (list *x* *y*)))
(selector-select *sel*)
(selector-select *sel* 0)
(list a (list *x* *y*)))))
(test* "selector-delete! (flags)" '((xxx) (yyy))
(begin
(write '(aaa) *p1*) (flush *p1*)
(write '(bbb) *q1*) (flush *q1*)
(selector-delete! *sel* #f #f '(r))
(selector-select *sel* 0)
(list *x* *y*)))
(test-end)