Megatest

Diff
Login

Differences From Artifact [7467445dd0]:

To Artifact [be8860baa4]:


20
21
22
23
24
25
26

27
28
29



30
31
32
33
34
35
36
(import srfi-18 
	test 
	chicken.string
	chicken.process-context
	chicken.file
	chicken.pretty-print
	commonmod

	)

(define test-work-dir (current-directory))




;; given list of lists
;;  ( ( msg expected param1 param2 ...)
;;    ( ... ) )
;; apply test to all
;;
(define (test-batch proc pname inlst #!key (post-proc #f))







>



>
>
>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
(import srfi-18 
	test 
	chicken.string
	chicken.process-context
	chicken.file
	chicken.pretty-print
	commonmod
	ulex
	)

(define test-work-dir (current-directory))

(work-method   'mailbox)   ;; threads, direct, mailbox
(return-method 'mailbox)   ;; polling, mailbox, direct

;; given list of lists
;;  ( ( msg expected param1 param2 ...)
;;    ( ... ) )
;; apply test to all
;;
(define (test-batch proc pname inlst #!key (post-proc #f))
47
48
49
50
51
52
53










54
55
56
57
58
59
60
;; read in all the _record files
;; (let ((files (glob "*_records.scm")))
;;   (for-each
;;    (lambda (file)
;;      (print "Loading " file)
;;      (load file))
;;    files))











(let* ((unit-test-name (list-ref (argv) 4))
       (fname          (conc "../unittests/" unit-test-name ".scm")))
  (if (file-exists? fname)
      (load fname)
      (print "ERROR: Unit test " unit-test-name " not found in unittests directory")))








>
>
>
>
>
>
>
>
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
;; read in all the _record files
;; (let ((files (glob "*_records.scm")))
;;   (for-each
;;    (lambda (file)
;;      (print "Loading " file)
;;      (load file))
;;    files))

(define-syntax run-in-thread
  (syntax-rules ()
    ((_ body ...)
     (let ((th1 (make-thread (lambda ()
			       body ...)
			     "the thread")))
       (thread-start! th1)
       (thread-join! th1)))))


(let* ((unit-test-name (list-ref (argv) 4))
       (fname          (conc "../unittests/" unit-test-name ".scm")))
  (if (file-exists? fname)
      (load fname)
      (print "ERROR: Unit test " unit-test-name " not found in unittests directory")))