X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Ftime.pure.lisp;h=a9aac4c80ab82894eb1d0c5604bbcbf7c1d15e2f;hb=a189a69454ef7635149319ae213b337f17c50d20;hp=df19ec028109defaa0008aa291e93f7c7b1eee8c;hpb=7c07a6f965c51828d8f452b47e0620d8e6cf2959;p=sbcl.git diff --git a/tests/time.pure.lisp b/tests/time.pure.lisp index df19ec0..a9aac4c 100644 --- a/tests/time.pure.lisp +++ b/tests/time.pure.lisp @@ -4,47 +4,29 @@ ;;;; 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. -#+nil ; FIXME: This test can't work as long as - ; (FUNCALL (COMPILE NIL (LAMBDA (X) (+ X 12))) 44) - ; fails with - ; # was defined in a non-null environment. +;;; 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)))) + '(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) - \ No newline at end of file +(with-test (:name :time/lambdas-converted) + (time (compile nil '(lambda () 42))))