Browse files

finally added and exported *profile-style* to LIFT

This controls the default value for the profile argument
to run-test and run-tests. It can be :time, :space or nil (for
no profiling).

Change-Id: Ida53bb11beb3aab4a89202f2d941f112e955e34c
  • Loading branch information...
Gary King
Gary King committed Sep 1, 2010
1 parent eb8ca62 commit 452d63b3a7a4be88266b8c11b1e2a44969f9095b
Showing with 15 additions and 8 deletions.
  1. +2 −2 dev/class-defs.lisp
  2. +2 −0 dev/definitions.lisp
  3. +2 −0 dev/packages.lisp
  4. +9 −6 dev/test-runner.lisp
@@ -15,7 +15,7 @@
(log-file :initform nil :initarg :log-file :reader log-file)
(test-data :initform nil :accessor test-data)
- :initform nil
+ :initform *profile-style*
:initarg :profile
:accessor profile))
(:documentation "A test suite")
@@ -192,4 +192,4 @@ LIFT during a test run.")
(remove-if-not (lambda (p) (typep p 'testsuite-problem-mixin)) (failures result)))
(defun configuration-failures (result)
- (remove-if-not (lambda (p) (typep p 'test-configuration-problem-mixin)) (failures result)))
+ (remove-if-not (lambda (p) (typep p 'test-configuration-problem-mixin)) (failures result)))
@@ -168,3 +168,5 @@ the thing being defined.")
(defvar *count-calls-p* nil)
+(defvar *profile-style* nil
+ "Sets the default profiling style to :time, :space, or nil (for no profiling).")
@@ -26,6 +26,8 @@
+ #:*profile-style*
+ #:*count-calls-p*
@@ -8,14 +8,14 @@
(break-on-errors? *test-break-on-errors?*)
(break-on-failures? *test-break-on-failures?*)
(result nil)
- (profile nil)
+ (profile *profile-style* profile-supplied?)
(testsuite-initargs nil))
"Run a single test-case in a testsuite. Will run the most recently
defined or run testcase unless the name and suite arguments are used
to override them."
(assert suite nil "Test suite could not be determined.")
(assert name nil "Test-case could not be determined.")
- (when profile
+ (when profile-supplied?
(push profile testsuite-initargs)
(push :profile testsuite-initargs))
(let* ((*test-break-on-errors?* break-on-errors?)
@@ -94,7 +94,7 @@ to override them."
(config nil)
(dribble *lift-dribble-pathname*)
(report-pathname *lift-report-pathname*)
- (profile nil)
+ (profile *profile-style* profile-supplied?)
(skip-tests *skip-tests*)
;(timeout nil)
(do-children? *test-run-subsuites?*)
@@ -115,7 +115,7 @@ to override them."
(remf args :do-children?)
(remf args :testsuite-initargs)
(remf args :profile)
- (when profile
+ (when profile-supplied?
(push profile testsuite-initargs)
(push :profile testsuite-initargs))
(let* ((*lift-report-pathname*
@@ -136,7 +136,9 @@ but not both."))
(unless result
(setf result
- (apply #'make-test-result config :multiple args)))
+ (apply #'make-test-result config :multiple
+ :testsuite-initargs testsuite-initargs
+ args)))
(when report-pathname
(write-log-header report-pathname result args-copy))
(let* ((*test-result* result))
@@ -145,7 +147,8 @@ but not both."))
(unless result
(setf result
(apply #'make-test-result suite
- :multiple args)))
+ :multiple :testsuite-initargs testsuite-initargs
+ args)))
(setf (testsuite-initargs result) testsuite-initargs)
(when report-pathname
(write-log-header report-pathname result args-copy))

0 comments on commit 452d63b

Please sign in to comment.