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 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
  70   (is-false
  71    (with-event-base (base)
  72      (with-open-socket (passive :address-family :ipv4 :connect :passive
  73                                 :local-host +ipv4-unspecified+)
  74        (with-open-socket (active :address-family :ipv4
  75                                  :remote-port (local-port passive)
  76                                  :remote-host #(127 0 0 1))
  77          (add-timer base #'timeout-cb 5)
  78          (let (peer)
  79            (waiting-for-event (base (fd-of passive) :read)
  80              (setq peer (accept-connection passive)))
  81            (assert (socket-open-p peer)))
  82          ;; TODO: send and receive some stuff
  83          ))
  84      nil)))