;;;; While most of SBCL is derived from the CMU CL system, the test
;;;; files (like this one) were written from scratch after the fork
;;;; from CMU CL.
-;;;;
+;;;;
;;;; This software is in the public domain and is provided with
;;;; absolutely no warranty. See the COPYING and CREDITS files for
;;;; more information.
(in-package "CL-USER")
-;;; Test for monotonicity of GET-INTERNAL-RUN-TIME.
+;;; Test for monotonicity of GET-INTERNAL-RUN-TIME. (On OpenBSD, this
+;;; is not a given, because of a longstanding bug in getrusage().)
(funcall (compile nil
- (lambda (n-seconds)
- (declare (type fixnum n-seconds))
- (let* ((n-internal-time-units
- (* n-seconds
- internal-time-units-per-second))
- (time0 (get-internal-run-time))
- (time1 (+ time0 n-internal-time-units)))
- (loop
- (let ((time (get-internal-run-time)))
- (assert (>= time time0))
- (when (>= time time1)
- (return)))))))
- 3)
-
-(locally
- (declare (notinline mapcar))
- (mapcar (lambda (args)
- (destructuring-bind (obj type-spec result) args
- (flet ((matches-result? (x)
- (eq (if x t nil) result)))
- (assert (matches-result? (typep obj type-spec)))
- (assert (matches-result? (sb-kernel:ctypep
- obj
- (sb-kernel:specifier-type
- type-spec)))))))
- '((nil (or null vector) t)
- (nil (or number vector) nil)
- (12 (or null vector) nil)
- (12 (and (or number vector) real) t))))
-
-
\ No newline at end of file
+ '(lambda (n-seconds)
+ (declare (type fixnum n-seconds))
+ (let* ((n-internal-time-units
+ (* n-seconds
+ internal-time-units-per-second))
+ (time0 (get-internal-run-time))
+ (time1 (+ time0 n-internal-time-units)))
+ (loop
+ (let ((time (get-internal-run-time)))
+ (assert (>= time time0))
+ (when (>= time time1)
+ (return)))))))
+ 3)