1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
|
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res)))
(define (db:get-test-info db run-id testname item-path)
(db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir)
(cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path))
(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
(cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))
(define (db:test-get-rundir-from-test-id db test-id)
(let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f)))
;; (if res
;; res
;; (begin
(sqlite3:for-each-row
(lambda (tpath)
|
<
<
<
<
<
<
|
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
|
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res)))
(define (db:get-test-info db run-id testname item-path)
(db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
(define (db:test-get-rundir-from-test-id db test-id)
(let ((res #f)) ;; (hash-table-ref/default *test-paths* test-id #f)))
;; (if res
;; res
;; (begin
(sqlite3:for-each-row
(lambda (tpath)
|
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
|
;; MUST BE CALLED local!
(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
;; BUG: Move the values derived from args to parameters and push to megatest.scm
(let* ((testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
(statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%"))
(statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%"))
(runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%"))
(paths-from-db (cdb:remote-run db:test-get-paths-matching-keynames-target-new db keynames target res
testpatt
statepatt
statuspatt
runname)))
(if fnamepatt
(apply append
(map (lambda (p)
|
|
|
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
|
;; MUST BE CALLED local!
(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
;; BUG: Move the values derived from args to parameters and push to megatest.scm
(let* ((testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))
(statepatt (if (args:get-arg ":state") (args:get-arg ":state") "%"))
(statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%"))
(runname (if (args:get-arg ":runname") (args:get-arg ":runname") "%"))
(paths-from-db (rmt:test-get-paths-matching-keynames-target-new keynames target res
testpatt
statepatt
statuspatt
runname)))
(if fnamepatt
(apply append
(map (lambda (p)
|