Permalink
Browse files

testing -- fixes to last commit

I didn't realize there was already a function designed to do parallel
testing.  So, add the features of my new function (now deleted) to the
test-aserve-n function.  It now takes `wait' and `exit' keywords.
Adjust `test' rule accordingly.

Change-Id: Ib32d34df589ff33794046bb4c0c575b8ea966fe7
  • Loading branch information...
1 parent 9f97975 commit 036b2b8fda226e65441fc8b8be78b995bf4e05b3 @dklayer dklayer committed Jun 7, 2012
Showing with 61 additions and 64 deletions.
  1. +0 −19 load.cl
  2. +4 −2 makefile
  3. +57 −43 test/t-aserve.cl
View
19 load.cl
@@ -330,22 +330,3 @@
(let ((count (read-sequence buffer in)))
(if* (<= count 0) then (return))
(write-sequence buffer p :end count))))))))
-
-
-(defun run-aserve-tests (&key (nservers 1) exit)
- (time
- (let ((processes '()))
- (dotimes (i nservers)
- (push (mp:process-run-function
- (format nil "aserve test#~d" (1+ i))
- (lambda () (time (load "test/t-aserve.cl"))))
- processes))
- (dolist (p processes)
- (mp:process-wait
- (format nil "waiting for ~a"
- (mp:process-name p))
- (lambda (p) (eq :terminated (mp::process-state p)))
- p))
- (if* exit
- then (exit util.test::*test-errors* :quiet t)
- else util.test::*test-errors*))))
View
@@ -32,11 +32,13 @@ NSERVERS = 1
test: FORCE
rm -f build.tmp
+ echo '(dribble "test.out")' >> build.tmp
echo '(setq excl::*break-on-warnings* t)' >> build.tmp
echo '(setq util.test::*break-on-test-failures* t)' >> build.tmp
echo '(load "load.cl")' >> build.tmp
- echo '(dribble "test.out")' >> build.tmp
- echo '(run-aserve-tests :nservers $(NSERVERS) :exit t)' >> build.tmp
+ echo '(setq user::*do-aserve-test* nil)' >> build.tmp
+ echo '(load "test/t-aserve.cl")' >> build.tmp
+ echo '(time (test-aserve-n :n $(NSERVERS) :exit t))' >> build.tmp
# -batch must come before -L, since arguments are evaluated from left to right
$(mlisp) -batch -L build.tmp -kill
View
@@ -148,7 +148,9 @@
(defun user::test-aserve-n (&key n (test-timeouts *test-timeouts*) (delay 0) logs
(direct t) (proxy t) (proxyproxy t) (ssl t)
(name "ast") (log-name nil l-n-p)
- &aux wname)
+ (wait t) ; wait for tests to finish
+ (exit nil) ; ignored if wait=nil
+ &aux wname)
(typecase n
((integer 0) nil)
(otherwise
@@ -165,48 +167,63 @@
(test-aserve test-timeouts :direct direct :proxy proxy :proxyproxy proxyproxy
:ssl ssl))
(otherwise
- (when (cond (l-n-p (setq *log-wserver-name* log-name))
- ((eql n 1) (setq *log-wserver-name* nil))
- (t (setq *log-wserver-name* user::*default-log-wserver-name*)))
- (when (boundp 'util.test::*test-report-thread*)
- (set 'util.test::*test-report-thread* t)))
- (dotimes (i n)
- (mp:process-run-function
- (setq wname (format nil "~A~A" i name))
- (lambda (i name)
- (let* (os
- clean
- (*standard-output*
- (if logs
- (setq os
+ (let ((procs '()))
+ (when (cond (l-n-p (setq *log-wserver-name* log-name))
+ ((eql n 1) (setq *log-wserver-name* nil))
+ (t (setq *log-wserver-name* user::*default-log-wserver-name*)))
+ (when (boundp 'util.test::*test-report-thread*)
+ (set 'util.test::*test-report-thread* t)))
+ (dotimes (i n)
+ (push
+ (mp:process-run-function
+ (setq wname (format nil "~A~A" i name))
+ (lambda (i name)
+ (let* (os
+ clean
+ (*standard-output*
+ (if logs
+ (setq os
(open (format nil "~A~A.log" logs i) :direction :output
:if-exists :supersede))
- *standard-output*))
- (*aserve-test-config*
- (setf (aref *aserve-test-configs* i)
+ *standard-output*))
+ (*aserve-test-config*
+ (setf (aref *aserve-test-configs* i)
(make-instance 'aserve-test-config
- :name name :index i
- :test-timeouts test-timeouts)))
- (*wserver* (apply #'make-instance 'wserver
- (when user::*default-log-wserver-name* (list :name name)))))
- (unwind-protect
- (let ()
- (asc-format "~&~%============ STARTING SERVER ~A ~A ~%~%" i name)
- (setf (asc wserver) *wserver*)
- (test-aserve test-timeouts
- :direct direct :proxy proxy :proxyproxy proxyproxy :ssl ssl)
- (setq clean t))
- (asc-format "~&~%============ ENDING SERVER ~A ~A ~A ~%~%" i name
- (if clean "normally" "ABRUPTLY"))
- (when os (close os))
- (setf (asc done) (if clean :clean :abrupt))
- (dotimes (j (length *aserve-test-configs*)
- (format *initial-terminal-io* "~&~%~%ALL SERVERS ENDED~%~%"))
- (or (asc-done (aref *aserve-test-configs* j)) (return)))
- )))
- i wname)
- (sleep delay))))
- )
+ :name name :index i
+ :test-timeouts test-timeouts)))
+ (*wserver* (apply #'make-instance 'wserver
+ (when user::*default-log-wserver-name* (list :name name)))))
+ (unwind-protect
+ (let ()
+ (asc-format "~&~%============ STARTING SERVER ~A ~A ~%~%" i name)
+ (setf (asc wserver) *wserver*)
+ (test-aserve test-timeouts
+ :direct direct :proxy proxy :proxyproxy proxyproxy :ssl ssl)
+ (setq clean t))
+ (asc-format "~&~%============ ENDING SERVER ~A ~A ~A ~%~%" i name
+ (if clean "normally" "ABRUPTLY"))
+ (when os (close os))
+ (setf (asc done) (if clean :clean :abrupt))
+ (dotimes (j (length *aserve-test-configs*)
+ (format *initial-terminal-io* "~&~%~%ALL SERVERS ENDED~%~%"))
+ (or (asc-done (aref *aserve-test-configs* j)) (return)))
+ )))
+ i wname)
+ procs)
+ ;; should be able to handle a delay = 0
+ (sleep delay))
+
+ (when wait
+ (dolist (p procs)
+ (mp:process-wait
+ (format nil "waiting for ~a"
+ (mp:process-name p))
+ (lambda (p) (eq :terminated (mp::process-state p)))
+ p))))))
+ (when wait
+ (if* exit
+ then (exit util.test::*test-errors* :quiet t)
+ else util.test::*test-errors*)))
(defvar *asc-lock* (mp:make-process-lock :name "asc"))
(defun asc-format (fmt &rest args)
@@ -382,9 +399,6 @@
;-------- publish-file tests
-(defvar *dummy-file-value* nil)
-(defvar *dummy-file-name* "aservetest.xx")
-
(defun build-dummy-file (length line-length name compress)
;; write a dummy file named name (if name isn't nil)
;; of a given length with spaces every line-length characters

0 comments on commit 036b2b8

Please sign in to comment.