Overview
Comment: | Added -regen-testfiles and added pre/post test triggers. [setup] precmd, postcmd. User responsible for blocking/non-blocking, i.e. use nbfake for non-blocking. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-revolution |
Files: | files | file ages | folders |
SHA1: |
215b2cc63bc0cfae24e7a508dd51382b |
User & Date: | mrwellan on 2023-12-22 14:17:33 |
Other Links: | branch diff | manifest | tags |
Context
2023-12-24
| ||
18:28 | Changed version to 1.8026 check-in: 3a124c1ad8 user: mmgraham tags: v1.80-revolution, v1.8026 | |
2023-12-22
| ||
14:17 | Added -regen-testfiles and added pre/post test triggers. [setup] precmd, postcmd. User responsible for blocking/non-blocking, i.e. use nbfake for non-blocking. check-in: 215b2cc63b user: mrwellan tags: v1.80-revolution | |
13:52 | Made -cleanup-db remove test_steps and tests from deleted runs. check-in: 97e7119428 user: mmgraham tags: v1.80-revolution | |
Changes
Modified launch.scm from [4674140b46] to [94cf158093].
︙ | ︙ | |||
333 334 335 336 337 338 339 340 341 342 343 344 345 346 | (thread-sleep! 6) ;; was 3 (loop (calc-minutes) (or new-cpu-load cpu-load) (or new-disk-free disk-free) (if do-sync (current-seconds) last-sync)))))) (tests:update-central-meta-info run-id test-id (get-cpu-load) (get-df (current-directory))(calc-minutes) #f #f))) ;; NOTE: Checking twice for keep-going is intentional (define (launch:execute encoded-cmd) (let* ((cmdinfo (common:read-encoded-string encoded-cmd)) (tconfigreg #f)) (setenv "MT_CMDINFO" encoded-cmd) ;;(bb-check-path msg: "launch:execute incoming") (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 | (thread-sleep! 6) ;; was 3 (loop (calc-minutes) (or new-cpu-load cpu-load) (or new-disk-free disk-free) (if do-sync (current-seconds) last-sync)))))) (tests:update-central-meta-info run-id test-id (get-cpu-load) (get-df (current-directory))(calc-minutes) #f #f))) ;; NOTE: Checking twice for keep-going is intentional ;; read testconfig and create .logpro and script files ;; - use #f for tconfigreg to re-read the testconfigs from disk ;; (define (launch:extract-scripts-logpro test-dir test-name item-path tconfigreg-in) (let* ((tconfigreg (or tconfigreg-in (tests:get-all))) (tconfig-fname (conc test-dir "/.testconfig")) (tconfig-tmpfile (conc tconfig-fname ".tmp")) (tconfig (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs))) (scripts (configf:get-section tconfig "scripts")) (logpros (configf:get-section tconfig "logpro"))) ;; create .testconfig file (configf:write-alist tconfig tconfig-tmpfile) (file-move tconfig-tmpfile tconfig-fname #t) (delete-file* ".final-status") ;; extract scripts from testconfig and write them to files in test run dir (for-each (lambda (scriptdat) (match scriptdat ((name content) (debug:print-info 2 *default-log-port* "Creating script "(current-directory)"/"name) (with-output-to-file name (lambda () (print content))) (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu))) (else (debug:print-info 0 "Invalid script definiton found in [scripts] section of testconfig. \"" scriptdat "\"")))) scripts) ;; extract logpro from testconfig and write them to files in test run dir (for-each (lambda (logprodat) (match logprodat ((name content) (debug:print-info 2 *default-log-port* "Creating logpro file "(current-directory)"/"name) (with-output-to-file name (lambda () (print content) ;; (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu)) ))) (else (debug:print-info 0 "Invalid logpro definiton found in [logpro] section of testconfig. \"" logprodat "\"")))) logpros))) (define (launch:execute encoded-cmd) (let* ((cmdinfo (common:read-encoded-string encoded-cmd)) (tconfigreg #f)) (setenv "MT_CMDINFO" encoded-cmd) ;;(bb-check-path msg: "launch:execute incoming") (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) |
︙ | ︙ | |||
608 609 610 611 612 613 614 | (if (string-search tmppath " ") (debug:print 0 *default-log-port* "WARNING: spaces in PATH are not supported.")) (if mt-bindir-path (setenv "PATH" (conc tmppath":"mt-bindir-path)))) ;;(bb-check-path msg: "launch:execute post block 4") ;; (change-directory top-path) ;; Can setup as client for server mode now ;; (client:setup) | | < | 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 | (if (string-search tmppath " ") (debug:print 0 *default-log-port* "WARNING: spaces in PATH are not supported.")) (if mt-bindir-path (setenv "PATH" (conc tmppath":"mt-bindir-path)))) ;;(bb-check-path msg: "launch:execute post block 4") ;; (change-directory top-path) ;; Can setup as client for server mode now ;; (client:setup) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) ;;(bb-check-path msg: "launch:execute post block 41") (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;;(bb-check-path msg: "launch:execute post block 42") (set-item-env-vars itemdat) ;;(bb-check-path msg: "launch:execute post block 43") |
︙ | ︙ | |||
639 640 641 642 643 644 645 646 | (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (common:file-exists? fullrunscript) (not (file-execute-access? fullrunscript))) (system (conc "chmod ug+x " fullrunscript)))) | > | | | | | | | | | > | | | | | | | | | | | | | | | | | | > > > > | 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 | (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (common:file-exists? fullrunscript) (not (file-execute-access? fullrunscript))) (system (conc "chmod ug+x " fullrunscript)))) (launch:extract-scripts-logpro work-area test-name item-path tconfigreg) ;;;;; ;; We are about to actually kick off the test ;;;;; ;; so this is a good place to remove the records for ;;;;; ;; any previous runs ;;;;; ;; (db:test-remove-steps db run-id testname itemdat) ;;;;; ;; now is also a good time to write the .testconfig file ;;;;; (let* ((tconfig-fname (conc work-area "/.testconfig")) ;;;;; (tconfig-tmpfile (conc tconfig-fname ".tmp")) ;;;;; (tconfig (tests:get-testconfig test-name item-path tconfigreg #t force-create: #t)) ;; 'return-procs))) ;;;;; (scripts (configf:get-section tconfig "scripts")) ;;;;; (precmd (configf:lookup tconfig ) ;;;;; ;; create .testconfig file ;;;;; (configf:write-alist tconfig tconfig-tmpfile) ;;;;; (file-move tconfig-tmpfile tconfig-fname #t) ;;;;; (delete-file* ".final-status") ;;;;; ;;;;; ;; extract scripts from testconfig and write them to files in test run dir ;;;;; (for-each ;;;;; (lambda (scriptdat) ;;;;; (match scriptdat ;;;;; ((name content) ;;;;; (with-output-to-file name ;;;;; (lambda () ;;;;; (print content) ;;;;; (change-file-mode name (bitwise-ior perm/irwxg perm/irwxu))))) ;;;;; (else ;;;;; (debug:print-info 0 "Invalid script definiton found in [scripts] section of testconfig. \"" scriptdat "\"")))) ;;;;; scripts)) ;; (let* ((m (make-mutex)) (kill-job? #f) (exit-info (make-launch:einf pid: #t exit-status: #t exit-code: #t rollup-status: 0)) ;; pid exit-status exit-code (i.e. process was successfully run) rollup-status (job-thread #f) ;; (keep-going #t) (misc-flags (let ((ht (make-hash-table))) (hash-table-set! ht 'keep-going #t) ht)) (runit (lambda () (launch:manage-steps run-id test-id item-path fullrunscript ezsteps subrun test-name tconfigreg exit-info m))) (monitorjob (lambda () (launch:monitor-job run-id test-id item-path fullrunscript ezsteps test-name tconfigreg exit-info m work-area runtlim misc-flags))) (th1 (make-thread monitorjob "monitor job")) (th2 (make-thread runit "run job")) (tconfig (tests:get-testconfig test-name item-path tconfigreg #t)) (propagate-exit-code (configf:lookup *configdat* "setup" "propagate-exit-code")) (propagate-status-list '("FAIL" "KILLED" "ABORT" "DEAD" "CHECK" "SKIP" "WAIVED")) (test-status "not set") (precmd (configf:lookup tconfig "setup" "precmd")) (postcmd (configf:lookup tconfig "setup" "postcmd"))) ;; first, if set, run the precmd (if precmd ;; (file-exists? precmd)(file-execute-access? precmd)) (system precmd)) ;; up to test author to put nbfake if desired. (set! job-thread th2) (thread-start! th1) (thread-start! th2) (thread-join! th2) (debug:print-info 0 *default-log-port* "Megatest execute of test " test-name ", item path " item-path " complete. Notifying the db ...") (debug:print-info 2 *default-log-port* "exit-info = " exit-info) (hash-table-set! misc-flags 'keep-going #f) |
︙ | ︙ | |||
754 755 756 757 758 759 760 761 762 763 764 765 766 767 | work-area ":\n====\n exit code " (launch:einf-exit-code exit-info) "\n" "====\n") (set! test-status (db:test-get-status (rmt:get-testinfo-state-status run-id test-id))) ;; If the propagate-exit-code option has been set in the megatest config, and the test status matches the list, set the exit code to 1. (if (and propagate-exit-code (string=? propagate-exit-code "yes") (member test-status propagate-status-list)) (begin (debug:print 1 *default-log-port* "Setting exit status to 1 because of test status of " test-status) (set! *globalexitstatus* 1) ) ) | > > > | 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 | work-area ":\n====\n exit code " (launch:einf-exit-code exit-info) "\n" "====\n") (set! test-status (db:test-get-status (rmt:get-testinfo-state-status run-id test-id))) ;; If the propagate-exit-code option has been set in the megatest config, and the test status matches the list, set the exit code to 1. (if postcmd (system postcmd)) (if (and propagate-exit-code (string=? propagate-exit-code "yes") (member test-status propagate-status-list)) (begin (debug:print 1 *default-log-port* "Setting exit status to 1 because of test status of " test-status) (set! *globalexitstatus* 1) ) ) |
︙ | ︙ |
Modified megatest.scm from [865b3a3469] to [7048d9a8e4].
︙ | ︙ | |||
255 256 257 258 259 260 261 | -mark-incompletes : find and mark incomplete tests -ping run-id|host:port : ping server, exit with 0 if found -debug N|N,M,O... : enable debug 0-N or N and M and O ... -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG -config fname : override the megatest.config file with fname -append-config fname : append fname to the megatest.config file -import-sexpr fname : import a sexpr file (use -list-runs % -dumpmode sexpr to create) | > | | 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | -mark-incompletes : find and mark incomplete tests -ping run-id|host:port : ping server, exit with 0 if found -debug N|N,M,O... : enable debug 0-N or N and M and O ... -debug-noprop N|M,M,O...: enable debug but do not propagate to subprocesses via MT_DEBUG -config fname : override the megatest.config file with fname -append-config fname : append fname to the megatest.config file -import-sexpr fname : import a sexpr file (use -list-runs % -dumpmode sexpr to create) -regen-testfiles : regenerate scripts and logpro files from testconfig, run in test context Utilities -env2file fname : write the environment to fname.csh and fname.sh -envcap a : save current variables labeled as context 'a' in file envdat.db -envdelta a-b : output enviroment delta from context a to context b to -o fname set the output mode with -dumpmode csh, bash or ini note: ini format will use calls to use curr and minimize path -refdb2dat refdb : convert refdb to sexp or to format specified by s-dumpmode |
︙ | ︙ | |||
464 465 466 467 468 469 470 471 472 473 474 475 476 477 | "-run-wait" ;; wait on a run to complete (i.e. no RUNNING) "-one-pass" ;; "-local" ;; run some commands using local db access "-generate-html" "-generate-html-structure" "-list-run-time" "-list-test-time" ;; misc queries "-list-disks" "-list-targets" "-list-db-targets" "-show-runconfig" "-show-config" | > | 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 | "-run-wait" ;; wait on a run to complete (i.e. no RUNNING) "-one-pass" ;; "-local" ;; run some commands using local db access "-generate-html" "-generate-html-structure" "-list-run-time" "-list-test-time" "-regen-testfiles" ;; misc queries "-list-disks" "-list-targets" "-list-db-targets" "-show-runconfig" "-show-config" |
︙ | ︙ | |||
2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 | (let* ((db #f) ;; DO NOT run remote (paths (tests:test-get-paths-matching keys target (args:get-arg "-test-files")))) (for-each (lambda (path) (print path)) paths)))))) ;;====================================================================== ;; Archive tests ;;====================================================================== ;; Archive tests matching target, runname, and testpatt (if (equal? (args:get-arg "-archive") "replicate-db") (begin ;; check if source | > > > > > > > > > > > > > > > | 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137 2138 2139 2140 2141 2142 2143 2144 2145 2146 2147 2148 | (let* ((db #f) ;; DO NOT run remote (paths (tests:test-get-paths-matching keys target (args:get-arg "-test-files")))) (for-each (lambda (path) (print path)) paths)))))) ;;====================================================================== ;; Utils for test areas ;;====================================================================== (if (args:get-arg "-regen-testfiles") (if (getenv "MT_TEST_RUN_DIR") (begin (launch:setup) (change-directory (getenv "MT_TEST_RUN_DIR")) (let* ((testname (getenv "MT_TEST_NAME")) (itempath (getenv "MT_ITEMPATH"))) (launch:extract-scripts-logpro (getenv "MT_TEST_RUN_DIR") testname itempath #f)) (set! *didsomething* #t)) (debug:print 0 *default-log-port* "ERROR: Must run -regen-testfiles in a test environment (i.e. test xterm from dashboard)"))) ;;====================================================================== ;; Archive tests ;;====================================================================== ;; Archive tests matching target, runname, and testpatt (if (equal? (args:get-arg "-archive") "replicate-db") (begin ;; check if source |
︙ | ︙ |