1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos json) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
;; (use zmq)
(declare (uses common))
(declare (uses megatest-version))
|
|
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
|
;; Copyright 2006-2012, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; (include "common.scm")
;; (include "megatest-version.scm")
(use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 format readline apropos json http-client) ;; (srfi 18) extras)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))
;; (use zmq)
(declare (uses common))
(declare (uses megatest-version))
|
︙ | | | ︙ | |
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace dot-locking)
;; (trace
;; tests:match)
;; db:teststep-set-status!
;; db:open-test-db-by-test-id
;; db:test-get-rundir-from-test-id
;; cdb:tests-register-test
;; cdb:tests-update-uname-host
;; cdb:tests-update-run-duration
;; ;; cdb:client-call
|
|
|
>
|
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace dot-locking)
;; (trace
;; tests:match
;; runs:run-tests)
;; db:teststep-set-status!
;; db:open-test-db-by-test-id
;; db:test-get-rundir-from-test-id
;; cdb:tests-register-test
;; cdb:tests-update-uname-host
;; cdb:tests-update-run-duration
;; ;; cdb:client-call
|
︙ | | | ︙ | |
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
|
(general-run-call
"-runtests"
"run a test"
(lambda (target runname keys keynames keyvallst)
(runs:run-tests target
runname
(args:get-arg "-runtests")
(or (args:get-arg "-testpatt")
(args:get-arg "-runtests"))
user
args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
|
<
|
|
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
|
(general-run-call
"-runtests"
"run a test"
(lambda (target runname keys keynames keyvallst)
(runs:run-tests target
runname
(args:get-arg "-runtests")
(args:get-arg "-runtests")
user
args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
|
︙ | | | ︙ | |
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
|
(load (args:get-arg "-load"))))
(exit))
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
;; this is the socket if we are a client
;; (if (and *runremote*
;; (socket? *runremote*))
;; (close-socket *runremote*))
(if (not *didsomething*)
|
>
>
|
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
|
(load (args:get-arg "-load"))))
(exit))
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
(if *runremote* (close-all-connections!))
;; this is the socket if we are a client
;; (if (and *runremote*
;; (socket? *runremote*))
;; (close-socket *runremote*))
(if (not *didsomething*)
|
︙ | | | ︙ | |