︙ | | | ︙ | |
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
|
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (db:get-keys dbstruct))
;; (runsdat (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f))
;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
(runs (db:get-rows runsdat))
(header (db:get-header runsdat))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table))
(dmode (let ((d (args:get-arg "-dumpmode")))
(if d (string->symbol d) #f)))
(data (make-hash-table)))
|
<
|
905
906
907
908
909
910
911
912
913
914
915
916
917
918
|
(testpatt (if (args:get-arg "-testpatt")
(args:get-arg "-testpatt")
"%"))
(keys (db:get-keys dbstruct))
;; (runsdat (db:get-runs dbstruct runpatt #f #f '()))
(runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
#f #f))
(runs (db:get-rows runsdat))
(header (db:get-header runsdat))
(db-targets (args:get-arg "-list-db-targets"))
(seen (make-hash-table))
(dmode (let ((d (args:get-arg "-dumpmode")))
(if d (string->symbol d) #f)))
(data (make-hash-table)))
|
︙ | | | ︙ | |
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
|
(if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
(change-directory work-area)
;; can setup as client for server mode now
;; (client:setup)
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
;; DO NOT put this one into either cdb:remote-run or open-run-close
(tdb:load-test-data run-id test-id))
(if (args:get-arg "-setlog")
(let ((logfname (args:get-arg "-setlog")))
(rmt:test-set-log! run-id test-id logfname)))
(if (args:get-arg "-set-toplog")
;; DO NOT run remote
(tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog")))
|
|
|
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
|
(if (args:get-arg "-runstep")(debug:print-info 1 "Running -runstep, first change to directory " work-area))
(change-directory work-area)
;; can setup as client for server mode now
;; (client:setup)
(if (args:get-arg "-load-test-data")
;; has sub commands that are rdb:
;; DO NOT put this one into either rmt: or open-run-close
(tdb:load-test-data run-id test-id))
(if (args:get-arg "-setlog")
(let ((logfname (args:get-arg "-setlog")))
(rmt:test-set-log! run-id test-id logfname)))
(if (args:get-arg "-set-toplog")
;; DO NOT run remote
(tests:test-set-toplog! run-id test-name (args:get-arg "-set-toplog")))
|
︙ | | | ︙ | |
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
|
(args:get-arg "-show-keys"))
(let ((db #f)
(keys #f))
(if (not (launch:setup-for-run *area-dat*))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! keys (cdb:remote-run db:get-keys db))
(debug:print 1 "Keys: " (string-intersperse keys ", "))
(if (sqlite3:database? db)(sqlite3:finalize! db))
(set! *didsomething* #t)))
(if (args:get-arg "-gui")
(begin
(debug:print 0 "Look at the dashboard for now")
|
|
|
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
|
(args:get-arg "-show-keys"))
(let ((db #f)
(keys #f))
(if (not (launch:setup-for-run *area-dat*))
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
(set! keys (rmt:get-keys)) ;; db))
(debug:print 1 "Keys: " (string-intersperse keys ", "))
(if (sqlite3:database? db)(sqlite3:finalize! db))
(set! *didsomething* #t)))
(if (args:get-arg "-gui")
(begin
(debug:print 0 "Look at the dashboard for now")
|
︙ | | | ︙ | |
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
|
(set! *client-non-blocking-mode* #t)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(use-legacy-bindings)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(gnu-history-install-file-manager
(let ((d (string-append
(or (get-environment-variable "HOME") ".") "/.megatest")))
(if (not (file-exists? d))
(create-directory d #t))
d))
(current-input-port (make-gnu-readline-port "megatest> "))
|
>
|
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
|
(set! *client-non-blocking-mode* #t)
(import extras) ;; might not be needed
;; (import csi)
(import readline)
(use-legacy-bindings)
(import apropos)
;; (import (prefix sqlite3 sqlite3:)) ;; doesn't work ...
(include "readline-fix.scm")
(gnu-history-install-file-manager
(let ((d (string-append
(or (get-environment-variable "HOME") ".") "/.megatest")))
(if (not (file-exists? d))
(create-directory d #t))
d))
(current-input-port (make-gnu-readline-port "megatest> "))
|
︙ | | | ︙ | |