tests/serve-event.pure.lisp

   1 ;;;; tests of SERVE-EVENT
   2 ;;;;
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; While most of SBCL is derived from the CMU CL system, the test
   7 ;;;; files (like this one) were written from scratch after the fork
   8 ;;;; from CMU CL.
   9 ;;;;
  10 ;;;; This software is in the public domain and is provided with
  11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  12 ;;;; more information.
  13
  14 (in-package sb-impl)
  15
  16 ;; Tests for SERVE-EVENT are somewhat lacking,
  17 ;; although RUN-PROGRAM exercises some multiplexed I/O.
  18 ;; At any rate, this tests that the utility function COMPUTE-POLLFDS is sane.
  19 #+os-provides-poll ; can't use :skipped-on. (sb-unix symbols don't exist)
  20 (test-util:with-test (:name :compute-pollfds)
  21   (labels ((try (list how)
  22              (multiple-value-bind (pollfds count map)
  23                  (compute-pollfds list (length list) how)
  24                (multiple-value-prog1
  25                    (values (alien-to-native pollfds count) map)
  26                  (free-alien pollfds))))
  27            (alien-to-native (pollfds n)
  28              (let ((result (make-list n)))
  29                (dotimes (i n result)
  30                  (setf (elt result i)
  31                        (list (slot (deref pollfds i) 'sb-unix:fd)
  32                              (slot (deref pollfds i) 'sb-unix:events))))))
  33            (bogotify (h)
  34              ;; a handler becomes bogus when the user hasn't removed
  35              ;; it from the list, but the kernel said EBADF on it.
  36              (setf (handler-bogus h) t)
  37              h)
  38            (run-test (&rest list)
  39              (sb-int:binding* (((fds1 map1) (try list nil))
  40                                ((fds2 map2) (try list t)))
  41                (format t "~&~D handlers, ~D descriptors, ~D non-bogus
  42 ~:{(~D #b~b)~:^ ~}~%~S~%"
  43                        (length list)
  44                        (length (remove-duplicates
  45                                 list :key #'handler-descriptor))
  46                        (length (remove-duplicates
  47                                 (remove-if #'handler-bogus list)
  48                                 :key #'handler-descriptor))
  49                        fds1 map1)
  50                (loop for handler in list
  51                      for handler-index from 0
  52                      for fd-index = (svref map1 handler-index)
  53                      do (cond ((handler-bogus handler)
  54                                (assert (null fd-index))) ; isn't in fds[]
  55                               (t
  56                                (assert (eql (car (elt fds1 fd-index))
  57                                             (handler-descriptor handler))))))
  58                ;; the two algorithms for de-duplication of file descriptors
  59                ;; should be equivalent.
  60                (assert (equalp fds1 fds2))
  61                (assert (equalp map1 map2)))))
  62
  63     ;; Basic correctness
  64     (run-test (make-handler :output 1030 #'car)
  65               (make-handler :input 1028 #'car)
  66               (make-handler :input 500 #'car)
  67               (make-handler :output 500 #'car)
  68               (make-handler :input 1028 #'car)
  69               (make-handler :input 1030 #'car))
  70
  71     ;; this test is particularly insidious because descriptor 92
  72     ;; appears as both a bogus descriptor and non-bogus,
  73     ;; which probably can't happen in real life.
  74     (run-test (bogotify (make-handler :output 92 #'car))
  75               (make-handler :output 91 #'car)
  76               (make-handler :output 80 #'car)
  77               (make-handler :input 92 #'car)
  78               (make-handler :input 2 #'car)
  79               (bogotify (make-handler :input 5 #'car))
  80               (make-handler :input 3 #'car)
  81               (make-handler :input 2 #'cadr)
  82               (make-handler :input 1 #'car)
  83               (make-handler :input 2 #'car)
  84               (make-handler :input 9 #'car)
  85               (make-handler :input 55 #'car))))