| ︙ | | |
351
352
353
354
355
356
357
358
359
360
361
362
363
364
|
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
|
+
|
(loop (car tal)(cdr tal)))
#f))))))
(pop-directory)
result)))))
(define (tests:test-force-state-status! run-id test-id state status)
(rmt:test-set-status-state run-id test-id status state #f)
;; (rmt:roll-up-pass-fail-counts run-id test-name item
(mt:process-triggers run-id test-id state status))
;; Do not rpc this one, do the underlying calls!!!
(define (tests:test-set-status! run-id test-id state status comment dat #!key (work-area #f))
(let* ((real-status status)
(otherdat (if dat dat (make-hash-table)))
(testdat (rmt:get-test-info-by-id run-id test-id))
|
| ︙ | | |
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
|
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
|
-
+
+
-
-
+
+
|
(debug:print 4 *default-log-port* "real-status " real-status ", waived " waived ", status " status)
;; update the primary record IF state AND status are defined
(if (and state status)
(begin
(rmt:test-set-status-state run-id test-id real-status state (if waived waived comment))
(mt:process-triggers run-id test-id state real-status)))
;; (mt:process-triggers run-id test-id state real-status) ;; triggers are called in test-set-status-state
))
;; if status is "AUTO" then call rollup (note, this one modifies data in test
;; run area, it does remote calls under the hood.
(if (and test-id state status (equal? status "AUTO"))
(rmt:test-data-rollup run-id test-id status))
;; (if (and test-id state status (equal? status "AUTO"))
;; (rmt:test-data-rollup run-id test-id status))
;; add metadata (need to do this way to avoid SQL injection issues)
;; :first_err
;; (let ((val (hash-table-ref/default otherdat ":first_err" #f)))
;; (if val
;; (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path)))
|
| ︙ | | |
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
|
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
|
-
+
|
type )))
;; This was run remote, don't think that makes sense. Perhaps not, but that is the easiest path for the moment.
(rmt:csv->test-data run-id test-id
dat))))
;; need to update the top test record if PASS or FAIL and this is a subtest
(if (not (equal? item-path ""))
(rmt:roll-up-pass-fail-counts run-id test-name item-path state status))
(rmt:roll-up-pass-fail-counts run-id test-name item-path state status #f))
(if (or (and (string? comment)
(string-match (regexp "\\S+") comment))
waived)
(let ((cmt (if waived waived comment)))
(rmt:general-call 'set-test-comment run-id cmt test-id)))))
|
| ︙ | | |
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
|
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
|
-
-
-
+
+
|
force)
(let ((my-start-time (current-seconds))
(lockf (conc outputfilename ".lock")))
(let loop ((have-lock (common:simple-file-lock lockf)))
(if have-lock
(let ((script (configf:lookup *configdat* "testrollup" test-name)))
(print "Obtained lock for " outputfilename)
;; (rmt:top-test-set-per-pf-counts run-id test-name)
(rmt:roll-up-pass-fail-counts run-id test-name "" #f #f)
(rmt:top-test-set-per-pf-counts run-id test-name)
|
| ︙ | | |