| ︙ | | |
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
;; (include "common.scm")
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
readline apropos json http-client directory-utils typed-records
http-client srfi-18 extras format)
;; Added for csv stuff - will be removed
;;
(use sparse-vectors)
(require-library mutils)
;; (use zmq)
(declare (uses ftail))
(import ftail)
;; (declare (uses ftail))
;; (import ftail)
(import stml2 mutils commonmod)
;; invoke the imports
;; (declare (uses mtargs.import))
;; (declare (uses mtconfigf.import))
(declare (uses cookie.import))
(declare (uses stml2.import))
(declare (uses pkts.import))
(declare (uses commonmod.import))
(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 "run_records.scm")
(include "megatest-fossil-hash.scm")
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
readline apropos json http-client directory-utils typed-records
http-client srfi-18 extras format)
;; Added for csv stuff - will be removed
;;
(use sparse-vectors)
(import mutils ducttape-lib stml2)
;; (use zmq)
(define *usage-log-file* #f) ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file
;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
|
| ︙ | | |
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
|
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
|
-
+
+
+
-
+
-
-
+
+
-
-
-
+
+
|
-refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode
formats: perl, ruby, sqlite3, csv (for csv the -o param
will substitute %s for the sheet name in generating
multiple sheets)
-o : output file for refdb2dat (defaults to stdout)
-archive cmd : archive runs specified by selectors to one of disks specified
in the [archive-disks] section.
cmd: keep-html, restore, save, save-remove
cmd: keep-html, restore, save, save-remove, get (use
-dest to set destination), -include and -exclude to include or
exclude files)
-generate-html : create a simple html dashboard for browsing your runs
-generate-html-structure : create a top level html veiw to list targets/runs and a Run view within each run directory.
-list-run-time : list time requered to complete runs. It supports following switches
-run-patt <patt> -target-patt <patt> -dumpmode <csv,json,plain-text>
-list-test-time : list time requered to complete each test in a run. It following following arguments
-list-test-time : list time requered to complete each test in a run. It following following arguments
-runname <patt> -target <patt> -dumpmode <csv,json,plain-text>
-syscheck : do some very basic checks; write access and space in tmp, home, runs, links and
is $DISPLAY valid
-create-megatest-area : create a skeleton megatest area. You will be prompted for paths
-create-test testname : create a skeleton megatest test. You will be prompted for info
-create-megatest-area : create a skeleton megatest area. You will be prompted for paths
-create-test testname : create a skeleton megatest test. You will be prompted for info
Examples
# Get test path, use '.' to get a single path or a specific path/file pattern
megatest -test-files 'logs/*.log' -target ubuntu/n%/no% -runname w49% -testpatt test_mt%
Called as " (string-intersperse (argv) " ") "
|
| ︙ | | |
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
|
+
|
"-logpro"
"-m"
"-rerun"
"-days"
"-rename-run"
"-to"
"-dest"
;; values and messages
":category"
":variable"
":value"
":expected"
":tol"
":units"
|
| ︙ | | |
434
435
436
437
438
439
440
441
442
443
444
445
446
447
|
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
|
+
+
|
"-sync-to-megatest.db"
"-sync-brute-force"
"-logging"
"-v" ;; verbose 2, more than normal (normal is 1)
"-q" ;; quiet 0, errors/warnings only
"-diff-rep"
"-syscheck"
)
args:arg-hash
0))
;; Add args that use remargs here
;;
(if (and (not (null? remargs))
|
| ︙ | | |
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
|
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
|
-
+
-
+
+
+
+
+
+
+
|
(start-watchdog (null? no-watchdog-args-vals)))
;;(BB> "no-watchdog-args="no-watchdog-args "no-watchdog-args-vals="no-watchdog-args-vals)
(if start-watchdog
(thread-start! *watchdog*)))
;; bracket open-output-file with code to make leading directory if it does not exist and handle exceptions
(define (open-logfile logpath)
(define (open-logfile logpath-in)
(condition-case
(let* ((log-dir (or (pathname-directory logpath) ".")))
(let* ((log-dir (or (pathname-directory logpath-in) "."))
(fname (pathname-strip-directory logpath-in))
(logpath (if (> (string-length fname) 250)
(let ((newlogf (conc log-dir "/" (common:get-signature fname) ".log")))
(debug:print 0 *default-log-port* "WARNING: log file " logpath-in " path too long, converted to " newlogf)
newlogf)
logpath-in)))
(if (not (directory-exists? log-dir))
(system (conc "mkdir -p " log-dir)))
(open-output-file logpath))
(exn ()
(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath)
(define *didsomething* #t)
(exit 1))))
|
| ︙ | | |
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
|
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
|
-
+
+
+
+
+
+
+
+
+
-
+
+
-
+
+
-
-
-
+
+
+
-
-
+
+
+
-
-
-
+
+
+
|
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action #!key (mode #f)) ;; #f is "use default"
(define (operate-on action #!key (mode #f)(target-in #f)(runname-in #f)(keys-in #f)(keyvals-in #f)) ;; #f is "use default"
(let* ((runrec (runs:runrec-make-record))
(target (or target-in (common:args-get-target))) ;; eventually get rid of the call to common:args-get-target
(runname (or runname-in
(args:get-arg "-runname"))) ;; eventually get rid of the get-arg calls
(testpatt (or (args:get-arg "-testpatt")
(and (eq? action 'archive) ;; if it is an archive command fallback to MT_TEST_NAME and MT_ITEMPATH
(common:get-full-test-name))
(and (eq? action 'kill-runs)
"%/%") ;; I'm just guessing that this is correct :(
(target (common:args-get-target)))
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")))
))) ;;
(cond
((not target)
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify -target or -reqtarg")
(debug:print-error 0 *default-log-port* "Missing required parameter for "
action ", you must specify -target or -reqtarg")
(exit 1))
((not (or (args:get-arg ":runname")
(args:get-arg "-runname")))
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the run name pattern with -runname patt")
((not (or (args:get-arg "-testpatt") (eq? action 'kill-runs)))
(debug:print-error 0 *default-log-port* "Missing required parameter for " action ", you must specify the test pattern with -testpatt")
((not testpatt)
(debug:print-error 0 *default-log-port* "Missing required parameter for "
action ", you must specify the test pattern with -testpatt")
(exit 3))
(else
(if (not (car *configinfo*))
(begin
(debug:print-error 0 *default-log-port* "Attempted " action "on test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(begin
;; check for correct version, exit with message if not correct
(common:exit-on-version-changed)
(runs:operate-on action
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
(common:args-get-testpatt #f) ;; (args:get-arg "-testpatt")
state: (common:args-get-state)
runname
testpatt
state: (common:args-get-state)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")
mode: mode)))
(set! *didsomething* #t)))))
(if (args:get-arg "-kill-runs")
(general-run-call
|
| ︙ | | |
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
|
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
|
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
|
;;======================================================================
;; Archive tests
;;======================================================================
;; Archive tests matching target, runname, and testpatt
(if (args:get-arg "-archive")
;; else do a general-run-call
(begin
;; for the archive get we need to preserve the starting dir as part of the target path
(if (and (args:get-arg "-dest")
(not (equal? (substring (args:get-arg "-dest") 0 1) "/")))
(let ((newpath (conc (current-directory) "/" (args:get-arg "-dest"))))
(debug:print-info 1 *default-log-port* "Preserving original path to destination, was " (args:get-arg "-dest") ", now " newpath)
(hash-table-set! args:arg-hash "-dest" newpath)))
(general-run-call
"-archive"
"Archive"
(lambda (target runname keys keyvals)
(operate-on 'archive))))
(general-run-call
"-archive"
"Archive"
(lambda (target runname keys keyvals)
(operate-on 'archive target-in: target runname-in: runname )))))
;;======================================================================
;; Extract a spreadsheet from the runs database
;;======================================================================
(if (args:get-arg "-extract-ods")
(general-run-call
|
| ︙ | | |
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
|
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
|
+
+
+
+
+
+
+
+
+
|
(if (args:get-arg "-generate-html")
(let* ((toppath (launch:setup)))
(if (tests:create-html-tree #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/page0.html")
(debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
(set! *didsomething* #t)))
(if (args:get-arg "-generate-html-structure")
(let* ((toppath (launch:setup)))
;(if (tests:create-html-tree #f)
(if (tests:create-html-summary #f)
(debug:print-info 0 *default-log-port* "HTML output created in " toppath "/lt/targets.html")
(debug:print 0 *default-log-port* "Failed to create HTML output in " toppath "/lt/runs-index.html"))
(set! *didsomething* #t)))
(if (args:get-arg "-syscheck")
(begin
(mutils:syscheck common:raw-get-remote-host-load
server:get-best-guess-address
read-config)
(set! *didsomething* #t)))
;;======================================================================
;; Exit and clean up
;;======================================================================
(if (not *didsomething*)
(debug:print 0 *default-log-port* help)
(set! *time-to-exit* #t)
|
| ︙ | | |