Changes In Branch servermode Through [da3de938e3] Excluding Merge-Ins
This is equivalent to a diff from 29dd546414 to da3de938e3
2012-03-13
| ||
06:59 | Merged servermode to trunk check-in: 3e2cee87de user: matt tags: trunk | |
2012-03-04
| ||
18:06 | rpc typo fix check-in: 3892474ef6 user: matt tags: servermode | |
16:47 | Multiple small fixes made, not ready for prime time .... check-in: da3de938e3 user: matt tags: servermode | |
2012-03-01
| ||
22:49 | Run server mode as part of -run* check-in: b06b51df8d user: matt tags: servermode | |
2012-02-29
| ||
17:56 | minor improvements to server mode check-in: 29dd546414 user: mrwellan tags: trunk | |
2012-02-27
| ||
09:52 | Partial fix for -rerun check-in: 0e00d7e0c2 user: matt tags: trunk | |
Modified common.scm from [5ebf23fbcd] to [4f03816054].
︙ | |||
31 32 33 34 35 36 37 38 39 40 41 42 43 44 | 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 | + | ;; global gletches (define *configinfo* #f) (define *configdat* #f) (define *toppath* #f) (define *already-seen-runconfig-info* #f) (define *waiting-queue* (make-hash-table)) (define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar (define *verbosity* 1) (define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port (define *runremote* #f) ;; if set up for server communication this will hold <host port> (define (get-with-default val default) |
︙ |
Modified dashboard.scm from [56cfd810b6] to [78b39d96f4].
︙ | |||
76 77 78 79 80 81 82 | 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | - + | (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* (open-db)) ;; HACK ALERT: this is a hack, please fix. |
︙ |
Modified db.scm from [72acdb1ad4] to [681d2d74d7].
︙ | |||
36 37 38 39 40 41 42 | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 | - + | (define *incoming-mutex* (make-mutex)) (define *cache-on* #f) (define (open-db) ;; (conc *toppath* "/megatest.db") (car *configinfo*))) (let* ((dbpath (conc *toppath* "/megatest.db")) ;; fname) (dbexists (file-exists? dbpath)) (db (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath)) |
︙ | |||
211 212 213 214 215 216 217 | 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | - + | value REAL, expected REAL, tol REAL, units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', CONSTRAINT test_data UNIQUE (test_id,category,variable));") |
︙ | |||
443 444 445 446 447 448 449 | 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 | + + - + | (sqlite3:for-each-row (lambda (id) (set! ids (cons id ids))) db "SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;" run-id test-name (item-list->path itemdat)) (for-each (lambda (id) (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" id) (thread-sleep! 0.1) ;; give others access to the db (sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" id) |
︙ | |||
548 549 550 551 552 553 554 | 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 | + - - + + + | (define (db:test-set-rundir! db run-id test-name item-path rundir) (sqlite3:execute db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id test-name item-path)) (define (db:test-set-log! db run-id test-name item-path logf) (if (string? logf) |
︙ | |||
804 805 806 807 808 809 810 | 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 | - + - + - + | (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) db "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (reverse res))) (define (db:load-test-data db run-id test-name itemdat) (let* ((item-path (item-list->path itemdat)) |
︙ | |||
1187 1188 1189 1190 1191 1192 1193 | 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 | - + - | run-id test-name item-path comment)) (db:test-set-comment db run-id test-name item-path comment))) (define (rdb:test-set-log! db run-id test-name item-path logf) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) |
︙ | |||
1309 1310 1311 1312 1313 1314 1315 | 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 | + + + + + + + | (define (rdb:delete-test-records db test-id) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rdb:delete-test-records host port) test-id)) (db:delete-test-records db test-id))) (define (rdb:test-data-rollup db test-id status) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rdb:test-data-rollup host port) test-id status)) (db:test-data-rollup db test-id status))) |
Modified launch.scm from [e033088d6b] to [55dfea2e6a].
︙ | |||
42 43 44 45 46 47 48 | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 | - + + | (define (steprun-good? logpro exitcode) (or (eq? exitcode 0) (and logpro (eq? exitcode 2)))) (define (launch:execute encoded-cmd) (let* ((cmdinfo (read (open-input-string (base64:base64-decode encoded-cmd))))) (setenv "MT_CMDINFO" encoded-cmd) |
︙ | |||
296 297 298 299 300 301 302 | 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 | - + | (thread-start! th2) (thread-join! th2) (mutex-lock! m) (set! db (open-db)) (if (not (args:get-arg "-server")) (server:client-setup db)) (let* ((item-path (item-list->path itemdat)) |
︙ | |||
437 438 439 440 441 442 443 | 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 | - + + + - + + | (runscript (config-lookup test-conf "setup" "runscript")) (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big (diskspace (config-lookup test-conf "requirements" "diskspace")) (memory (config-lookup test-conf "requirements" "memory")) (hosts (config-lookup *configdat* "jobtools" "workhosts")) (remote-megatest (config-lookup *configdat* "setup" "executable")) ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to |
︙ | |||
495 496 497 498 499 500 501 | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 | - - + | (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms)))) (else (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section")) (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" ""))))) (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm")))) (debug:print 1 "Launching megatest for test " test-name " in " work-area" ...") (test-set-status! db run-id test-name "LAUNCHED" "n/a" itemdat #f #f) ;; (if launch-results launch-results "FAILED")) |
︙ |
Modified megatest.scm from [91d562ec2a] to [2aae15056c].
1 2 3 4 5 6 7 8 9 10 11 12 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | - + | ;; Copyright 2006-2011, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; (include "common.scm") ;; (include "megatest-version.scm") |
︙ | |||
335 336 337 338 339 340 341 342 | 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 | + - + + | ;; Start the server - can be done in conjunction with -runall or -runtests (one day...) ;;====================================================================== (if (and (args:get-arg "-server") (not (or (args:get-arg "-runall") (args:get-arg "-runtests")))) (let* ((toppath (setup-for-run)) (db (if toppath (open-db) #f))) (debug:print 0 "INFO: Starting the standalone server") (if db |
︙ | |||
453 454 455 456 457 458 459 | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 | - + - + | (exit 1))) (set! db (open-db)) (if (not (args:get-arg "-server")) (server:client-setup db)) (let* ((itempatt (args:get-arg "-itempatt")) (keys (rdb:get-keys db)) (keynames (map key:get-fieldname keys)) |
︙ | |||
612 613 614 615 616 617 618 619 620 | 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 | + - + - + - + | (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (set! db (open-db)) (if (not (args:get-arg "-server")) (server:client-setup db)) (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: (db:load-test-data db run-id test-name itemdat)) (if (args:get-arg "-setlog") |
︙ | |||
662 663 664 665 666 667 668 | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | - + | (oldexitstat exitstat) (cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " "))) (debug:print 2 "INFO: running \"" cmd "\"") (change-directory startingdir) (set! exitstat (system cmd)) (set! *globalexitstatus* exitstat) ;; no necessary (change-directory testpath) |
︙ | |||
692 693 694 695 696 697 698 | 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 | - + | (if (and (args:get-arg "-test-status") (or (not state) (not status))) (begin (debug:print 0 "ERROR: You must specify :state and :status with every call to -test-status\n" help) (sqlite3:finalize! db) (exit 6))) |
︙ |
Modified runs.scm from [25e1315b1d] to [7a34943964].
1 2 3 4 5 6 7 8 9 10 11 12 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | - + | ;; Copyright 2006-2011, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; strftime('%m/%d/%Y %H:%M:%S','now','localtime') |
︙ | |||
390 391 392 393 394 395 396 | 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 | + + + + - + | (debug:print 2 "Attempting to launch test " test-name "/" item-path) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory *toppath*) ;; Here is where the test_meta table is best updated ;; Yes, another use of a global for caching. Need a better way? (if (not (hash-table-ref/default *test-meta-updated* test-name #f)) (begin (hash-table-set! *test-meta-updated* test-name #t) |
︙ | |||
447 448 449 450 451 452 453 | 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 | - + + | (member (test:get-status testdat) '("FAIL" "n/a"))) (set! runflag #t)) (else (set! runflag #f))) (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"" (test:get-state testdat) |
︙ | |||
569 570 571 572 573 574 575 | 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 | - + + - - + + + + + | ;; Since many calls to a run require pretty much the same setup ;; this wrapper is used to reduce the replication of code (define (general-run-call switchname action-desc proc) (let ((runname (args:get-arg ":runname")) (target (if (args:get-arg "-target") (args:get-arg "-target") |
︙ | |||
609 610 611 612 613 614 615 616 617 618 619 620 621 622 | 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 | + | (debug:print 0 "ERROR: Attempted to " action-desc " but run area config file not found") (exit 1)) ;; Extract out stuff needed in most or many calls ;; here then call proc (let* ((keynames (map key:get-fieldname keys)) (keyvallst (keys->vallist keys #t))) (proc db target runname keys keynames keyvallst))) (if th1 (thread-join! th1)) (sqlite3:finalize! db) (set! *didsomething* #t)))))) ;;====================================================================== ;; Rollup runs ;;====================================================================== |
︙ |
Modified server.scm from [5c480362d7] to [626dc3a431].
︙ | |||
80 81 82 83 84 85 86 | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | - + | 'rdb:test-set-state-status-by-run-id-testname (lambda (run-id test-name item-path status state) (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state))) (rpc:publish-procedure! 'rdb:csv->test-data (lambda (test-id csvdata) |
︙ | |||
196 197 198 199 200 201 202 203 204 205 206 207 208 | 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 | + + + + + + + + + + + + + + + + + - + | (db:delete-test-records db test-id))) (rpc:publish-procedure! 'rtests:register-test (lambda (run-id test-name item-path) (tests:register-test db run-id test-name item-path))) (rpc:publish-procedure! 'rdb:test-data-rollup (lambda (test-id status) (db:test-data-rollup db test-id status))) (rpc:publish-procedure! 'rtests:test-set-status! (lambda (run-id test-name state status itemdat-or-path comment dat) (test-set-status! db run-id test-name state status itemdat-or-path comment dat))) ;;====================================================================== ;; end of publish-procedure section ;;====================================================================== (set! *rpc:listener* rpc:listener) (on-exit (lambda () (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port) (sqlite3:finalize! db))) (thread-start! th1) (thread-start! th2) ;; (thread-join! th2) ;; return th2 for the calling process to do a join with th2 |
︙ |
Modified tests.scm from [536da07661] to [bd1dcbf11c].
︙ | |||
385 386 387 388 389 390 391 | 385 386 387 388 389 390 391 392 393 394 395 396 397 398 | + + + + + + + | (define (rtests:register-test db run-id test-name item-path) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rtests:register-test host port) run-id test-name item-path)) (tests:register-test db run-id test-name item-path))) (define (rtests:test-set-status! db run-id test-name state status itemdat-or-path comment dat) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rtests:test-set-status! host port) run-id test-name state status itemdat-or-path comment dat)) (test-set-status! db run-id test-name state status itemdat-or-path comment dat))) |
Modified tests/Makefile from [393100f5ee] to [b314894f18].
1 2 3 4 5 6 7 8 9 10 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | - + | # run some tests BINPATH=$(shell realpath ../bin) MEGATEST=$(BINPATH)/megatest PATH := $(BINPATH):$(PATH) runall : cd ../;make install mkdir -p /tmp/mt_runs /tmp/mt_links $(BINPATH)/dboard -rows 15 & |
︙ |
Modified tests/megatest.config from [729204831f] to [75d2bf7273].
1 2 3 4 5 6 7 8 9 10 11 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | - + | [fields] sysname TEXT fsname TEXT datapath TEXT [setup] # exectutable /path/to/megatest max_concurrent_jobs 200 linktree /tmp/mt_links [jobtools] |
︙ |
Modified utils/mt_ezstep from [e004bfd05c] to [dc6e288c61].
︙ | |||
25 26 27 28 29 30 31 | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 | + + + - + + - + | source $prev_env fi # source the environment from the previous step if it exists # if a logpro file exists then use it otherwise just run the command, nb// was using 2>&1 if [ -e ${stepname}.logpro ];then # could do: $command 2>&1| tee ${stepname}.log | logpro ${stepname}.logpro ${stepname}.html &> /dev/null logprostatus=$? |
︙ |