854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
|
(begin
(debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(runs:operate-on action
target
(common:args-get-runname) ;; (or (args:get-arg "-runname")(args:get-arg ":runname"))
(common:args-get-testpatt) ;; (args:get-arg "-testpatt")
state: (common:args-get-state)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")))
(set! *didsomething* #t)))))
(if (args:get-arg "-remove-runs")
(general-run-call
|
|
|
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
|
(begin
(debug:print 0 "ERROR: Attempted " action "on test(s) but run area config file not found")
(exit 1))
;; put test parameters into convenient variables
(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)
status: (common:args-get-status)
new-state-status: (args:get-arg "-set-state-status")))
(set! *didsomething* #t)))))
(if (args:get-arg "-remove-runs")
(general-run-call
|
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
|
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt))
;; (if (args:get-arg "-testpatt")
;; (args:get-arg "-testpatt")
;; "%"))
(keys (db:get-keys dbstruct))
;; (runsda t (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
|
|
|
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
|
;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
(if (or (args:get-arg "-list-runs")
(args:get-arg "-list-db-targets"))
(if (launch:setup-for-run)
(let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t))
(runpatt (args:get-arg "-list-runs"))
(testpatt (common:args-get-testpatt #f))
;; (if (args:get-arg "-testpatt")
;; (args:get-arg "-testpatt")
;; "%"))
(keys (db:get-keys dbstruct))
;; (runsda t (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f '("id" "runname" "state" "status" "owner" "event_time" "comment")))
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
|
;; launch task
;; else
;; put task in deferred queue
;; if still ok to run tasks
;; process deferred tasks per above steps
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")(args:get-arg "-run"))
(general-run-call
"-runall"
"run all tests"
(lambda (target runname keys keyvals)
(runs:run-tests target
runname
(common:args-get-testpatt)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash))))
;;======================================================================
;; run one test
|
|
>
>
|
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
|
;; launch task
;; else
;; put task in deferred queue
;; if still ok to run tasks
;; process deferred tasks per above steps
;; run all tests are are Not COMPLETED and PASS or CHECK
(if (or (args:get-arg "-runall")
(args:get-arg "-run")
(args:get-arg "-runtests"))
(general-run-call
"-runall"
"run all tests"
(lambda (target runname keys keyvals)
(runs:run-tests target
runname
#f ;; (common:args-get-testpatt #f)
;; (or (args:get-arg "-testpatt")
;; "%")
user
args:arg-hash))))
;;======================================================================
;; run one test
|
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
|
;; started and completed
;; - step started, timestamp
;; - step completed, exit status, timestamp
;; 6. test phone home
;; - if test run time > allowed run time then kill job
;; - if cannot access db > allowed disconnect time then kill job
(if (or (args:get-arg "-run")(args:get-arg "-runtests"))
(general-run-call
"-runtests"
"run a test"
(lambda (target runname keys keyvals)
;;
;; May or may not implement it this way ...
;;
;; Insert this run into the tasks queue
;; (open-run-close tasks:add tasks:open-db
;; "runtests"
;; user
;; target
;; runname
;; (args:get-arg "-runtests")
;; #f))))
(runs:run-tests target
runname
(common:args-get-testpatt) ;; (args:get-arg "-runtests")
user
args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
|
;; started and completed
;; - step started, timestamp
;; - step completed, exit status, timestamp
;; 6. test phone home
;; - if test run time > allowed run time then kill job
;; - if cannot access db > allowed disconnect time then kill job
;; == duplicated == (if (or (args:get-arg "-run")(args:get-arg "-runtests"))
;; == duplicated == (general-run-call
;; == duplicated == "-runtests"
;; == duplicated == "run a test"
;; == duplicated == (lambda (target runname keys keyvals)
;; == duplicated == ;;
;; == duplicated == ;; May or may not implement it this way ...
;; == duplicated == ;;
;; == duplicated == ;; Insert this run into the tasks queue
;; == duplicated == ;; (open-run-close tasks:add tasks:open-db
;; == duplicated == ;; "runtests"
;; == duplicated == ;; user
;; == duplicated == ;; target
;; == duplicated == ;; runname
;; == duplicated == ;; (args:get-arg "-runtests")
;; == duplicated == ;; #f))))
;; == duplicated == (runs:run-tests target
;; == duplicated == runname
;; == duplicated == (common:args-get-testpatt #f) ;; (args:get-arg "-runtests")
;; == duplicated == user
;; == duplicated == args:arg-hash))))
;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
(general-run-call
|