common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

sb-sprof: Convert to ASDF

Browse source
This commit is contained in:
Jan Moringen 2017-10-22 12:54:50 +02:00
parent 854ba237a3
commit 062eb41868
4 changed files with 39 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
contrib/sb-sprof/Makefile
View file

@ -1,5 +1,2 @@
MODULE=sb-sprof
include ../vanilla-module.mk
test::
$(SBCL) --eval '(load (format nil "SYS:CONTRIB;~:@(~A~);TEST.LISP" "$(MODULE)"))' </dev/null
SYSTEM=sb-sprof
include ../asdf-module.mk

14
contrib/sb-sprof/sb-sprof.asd Normal file
View file

@ -0,0 +1,14 @@
(defsystem "sb-sprof"
:description "A statistical profiler."
#+sb-building-contrib :pathname
#+sb-building-contrib #p"SYS:CONTRIB;SB-SPROF;"
:components ((:file "sb-sprof"))
:perform (load-op :after (o c) (provide 'sb-sprof))
:in-order-to ((test-op (test-op "sb-sprof/tests"))))
(defsystem "sb-sprof/tests"
:depends-on ("sb-sprof")
:components ((:file "test"))
:perform (test-op (o c)
(or (funcall (find-symbol "RUN-TESTS" "SB-SPROF-TEST"))
(error "test-op failed"))))

2
contrib/sb-sprof/sb-sprof.lisp
View file

@ -1423,5 +1423,3 @@ functions during statistical profiling."
(sb-c:%more-arg-values more-context
0
more-count)))))))))
(provide 'sb-sprof)

42
contrib/sb-sprof/test.lisp
View file

@ -1,6 +1,9 @@
(in-package :cl-user)
(cl:defpackage #:sb-sprof-test
(:use #:cl #:sb-sprof)
(:export #:run-tests))
(cl:in-package #:sb-sprof-test)
(require :sb-sprof)
;#+sb-fasteval (setq sb-ext:*evaluator-mode* :compile)
;;; silly examples
@ -13,7 +16,7 @@
(test-0 n (1+ depth)))))
(defun test ()
(sb-sprof:with-profiling (:reset t :max-samples 1000 :report :graph)
(with-profiling (:reset t :max-samples 1000 :report :graph)
(test-0 7)))
(defun consalot ()
@ -25,27 +28,28 @@
(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
;; setitimer with small intervals
;; is broken on FreeBSD 10.0
;; And ARM targets are not fast in
;; general, causing the profiling signal
;; to be constantly delivered without
;; making any progress.
#-(or freebsd arm) :sample-interval
#-(or freebsd arm) 0.0001
#+arm :sample-interval #+arm 0.1
:report :graph :loop nil)
(with-profiling (:reset t
;; setitimer with small intervals
;; is broken on FreeBSD 10.0
;; And ARM targets are not fast in
;; general, causing the profiling signal
;; to be constantly delivered without
;; making any progress.
#-(or freebsd arm) :sample-interval
#-(or freebsd arm) 0.0001
#+arm :sample-interval #+arm 0.1
:report :graph :loop nil)
(let ((target (+ (get-universal-time) 15)))
(princ #\.)
(force-output)
(loop while (< (get-universal-time) target)
do (consalot)))))
do (consalot)))))
#-(or win32 darwin) ;not yet
(test)
#-(or win32 darwin) ;not yet
(consing-test)
(defun run-tests ()
#-(or win32 darwin) ;not yet
(test)
#-(or win32 darwin) ;not yet
(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