0.pre7.14:
[sbcl.git] / 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