344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
|
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
|
-
+
+
|
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(let ((targets (common:get-runconfig-targets)))
(print "Found "(length targets) " targets")
(for-each (lambda (x)
(print "[" x "]"))
;; (print "[" x "]"))
(print x))
targets)
(set! *didsomething* #t)))
(if (args:get-arg "-show-runconfig")
(begin
(pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f)))
(set! *didsomething* #t)))
|
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
|
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
|
-
+
+
|
(let ((targetstr (string-intersperse (map (lambda (x)
(db:get-value-by-header run header x))
keynames) "/")))
(if db-targets
(if (not (hash-table-ref/default seen targetstr #f))
(begin
(hash-table-set! seen targetstr #t)
(print "[" targetstr "]"))))
;; (print "[" targetstr "]"))))
(print targetstr))))
(if (not db-targets)
(let* ((run-id (open-run-close db:get-value-by-header run header "id"))
(tests (open-run-close db:get-tests-for-run db run-id testpatt '() '())))
(debug:print 1 "Run: " targetstr " status: " (db:get-value-by-header run header "state")
" run-id: " run-id ", number tests: " (length tests))
(for-each
(lambda (test)
|
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
|
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
|
-
+
|
(if (args:get-arg "-repl")
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(begin
(set! *db* db)
(set! *client-non-blocking-mode* #t)
;; (server:client-setup)
(server:client-setup)
(import readline)
(import apropos)
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))
(repl))
|