tests/events.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- iolib.multiplex test suite.
   4 ;;;
   5
   6 (in-package :iolib-tests)
   7
   8 (in-suite :iolib.multiplex)
   9
  10 (defmacro with-event-base/for-each-mux ((base &rest initargs) &body body)
  11   `(let ((failed-list))
  12      (dolist (mux (mapcar #'cdr *available-multiplexers*) failed-list)
  13        (handler-case
  14            (with-event-base (,base :mux mux ,@initargs)
  15              ,@body)
  16          (error (err)
  17            (push (cons mux err) failed-list))))))
  18
  19 (test (timeout.1 :compile-at :definition-time)
  20   (is-false
  21    (with-event-base/for-each-mux (base)
  22      (event-dispatch base :timeout 0))))
  23
  24 (test (timeout.2 :compile-at :definition-time)
  25   (is-false
  26    (with-event-base/for-each-mux (base)
  27      (let ((cb nil))
  28        (add-timer base (lambda () (setq cb :timeout)) 30)
  29        (event-dispatch base :timeout 0)
  30        (assert (null cb))))))
  31
  32 (test (timeout.3 :compile-at :definition-time)
  33   (is-false
  34    (with-event-base/for-each-mux (base)
  35      (let ((cb nil))
  36        (add-timer base (lambda () (setq cb :timeout)) 0)
  37        (event-dispatch base :one-shot t)
  38        (assert (eq cb :timeout))))))
  39
  40 ;;; regression test: timeouts' absolute times used used to be
  41 ;;; incremented with the relative time ad infinitum.
  42 (test (timeout.4 :compile-at :definition-time)
  43   (is-false
  44    (with-event-base/for-each-mux (base)
  45      (let ((cb nil))
  46        (add-timer base (lambda () (setq cb :timeout)) 1.5)
  47        (event-dispatch base :timeout 2)
  48        (assert (eq cb :timeout))))))
  49
  50 (defun timeout-cb (fd event)
  51   (declare (ignore fd event))
  52   (error "timeout"))
  53
  54 (defmacro waiting-for-event ((base fd event-type) &body body)
  55   (with-gensyms (fd-arg event-arg error-arg)
  56     (once-only (base)
  57       `(progn
  58          (set-io-handler ,base ,fd ,event-type
  59                          (lambda (,fd-arg ,event-arg ,error-arg)
  60                            (declare (ignore ,error-arg))
  61                            (when (eq ,event-arg :error)
  62                              (error "error with ~A" ,fd-arg))
  63                            ,@body)
  64                          :one-shot t)
  65          (event-dispatch ,base :one-shot t)))))
  66
  67 ;;; FIXME: doesn't work with SELECT.
  68 ;;;        where ? it works here, on Linux. SIONESCU 2007.12.02
  69 (test (event-base-with-open-sockets :compile-at :definition-time)
  70   (is-true
  71    (block test
  72      (with-event-base (base)
  73        (with-open-socket (passive :address-family :ipv4 :connect :passive
  74                                   :local-host +ipv4-unspecified+)
  75          (with-open-socket (active :address-family :ipv4
  76                                    :remote-port (local-port passive)
  77                                    :remote-host +ipv4-unspecified+)
  78            (add-timer base #'timeout-cb 5)
  79            (let (peer)
  80              (waiting-for-event (base (fd-of passive) :read)
  81                (setq peer (accept-connection passive)))
  82              (assert (socket-open-p peer))
  83              (send-to active #(1 2 3 4))
  84              (waiting-for-event (base (fd-of peer) :read)
  85                (multiple-value-bind (v n)
  86                    (receive-from peer :size 5)
  87                  (assert (= n 4))
  88                  (assert (equalp v #(1 2 3 4 0))))
  89                (return-from test t)))))
  90        nil))))