tests/time.pure.lisp

   1 ;;;; This software is part of the SBCL system. See the README file for
   2 ;;;; more information.
   3 ;;;;
   4 ;;;; While most of SBCL is derived from the CMU CL system, the test
   5 ;;;; files (like this one) were written from scratch after the fork
   6 ;;;; from CMU CL.
   7 ;;;;
   8 ;;;; This software is in the public domain and is provided with
   9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
  10 ;;;; more information.
  11
  12 (in-package "CL-USER")
  13
  14 ;;; Test for monotonicity of GET-INTERNAL-RUN-TIME.
  15 (funcall (compile nil
  16                   '(lambda (n-seconds)
  17                      (declare (type fixnum n-seconds))
  18                      (let* ((n-internal-time-units
  19                              (* n-seconds
  20                                 internal-time-units-per-second))
  21                             (time0 (get-internal-run-time))
  22                             (time1 (+ time0 n-internal-time-units)))
  23                        (loop
  24                         (let ((time (get-internal-run-time)))
  25                           (assert (>= time time0))
  26                           (when (>= time time1)
  27                             (return)))))))
  28          3)
  29
  30 (locally
  31   (declare (notinline mapcar))
  32   (mapcar (lambda (args)
  33             (destructuring-bind (obj type-spec result) args
  34               (flet ((matches-result? (x)
  35                        (eq (if x t nil) result)))
  36                 (assert (matches-result? (typep obj type-spec)))
  37                 (assert (matches-result? (sb-kernel:ctypep
  38                                           obj
  39                                           (sb-kernel:specifier-type
  40                                            type-spec)))))))
  41           '((nil (or null vector)              t)
  42             (nil (or number vector)            nil)
  43             (12  (or null vector)              nil)
  44             (12  (and (or number vector) real) t))))
  45
  46