1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
3 ;;; events.lisp --- io.multiplexer test suite.
5 ;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
7 ;;; Permission is hereby granted, free of charge, to any person
8 ;;; obtaining a copy of this software and associated documentation
9 ;;; files (the "Software"), to deal in the Software without
10 ;;; restriction, including without limitation the rights to use, copy,
11 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12 ;;; of the Software, and to permit persons to whom the Software is
13 ;;; furnished to do so, subject to the following conditions:
15 ;;; The above copyright notice and this permission notice shall be
16 ;;; included in all copies or substantial portions of the Software.
18 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25 ;;; DEALINGS IN THE SOFTWARE.
27 (in-package :iolib-tests
)
29 (in-suite* :io.multiplex
:in
:iolib
)
31 (defmacro with-event-base
/for-each-mux
((base &rest initargs
) &body body
)
33 (dolist (mux (mapcar #'cdr
*available-multiplexers
*) failed-list
)
35 (with-event-base (,base
:mux mux
,@initargs
)
38 (push (cons mux err
) failed-list
))))))
42 (with-event-base/for-each-mux
(base)
43 (event-dispatch base
:timeout
0))))
47 (with-event-base/for-each-mux
(base)
49 (add-timer base
(lambda () (setq cb
:timeout
)) 30)
50 (event-dispatch base
:timeout
0)
51 (assert (null cb
))))))
55 (with-event-base/for-each-mux
(base)
57 (add-timer base
(lambda () (setq cb
:timeout
)) 0)
58 (event-dispatch base
:one-shot t
)
59 (assert (eq cb
:timeout
))))))
61 ;;; regression test: timeouts' absolute times used used to be
62 ;;; incremented with the relative time ad infinitum.
65 (with-event-base/for-each-mux
(base)
67 (add-timer base
(lambda () (setq cb
:timeout
)) 1.5)
68 (event-dispatch base
:one-shot t
:timeout
2)
69 (assert (eq cb
:timeout
))))))
71 (defun timeout-cb (fd event
)
72 (declare (ignore fd event
))
75 (defmacro waiting-for-event
((base fd event-type
) &body body
)
76 (with-gensyms (fd-arg event-arg
)
79 (add-fd ,base
,fd
,event-type
80 (lambda (,fd-arg
,event-arg
)
81 (when (eq ,event-arg
:error
)
82 (error "error with ~A" ,fd-arg
))
85 (event-dispatch ,base
:one-shot t
)))))
87 ;;; FIXME: doesn't work with SELECT.
88 ;;; where ? it works here, on Linux. SIONESCU 2007.12.02
89 (test event-base-with-open-sockets
91 (with-event-base (base)
92 (with-open-socket (passive :family
:ipv4
:connect
:passive
93 :local-host
+ipv4-unspecified
+)
94 (with-open-socket (active :family
:ipv4
95 :remote-port
(local-port passive
)
96 :remote-host
#(127 0 0 1))
97 (add-timer base
#'timeout-cb
5)
99 (waiting-for-event (base (fd-of passive
) :read
)
100 (setq peer
(accept-connection passive
)))
101 (assert (socket-open-p peer
)))
102 ;; TODO: send and receive some stuff