| ︙ | | | ︙ | |
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; (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))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace dot-locking)
;; (trace
;; cdb:client-call
;; cdb:remote-run
;; cdb:test-set-status-state
;; change-directory
;; db:process-queue-item
;; db:test-get-logfile-info
;; db:teststep-set-status!
;; nice-path
;; obtain-dot-lock
|
|
>
>
>
|
|
>
|
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
;; (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))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses server))
(declare (uses client))
(declare (uses tests))
(declare (uses genexample))
(define *db* #f) ;; this is only for the repl, do not use in general!!!!
(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")
;; (use trace dot-locking)
;; (trace
;; cdb:tests-update-cpuload-diskfree
;; cdb:tests-update-uname-host
;; cdb:tests-update-run-duration
;; ;; cdb:client-call
;; ;; cdb:remote-run
;; )
;; cdb:test-set-status-state
;; change-directory
;; db:process-queue-item
;; db:test-get-logfile-info
;; db:teststep-set-status!
;; nice-path
;; obtain-dot-lock
|
| ︙ | | | ︙ | |
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
-rebuild-db : bring the database schema up to date
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-transport http|zmq : use http or zmq for transport (default is http)
-daemonize : fork into background and disconnect from stdin/out
-list-servers : list the servers
-stop-server id : stop server specified by id (see output of -list-servers)
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
Spreadsheet generation
|
|
|
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
-rebuild-db : bring the database schema up to date
-update-meta : update the tests metadata for all tests
-env2file fname : write the environment to fname.csh and fname.sh
-setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
overwritten by values set in config files.
-server -|hostname : start the server (reduces contention on megatest.db), use
- to automatically figure out hostname
-transport http|fs : use http or direct access for transport (default is http)
-daemonize : fork into background and disconnect from stdin/out
-list-servers : list the servers
-stop-server id : stop server specified by id (see output of -list-servers)
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
Spreadsheet generation
|
| ︙ | | | ︙ | |
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
|
(begin
(hash-table-set! seen targetstr #t)
;; (print "[" targetstr "]"))))
(print targetstr))))
(if (not db-targets)
(let* ((run-id (db:get-value-by-header run header "id"))
(tests (cdb:remote-run db:get-tests-for-run #f run-id testpatt '() '())))
(debug:print 1 "Run: " targetstr " status: " (db:get-value-by-header run header "state")
" run-id: " run-id ", number tests: " (length tests))
(for-each
(lambda (test)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(conc (db:test-get-testname test)
(if (equal? (db:test-get-item-path test) "")
""
|
>
|
|
|
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
|
(begin
(hash-table-set! seen targetstr #t)
;; (print "[" targetstr "]"))))
(print targetstr))))
(if (not db-targets)
(let* ((run-id (db:get-value-by-header run header "id"))
(tests (cdb:remote-run db:get-tests-for-run #f run-id testpatt '() '())))
(print "Run: " targetstr "/" (db:get-value-by-header run header "runname")
" status: " (db:get-value-by-header run header "state")
" run-id: " run-id ", number tests: " (length tests))
(for-each
(lambda (test)
(format #t
" Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"
(conc (db:test-get-testname test)
(if (equal? (db:test-get-item-path test) "")
""
|
| ︙ | | | ︙ | |
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
|
;; (set! *runremote* runremote)
(set! *transport-type* (string->symbol transport))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(if (and state status)
;; DO NOT remote run
(db:teststep-set-status! db test-id step state status msg logfile)
(begin
(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
(exit 6))))))
(if (args:get-arg "-step")
(begin
|
|
|
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
|
;; (set! *runremote* runremote)
(set! *transport-type* (string->symbol transport))
(if (not (setup-for-run))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(if (and state status)
;; DO NOT remote run, makes calls to the testdat.db test db.
(db:teststep-set-status! db test-id step state status msg logfile)
(begin
(debug:print 0 "ERROR: You must specify :state and :status with every call to -step")
(exit 6))))))
(if (args:get-arg "-step")
(begin
|
| ︙ | | | ︙ | |