Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
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...
commit 452d63b3a7a4be88266b8c11b1e2a44969f9095b 1 parent eb8ca62
Gary King authored
View
4 dev/class-defs.lisp
@@ -15,7 +15,7 @@
(log-file :initform nil :initarg :log-file :reader log-file)
(test-data :initform nil :accessor test-data)
(profile
- :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)))
View
2  dev/definitions.lisp
@@ -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).")
View
2  dev/packages.lisp
@@ -26,6 +26,8 @@
#:report-hooks-for
#:add-report-hook-for
#:with-profile-report
+ #:*profile-style*
+ #:*count-calls-p*
#:describe-test-result
#:make-test-result
#:count-repetitions
View
15 dev/test-runner.lisp
@@ -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."))
(config
(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))
Please sign in to comment.
Something went wrong with that request. Please try again.