Overview
Comment: | Merged v1.55 into v1.60 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
ddc50147d111b3e7afefb4f41551005b |
User & Date: | mrwellan on 2014-06-02 14:17:33 |
Other Links: | branch diff | manifest | tags |
Context
2014-06-03
| ||
09:41 | Nearly all working with v1.55 changes merged into v1.60 check-in: 8d341c3b0e user: mrwellan tags: v1.60 | |
2014-06-02
| ||
14:17 | Merged v1.55 into v1.60 check-in: ddc50147d1 user: mrwellan tags: v1.60 | |
14:06 | Merged 1b2b into v1.60 from v1.55 check-in: 4d7843e5cb user: mrwellan tags: v1.60 | |
09:56 | Added -preclean to all calls in Makefile check-in: fa535bcd4c user: mrwellan tags: v1.55 | |
Changes
Modified dashboard-tests.scm from [fa1c3517a4] to [b6cc0a25fc].
︙ | |||
30 31 32 33 34 35 36 37 38 39 40 41 42 43 | 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | + + + + + + + + + + + + + | (declare (uses ezsteps)) ;; (declare (uses sdb)) ;; (declare (uses filedb)) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") ;;====================================================================== ;; C O M M O N ;;====================================================================== (define (dtests:get-pre-command #!key (default-override #f)) (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "pre-command"))) (or cfg-ovrd default-override "xterm -geometry 180x20 -e \""))) (define (dtests:get-post-command #!key (default-override #f)) (let ((cfg-ovrd (configf:lookup *configdat* "dashboard" "post-command"))) (or cfg-ovrd default-override ";echo Press any key to continue;bash -c 'read -n 1 -s'\" &"))) (define (test-info-panel testdat store-label widgets) (iup:frame #:title "Test Info" ; #:expand "YES" (iup:hbox ; #:expand "YES" (apply iup:vbox ; #:expand "YES" (append (map (lambda (val) |
︙ | |||
607 608 609 610 611 612 613 | 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 | - - + + + + + + - + - - + - + - + - + - + - - + - + - + - + | (iup:attribute-set! lbl "TITLE" newval) ;(mutex-unlock! mx1) ))))) lbl)) (store-button store-label) (command-text-box (iup:textbox #:expand "HORIZONTAL" #:font "Courier New, -10")) (command-launch-button (iup:button "Execute!" #:action (lambda (x) |
︙ |
Modified dashboard.scm from [318cb50829] to [741f8f5a94].
︙ | |||
1452 1453 1454 1455 1456 1457 1458 | 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 | + - + + | (define (dashboard:get-youngest-run-db-mod-time) (apply max (map (lambda (filen) (file-modification-time filen)) (glob (conc *dbdir* "/*.db"))))) (define (dashboard:run-update x) (let* ((modtime (dashboard:get-youngest-run-db-mod-time)) ;; (file-modification-time *db-file-path*)) (monitor-modtime (if (file-exists? *monitor-db-path*) |
︙ |
Modified db.scm from [011e6c6c39] to [b421549a4a].
︙ | |||
672 673 674 675 676 677 678 | 672 673 674 675 676 677 678 679 680 681 682 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 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 | - + + + - - + + + + + + + + - - + + + - + - + + + + + - - + + - + + + + + + + + + + + - - - - - - - - + + + + + + + + + + + + + + + + + | ;;====================================================================== ;; select end_time-now from ;; (select testname,item_path,event_time+run_duration as ;; end_time,strftime('%s','now') as now from tests where state in ;; ('RUNNING','REMOTEHOSTSTART','LAUNCED')); |
︙ | |||
1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 | 1506 1507 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 | + + - + - + | ;; (define (db:get-count-tests-running dbstruct run-id) (let ((res 0)) (sqlite3:for-each-row (lambda (count) (set! res count)) (db:get-db dbstruct run-id) ;; WARNING BUG EDIT ME - merged from v1.55 - not sure what is right here ... ;; "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id NOT IN (SELECT id FROM runs WHERE state='deleted') AND NOT (uname = 'n/a' AND item_path = '');") "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" run-id) ;; NOT IN (SELECT id FROM runs WHERE state='deleted');") res)) ;; NEW BEHAVIOR: Look only at single run with run-id ;; ;; (define (db:get-running-stats dbstruct run-id) (define (db:get-count-tests-running-for-run-id dbstruct run-id) (let ((res 0)) (sqlite3:for-each-row (lambda (count) |
︙ | |||
1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 | 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 | + + + | (sqlite3:for-each-row (lambda (count) (set! res count)) (db:get-db dbstruct run-id) (conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('" (string-intersperse testnames "','") "');"))) ;; DEBUG FIXME - need to merge this v.155 query correctly ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?) ;; AND NOT (uname = 'n/a' AND item_path = '');" res))) ;; done with run when: ;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING (define (db:estimated-tests-remaining dbstruct run-id) (let ((res 0)) (sqlite3:for-each-row |
︙ | |||
1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 | 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 1835 1836 1837 1838 | + + + + + + + + + + + | (tstsqry (conc "SELECT rundir FROM tests WHERE " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;"))) (sqlite3:for-each-row (lambda (p) (set! res (cons p res))) (db:get-db dbstruct run-id) tstsqry) res)) (define (db:test-toplevel-num-items db run-id testname) (let ((res 0)) (sqlite3:for-each-row (lambda (num-items) (set! res num-items)) db "SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND state NOT IN ('DELETED');" run-id testname) res)) ;;====================================================================== ;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS ;;====================================================================== ;; NOTE: Can remove the regex and base64 encoding for zmq (define (db:obj->string obj) |
︙ | |||
2035 2036 2037 2038 2039 2040 2041 | 2083 2084 2085 2086 2087 2088 2089 2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2113 2114 2115 2116 2117 2118 2119 2120 2121 | - + + + + - + - + - + - + - + - + | ;; (thread-sleep! sleep-time) ;; (debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up") ;; (proc (- remtries 1))))) ;; (apply sqlite3:execute db query params)) ;; (debug:print 0 "ERROR: too many attempts to access db were made and no sucess. query: " ;; query ", params: " params)))) ;; (proc remtries)) |
︙ |
Modified db_records.scm from [7476711f37] to [828e5a591d].
︙ | |||
90 91 92 93 94 95 96 97 98 99 100 101 102 103 | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | + + + + + + + + | (define-inline (db:test-set-diskfree! vec val)(vector-set! vec 8 val)) (define-inline (db:test-set-testname! vec val)(vector-set! vec 2 val)) (define-inline (db:test-set-state! vec val)(vector-set! vec 3 val)) (define-inline (db:test-set-status! vec val)(vector-set! vec 4 val)) (define-inline (db:test-set-run_duration! vec val)(vector-set! vec 12 val)) (define-inline (db:test-set-final_logf! vec val)(vector-set! vec 13 val)) ;; Test record utility functions ;; Is a test a toplevel? ;; (define (db:test-get-is-toplevel vec) (and (equal? (db:test-get-item-path vec) "") ;; test is not an item (equal? (db:test-get-uname vec) "n/a"))) ;; test has never been run ;; make-vector-record "" db mintest id run_id testname state status event_time item_path ;; (define (make-db:mintest)(make-vector 7)) (define-inline (db:mintest-get-id vec) (vector-ref vec 0)) (define-inline (db:mintest-get-run_id vec) (vector-ref vec 1)) (define-inline (db:mintest-get-testname vec) (vector-ref vec 2)) (define-inline (db:mintest-get-state vec) (vector-ref vec 3)) |
︙ |
Modified launch.scm from [e833897f83] to [f158af2890].
︙ | |||
687 688 689 690 691 692 693 | 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 | + - + - + + + + | (exe (pathname-strip-directory lm))) (conc (if dir (conc dir "/") "") (case (string->symbol exe) ((dboard) "../megatest") ((mtest) "../megatest") ((dashboard) "megatest") (else exe))))) (item-path (item-list->path itemdat)) |
︙ |
Modified megatest.scm from [cad76d323f] to [545aadfca9].
︙ | |||
68 69 70 71 72 73 74 75 76 77 78 79 80 81 | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | + | -set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs -rerun FAIL,WARN... : force re-run for tests with specificed status(s) -lock : lock run specified by target and runname -unlock : unlock run specified by target and runname -set-run-status status : sets status for run to status, requires -target and -runname -get-run-status : gets status for run specified by target and runname -run-wait : wait on run specified by target and runname -preclean : remove the existing test directory before running the test Selectors (e.g. use for -runtests, -remove-runs, -set-state-status, -list-runs etc.) -target key1/key2/... : run for key1, key2, etc. -reqtarg key1/key2/... : run for key1, key2, etc. but key1/key2 must be in runconfig -testpatt patt1/patt2,patt3/... : % is wildcard -runname : required, name for this particular test run -state : Applies to runs, tests or steps depending on context |
︙ | |||
230 231 232 233 234 235 236 237 238 239 240 241 242 243 | 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 | + | "-show-keys" "-test-status" "-set-values" "-load-test-data" "-summarize-items" "-gui" "-daemonize" "-preclean" ;; misc "-archive" "-repl" "-lock" "-unlock" "-list-servers" "-run-wait" ;; wait on a run to complete (i.e. no RUNNING) |
︙ | |||
1191 1192 1193 1194 1195 1196 1197 | 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 | - - - - - - - - - - - - - | (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (open-run-close db:find-and-mark-incomplete #f) (set! *didsomething* #t))) |
︙ | |||
1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 | 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 | + + + + + + + + + + + + + | (current-input-port (make-gnu-readline-port "megatest> ")) (if (args:get-arg "-repl") (repl) (load (args:get-arg "-load"))) (db:close-all dbstruct)) (exit)) (set! *didsomething* #t))) ;;====================================================================== ;; Wait on a run to complete ;;====================================================================== (if (args:get-arg "-run-wait") (begin (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (operate-on 'run-wait) (set! *didsomething* #t))) ;; Not converted to use dbstruct yet ;; (if (args:get-arg "-convert-to-norm") (let* ((toppath (setup-for-run)) (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t)))) (for-each |
︙ |
Modified runs.scm from [b67c39dcab] to [e111ea3adb].
︙ | |||
851 852 853 854 855 856 857 | 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 | - + + - - - - + + + + | (num-retries 0) (max-retries (config-lookup *configdat* "setup" "maxretries")) (max-concurrent-jobs (let ((mcj (config-lookup *configdat* "setup" "max_concurrent_jobs"))) (if (and mcj (string->number mcj)) (string->number mcj) 1))) ;; length of the register queue ahead (reglen (if (number? reglen-in) reglen-in 1)) |
︙ | |||
1302 1303 1304 1305 1306 1307 1308 | 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 | - + | ;; fields are passing in through ;; action: ;; 'remove-runs ;; 'set-state-status ;; ;; NB// should pass in keys? ;; |
︙ | |||
1373 1374 1375 1376 1377 1378 1379 | 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 | - - - - + + + + + + + + - - - - - - - - - - - - - + + + + + + + + + + + + + - - + + - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - - - - - + + | (if (not (null? tal)) (loop (car tal)(cdr tal)))) (let* ((item-path (db:test-get-item-path new-test-dat)) (test-name (db:test-get-testname new-test-dat)) (run-dir ;;(filedb:get-path *fdb* ;; (rmt:sdb-qry 'getid (db:test-get-rundir new-test-dat)) ;; ) ;; run dir is from the link tree |
︙ | |||
1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 | 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) ))))) )) runs)) #t) (define (runs:remove-test-directory db test remove-data-only) (let* ((run-dir (db:test-get-rundir test)) ;; run dir is from the link tree (real-dir (if (file-exists? run-dir) (resolve-pathname run-dir) #f))) (if (not remove-data-only) (mt:test-set-state-status-by-id (db:test-get-id test) "REMOVING" "LOCKED" #f)) (debug:print-info 1 "Attempting to remove " (if real-dir (conc " dir " real-dir " and ") "") " link " run-dir) (if (and real-dir (> (string-length real-dir) 5) (file-exists? real-dir)) ;; bad heuristic but should prevent /tmp /home etc. (begin ;; let* ((realpath (resolve-pathname run-dir))) (debug:print-info 1 "Recursively removing " real-dir) (if (file-exists? real-dir) (runs:safe-delete-test-dir real-dir) (debug:print 0 "WARNING: test dir " real-dir " appears to not exist or is not readable"))) (if real-dir (debug:print 0 "WARNING: directory " real-dir " does not exist") (debug:print 0 "WARNING: no real directory corrosponding to link " run-dir ", nothing done"))) (if (symbolic-link? run-dir) (begin (debug:print-info 1 "Removing symlink " run-dir) (handle-exceptions exn (debug:print 0 "ERROR: Failed to remove symlink " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue") (delete-file run-dir))) (if (directory? run-dir) (if (> (directory-fold (lambda (f x)(+ 1 x)) 0 run-dir) 0) (debug:print 0 "WARNING: refusing to remove " run-dir " as it is not empty") (handle-exceptions exn (debug:print 0 "ERROR: Failed to remove directory " run-dir ((condition-property-accessor 'exn 'message) exn) ", attempting to continue") (delete-directory run-dir))) (if run-dir (debug:print 0 "WARNING: not removing " run-dir " as it either doesn't exist or is not a symlink") (debug:print 0 "NOTE: the run dir for this test is undefined. Test may have already been deleted.")) )) ;; Only delete the records *after* removing the directory. If things fail we have a record (if (not remove-data-only) (cdb:remote-run db:delete-test-records db #f (db:test-get-id test))))) ;;====================================================================== ;; Routines for manipulating runs ;;====================================================================== ;; 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) |
︙ |
Modified tasks.scm from [633ea6eb75] to [a24fc80b64].
︙ | |||
23 24 25 26 27 28 29 | 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | + - + + | ;;====================================================================== (define (tasks:open-db) (let* ((linktree (configf:lookup *configdat* "setup" "linktree")) (dbpath (conc linktree "/.db/monitor.db")) (exists (file-exists? dbpath)) (write-access (file-write-access? dbpath)) (mdb (if (file-write-access? *toppath*) |
︙ |
Modified tests/Makefile from [467993636c] to [e2f7a8e3c3].
︙ | |||
36 37 38 39 40 41 42 | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 | - - - - + + + + - + - + - + - + - - - - - - + + + + + + - - + + - + - + - + - + - - - + + + - + - + - + - + - + - + - + | test0 : cleanprep cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG) test1 : cleanprep test2 : fullprep |
︙ |
Modified tests/fullrun/megatest.config from [2df07d7e2d] to [2791752641].
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | + + + + | [fields] sysname TEXT fsname TEXT datapath TEXT # refareas can be searched to find previous runs # the path points to where megatest.db exists [refareas] area1 /tmp/oldarea/megatest [include config/mt_include_1.config] [dashboard] pre-command xterm -geometry 180x20 -e " post-command |& tee results.log ;echo Press any key to continue;bash -c 'read -n 1 -s'" & [misc] home #{shell readlink -f $MT_RUN_AREA_HOME} parent #{shell readlink -f $MT_RUN_AREA_HOME/..} [tests-paths] 1 #{get misc parent}/simplerun/tests |
︙ |