From: Stas Boukarev Date: Wed, 13 Nov 2013 11:34:58 +0000 (+0400) Subject: sb-sprof: Move tests into test.lisp. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=04b902c7279d7f9e5fa75bccca2e26a002544eca;hp=f8664e5b8a5dfdcc6d0cb2f923b7de7a4322a1fa;p=sbcl.git sb-sprof: Move tests into test.lisp. Instead of having tests in sb-sprof.lisp and running them from test.lisp, move everything into test.lisp. --- diff --git a/contrib/sb-sprof/sb-sprof.lisp b/contrib/sb-sprof/sb-sprof.lisp index 1c7d1ca..6c3ee7c 100644 --- a/contrib/sb-sprof/sb-sprof.lisp +++ b/contrib/sb-sprof/sb-sprof.lisp @@ -1412,40 +1412,5 @@ functions during statistical profiling." (sb-c:%more-arg-values more-context 0 more-count))))))))) - -;;; silly examples - -(defun test-0 (n &optional (depth 0)) - (declare (optimize (debug 3))) - (when (< depth n) - (dotimes (i n) - (test-0 n (1+ depth)) - (test-0 n (1+ depth))))) - -(defun test () - (with-profiling (:reset t :max-samples 1000 :report :graph) - (test-0 7))) - -(defun consalot () - (let ((junk '())) - (loop repeat 10000 do - (push (make-array 10) junk)) - junk)) - -(defun consing-test () - ;; 0.0001 chosen so that it breaks rather reliably when sprof does not - ;; respect pseudo atomic. - (with-profiling (:reset t :sample-interval 0.0001 :report :graph :loop nil) - (let ((target (+ (get-universal-time) 15))) - (princ #\.) - (force-output) - (loop - while (< (get-universal-time) target) - do (consalot))))) - - -;;; provision (provide 'sb-sprof) - -;;; end of file diff --git a/contrib/sb-sprof/test.lisp b/contrib/sb-sprof/test.lisp index 9a16960..43432ef 100644 --- a/contrib/sb-sprof/test.lisp +++ b/contrib/sb-sprof/test.lisp @@ -1,13 +1,44 @@ (in-package :cl-user) + (require :sb-sprof) +;;; silly examples + +(defun test-0 (n &optional (depth 0)) + (declare (optimize (debug 3))) + (when (< depth n) + (dotimes (i n) + (test-0 n (1+ depth)) + (test-0 n (1+ depth))))) + +(defun test () + (sb-sprof:with-profiling (:reset t :max-samples 1000 :report :graph) + (test-0 7))) + +(defun consalot () + (let ((junk '())) + (loop repeat 10000 do + (push (make-array 10) junk)) + junk)) + +(defun consing-test () + ;; 0.0001 chosen so that it breaks rather reliably when sprof does not + ;; respect pseudo atomic. + (sb-sprof:with-profiling (:reset t :sample-interval 0.0001 :report :graph :loop nil) + (let ((target (+ (get-universal-time) 15))) + (princ #\.) + (force-output) + (loop + while (< (get-universal-time) target) + do (consalot))))) + #-(or win32 darwin) ;not yet -(sb-sprof::test) +(test) #-(or win32 darwin) ;not yet -(sb-sprof::consing-test) +(consing-test) ;; For debugging purposes, print output for visual inspection to see if ;; the allocation sequence gets hit in the right places (i.e. not at all ;; in traditional builds, and everywhere if SB-SAFEPOINT-STRICTLY is ;; enabled.) -(disassemble #'sb-sprof::consalot) +(disassemble #'consalot)