Overview
Comment: | Improved messages on -list-runs |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80 |
Files: | files | file ages | folders |
SHA1: |
c8040a78face8a5733ddf84942c4afde |
User & Date: | matt on 2023-02-22 12:27:48 |
Other Links: | branch diff | manifest | tags |
Context
2023-02-23
| ||
06:04 | rmt:get-key-val-pairs was using wrong db. check-in: 335653cb5f user: matt tags: v1.80 | |
2023-02-22
| ||
12:27 | Improved messages on -list-runs check-in: c8040a78fa user: matt tags: v1.80 | |
11:42 | bumped allowed number of running servers check-in: 5fca83553e user: mrwellan tags: v1.80 | |
Changes
Modified megatest.scm from [f617118e28] to [a9076c4fb8].
︙ | ︙ | |||
1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 | (tests-spec (let ((t (alist-ref "tests" fields-spec equal?))) (if (and t (null? t)) ;; all fields db:test-record-fields t))) (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id")))) (steps-spec (alist-ref "steps" fields-spec equal?)) (test-field-index (make-hash-table))) (if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec (let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec))) (if (null? invalid-tests-spec) ;; generate the lookup map test-field-name => index-number (let loop ((hed (car adj-tests-spec)) (tal (cdr adj-tests-spec)) (idx 0)) | > > > > > | 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 | (tests-spec (let ((t (alist-ref "tests" fields-spec equal?))) (if (and t (null? t)) ;; all fields db:test-record-fields t))) (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id")))) (steps-spec (alist-ref "steps" fields-spec equal?)) (test-field-index (make-hash-table))) (if (and (args:get-arg "-dumpmode") (not (member (args:get-arg "-dumpmode") '("sexpr" "json" "ods" "list")))) (begin (debug:print 0 *default-log-port* "ERROR: dumpmode "(args:get-arg "-dumpmode")" not recognised. Use sexpr, json, ods or list") (exit))) (if (and tests-spec (not (null? tests-spec))) ;; do some validation and processing of the test-spec (let ((invalid-tests-spec (filter (lambda (x)(not (member x db:test-record-fields))) tests-spec))) (if (null? invalid-tests-spec) ;; generate the lookup map test-field-name => index-number (let loop ((hed (car adj-tests-spec)) (tal (cdr adj-tests-spec)) (idx 0)) |
︙ | ︙ | |||
1503 1504 1505 1506 1507 1508 1509 | ;; (mutils:hierhash-set! data (db:get-value-by-header run header "status") targetstr runname "meta" "status" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "state") targetstr runname "meta" "state" ) ;; (mutils:hierhash-set! data (conc (db:get-value-by-header run header "id")) targetstr runname "meta" "id" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "event_time") targetstr runname "meta" "event_time" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" ) ;; ;; add last entry twice - seems to be a bug in hierhash? ;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" ) | | | > > > | 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 | ;; (mutils:hierhash-set! data (db:get-value-by-header run header "status") targetstr runname "meta" "status" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "state") targetstr runname "meta" "state" ) ;; (mutils:hierhash-set! data (conc (db:get-value-by-header run header "id")) targetstr runname "meta" "id" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "event_time") targetstr runname "meta" "event_time" ) ;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" ) ;; ;; add last entry twice - seems to be a bug in hierhash? ;; (mutils:hierhash-set! data (db:get-value-by-header run header "comment") targetstr runname "meta" "comment" ) ((#f list) (if (null? runs-spec) (print "Run: " targetstr "/" runname " status: " (db:get-value-by-header run header "state") " run-id: " run-id ", number tests: " (length tests) " event_time: " (db:get-value-by-header run header "event_time")) (begin (if (not (member "target" runs-spec)) ;; (display (conc "Target: " targetstr)) (display (conc "Run: " targetstr "/" runname " "))) (for-each (lambda (field-name) (if (equal? field-name "target") (display (conc "target: " targetstr " ")) (display (conc field-name ": " (db:get-value-by-header run header (conc field-name)) " ")))) runs-spec) (newline)))) (else (debug:print 0 *default-log-port* "ERROR: dumpmode "(args:get-arg "-dumpmode")" not recognised. Use sexpr, json, ods or list") )) (for-each (lambda (test) (common:debug-handle-exceptions #f exn (begin (debug:print-error 0 *default-log-port* "Bad data in test record? " test) |
︙ | ︙ |
Modified tcp-transportmod.scm from [f4eb0bdfcc] to [b0099fec72].
︙ | ︙ | |||
556 557 558 559 560 561 562 | " -m testsuite:" testsuite ;; " -run-id " (or run-id "main") ;; NO, we do NOT want to have run id as part of this " -db " (dbmod:run-id->dbfname run-id) " " profile-mode ))) ;; (conc " >> " logfile " 2>&1 &"))))) ;; we want the remote server to start in *toppath* so push there ;; (push-directory areapath) ;; use cd in the command line instead | | | 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 | " -m testsuite:" testsuite ;; " -run-id " (or run-id "main") ;; NO, we do NOT want to have run id as part of this " -db " (dbmod:run-id->dbfname run-id) " " profile-mode ))) ;; (conc " >> " logfile " 2>&1 &"))))) ;; we want the remote server to start in *toppath* so push there ;; (push-directory areapath) ;; use cd in the command line instead (debug:print 0 *default-log-port* "INFO: Trying to start server in tcp mode (" cmdln ") at "(common:human-time)" for "areapath) ;; (debug:print 0 *default-log-port* "INFO: starting server at " (common:human-time)) (setenv "NBFAKE_QUIET" "yes") ;; BUG: change to with-environment-variable ... (setenv "NBFAKE_LOG" logfile) (system (conc "cd "areapath" ; nbfake " cmdln)) (unsetenv "NBFAKE_QUIET") (unsetenv "NBFAKE_LOG") ;;(pop-directory) |
︙ | ︙ |