tests/events.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- io.multiplexer test suite.
   4 ;;;
   5
   6 (in-package :iolib-tests)
   7
   8 (in-suite* :io.multiplex :in :iolib)
   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
  20   (is-false
  21    (with-event-base/for-each-mux (base)
  22      (event-dispatch base :timeout 0))))
  23
  24 (test timeout.2
  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
  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
  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 :one-shot t :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)
  56     (once-only (base)
  57       `(progn
  58          (add-fd ,base ,fd ,event-type
  59                  (lambda (,fd-arg ,event-arg)
  60                    (when (eq ,event-arg :error)
  61                      (error "error with ~A" ,fd-arg))
  62                    ,@body)
  63                  :one-shot t)
  64          (event-dispatch ,base :one-shot t)))))
  65
  66 ;;; FIXME: doesn't work with SELECT.
  67 ;;;        where ? it works here, on Linux. SIONESCU 2007.12.02
  68 (test event-base-with-open-sockets
  69   (is-false
  70    (with-event-base (base)
  71      (with-open-socket (passive :address-family :ipv4 :connect :passive
  72                                 :local-host +ipv4-unspecified+)
  73        (with-open-socket (active :address-family :ipv4
  74                                  :remote-port (local-port passive)
  75                                  :remote-host #(127 0 0 1))
  76          (add-timer base #'timeout-cb 5)
  77          (let (peer)
  78            (waiting-for-event (base (fd-of passive) :read)
  79                               (setq peer (accept-connection passive)))
  80            (assert (socket-open-p peer)))
  81          ;; TODO: send and receive some stuff
  82          ))
  83      nil)))