43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
-
+
+
-
+
|
-testpatt patt : in list-runs show only these tests, % is the wildcard
-itempatt patt : in list-runs show only tests with items that match patt
-showkeys : show the keys used in this megatest setup
Misc
-force : override some checks
-xterm : start an xterm instead of launching the test
-remove-runs : remove the data for a run, requires fields, :runname
-remove-runs : remove the data for a run, requires all fields be specified
and :runname ,-testpatt and -itempatt
and -testpatt
-testpatt patt : remove tests matching patt (requires -remove-runs)
|
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
+
|
"-testpatt"
"-itempatt"
"-setlog"
"-set-toplog"
"-runstep"
"-logpro"
"-m"
"-rerun"
)
(list "-h"
"-force"
"-xterm"
"-showkeys"
"-test-status"
"-gui"
|
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
+
+
|
(define *didsomething* #f)
;;======================================================================
;; Remove old run(s)
;;======================================================================
;; since several actions can be specified on the command line the removal
;; is done first
(define (remove-runs)
(cond
((not (args:get-arg ":runname"))
(print "ERROR: Missing required parameter for -remove-runs, you must specify the run name pattern with :runname patt")
(exit 2))
((not (args:get-arg "-testpatt"))
(print "ERROR: Missing required parameter for -remove-runs, you must specify the test pattern with -testpatt")
|
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
|
+
-
+
|
(let* ((testinfo (db:get-test-info db run-id test-name (item-list->path itemdat))))
(if (not (equal? (db:test-get-state testinfo) "COMPLETED"))
(begin
(print "Test NOT logged as COMPLETED, (state=" (db:test-get-state testinfo) "), updating result")
(test-set-status! db run-id test-name
(if kill-job? "KILLED" "COMPLETED")
(if (vector-ref exit-info 1) ;; look at the exit-status
(if (and (not kill-job?)
(if (eq? (vector-ref exit-info 2) 0)
(eq? (vector-ref exit-info 2) 0))
"PASS"
"FAIL")
"FAIL") itemdat (args:get-arg "-m")))))
(mutex-unlock! m)
;; (exec-results (cmd-run->list fullrunscript)) ;; (list ">" (conc test-name "-run.log"))))
;; (success exec-results)) ;; (eq? (cadr exec-results) 0)))
(print "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area "
|