Comment: | Merged recent changes from v1.55 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.60 |
Files: | files | file ages | folders |
SHA1: |
c2c7cdb91e7fcc9aee7cbb567f07af37 |
User & Date: | matt on 2014-07-15 00:06:15 |
Other Links: | branch diff | manifest | tags |
2014-07-22
| ||
22:00 | Merged recent changes from v1.55 and fixed few related bugs check-in: a7e3370085 user: matt tags: v1.60 | |
2014-07-15
| ||
00:06 | Merged recent changes from v1.55 check-in: c2c7cdb91e user: matt tags: v1.60 | |
2014-07-14
| ||
23:05 | Added more status variations for NOT_STARTED and bumped version. Also added visibility of statuses on dashboard check-in: 85a669be50 user: matt tags: v1.55 | |
2014-06-26
| ||
15:27 | Evaluate strings before storing in environment in launch:execute check-in: 761dba431d user: mrwellan tags: v1.60 | |
Modified common.scm from [405f0df78e] to [e3f681efc8].
︙ | |||
242 243 244 245 246 247 248 | 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | - + | ;;====================================================================== (define (common:args-get-target #!key (split #f)) (let* ((target (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") |
︙ |
Modified configf.scm from [5e1016adfd] to [81365b22b7].
︙ | |||
109 110 111 112 113 114 115 | 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | - + | (with-output-to-port (current-error-port) (lambda () (print "ERROR: " cmd " returned bad exit code " status))) "")))) ;; Lookup a value in runconfigs based on -reqtarg or -target (define (runconfigs-get config var) |
︙ |
Modified dashboard-tests.scm from [b6cc0a25fc] to [ce4cdb7172].
︙ | |||
658 659 660 661 662 663 664 | 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 | - + + + | "%" item-path)) ";megatest -target " keystring " -runname " runname " -runtests " (conc testname "/" (if (equal? item-path "") "%" item-path)) ))) |
︙ |
Modified dashboard.scm from [741f8f5a94] to [d5cde3a2ed].
︙ | |||
79 80 81 82 83 84 85 | 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 | - + | 0)) (if (args:get-arg "-h") (begin (print help) (exit))) |
︙ | |||
135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 | + + + + + + + + + + + + + - | (define *tests-sort-options* (vector (vector "Sort +a" 'testname "ASC") (vector "Sort -a" 'testname "DESC") (vector "Sort +t" 'event_time "ASC") (vector "Sort -t" 'event_time "DESC") (vector "Sort +s" 'statestatus "ASC") (vector "Sort -s" 'statestatus "DESC"))) (define *tests-sort-type-index* '(("+testname" 0) ("-testname" 1) ("+event_time" 2) ("-event_time" 3) ("+statestatus" 4) ("-statestatus" 5))) ;; Don't forget to adjust the >= below if you add to the sort-options above (define (next-sort-option) (if (>= *tests-sort-reverse* 5) (set! *tests-sort-reverse* 0) (set! *tests-sort-reverse* (+ *tests-sort-reverse* 1))) *tests-sort-reverse*) (define *tests-sort-reverse* (let ((t-sort (assoc (configf:lookup *configdat* "dashboard" "testsort") *tests-sort-type-index*))) (if t-sort (cadr t-sort) 3))) (define (get-curr-sort) (vector-ref *tests-sort-options* *tests-sort-reverse*)) |
︙ | |||
460 461 462 463 464 465 466 | 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 | + - + + + + + + | (testname (db:test-get-testname test)) (itempath (db:test-get-item-path test)) (testfullname (test:test-get-fullname test)) (teststatus (db:test-get-status test)) (teststate (db:test-get-state test)) ;;(teststart (db:test-get-event_time test)) (runtime (db:test-get-run_duration test)) (buttontxt (cond |
︙ | |||
679 680 681 682 683 684 685 | 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 | - - - + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + - - - - | (begin (hash-table-set! tests-draw-state 'first-time #f) (hash-table-set! tests-draw-state 'scalef 8) (hash-table-set! tests-draw-state 'tests-info (make-hash-table)) (hash-table-set! tests-draw-state 'selected-tests (make-hash-table)) ;; set these (hash-table-set! tests-draw-state 'test-browse-xoffset 20) ;; (- 0 (* (/ sizex 2) (* 8 xadj)))) |
︙ | |||
802 803 804 805 806 807 808 | 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 | - + | (default-cmd (car cmds-list))) (iuplistbox-fill-list lb cmds-list selected-item: default-cmd) (dboard:data-set-command! *data* default-cmd) lb))) (iup:frame #:title "Runname" |
︙ | |||
884 885 886 887 888 889 890 | 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 | + - - - - - - - + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + | (dashboard:update-run-command)))))))) (iup:frame #:title "Tests and Tasks" (let* ((updater #f) (last-xadj 0) (last-yadj 0) (the-cnv #f) |
︙ | |||
1211 1212 1213 1214 1215 1216 1217 | 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 | + + + + + + + + + + + - - - - + + + + | ;;(iup:textbox #:size "60x15" #:fontsize "10" #:value "%" ;; #:action (lambda (obj unk val) ;; (mark-for-update) ;; (update-search "item-name" val)) )) (iup:vbox (iup:hbox (let* ((cmds-list '("+testname" "-testname" "+event_time" "-event_time" "+statestatus" "-statestatus")) (lb (iup:listbox #:expand "HORIZONTAL" #:dropdown "YES" #:action (lambda (obj val index lbstate) (set! *tests-sort-reverse* index) (mark-for-update)))) (default-cmd (car (list-ref *tests-sort-type-index* *tests-sort-reverse*)))) (iuplistbox-fill-list lb cmds-list selected-item: default-cmd) (mark-for-update) ;; (set! *tests-sort-reverse* *tests-sort-reverse*0) lb) |
︙ | |||
1427 1428 1429 1430 1431 1432 1433 | 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 | - + | ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... ;; (define *last-db-update-time* (file-modification-time *db-file-path*)) ;; (conc *toppath* "/db/main.db"))) (define *last-recalc-ended-time* 0) (define (dashboard:been-changed) |
︙ | |||
1542 1543 1544 1545 1546 1547 1548 | 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 | + + + + + + + + + + + + + + + + - - + + + + + + | (begin (dashboard:run-update x) (mutex-lock! *update-mutex*) (set! *update-is-running* #f) (mutex-unlock! *update-mutex*)))) 1)))) (let ((th1 (make-thread (lambda () (thread-sleep! 1) (set! *please-update-buttons* #t) (dashboard:run-update 1)) "update buttons once")) ;; need to wait for first *update-is-running* #t ;; (let loop () ;; (mutex-lock! *update-mutex*) ;; (if *update-is-running* ;; (begin ;; (set! *please-update-buttons* #t) ;; (mark-for-update) ;; (print "Did redraw trigger")) "First update after startup") ;; (mutex-unlock! *update-mutex*) ;; (thread-sleep! 1) ;; (if (not *please-update-buttons*) ;; (loop)))))) |
Modified dcommon.scm from [6ced1731f9] to [233e3f255c].
︙ | |||
543 544 545 546 547 548 549 550 | 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 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 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 | + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;; (show message-window ;; #:modal? #t ;; ;; set positon using coordinates or center, start, top, left, end, bottom, right, parent-center, current ;; ;; #:x 'mouse ;; ;; #:y 'mouse ;; ) )))) ;;====================================================================== ;; CANVAS STUFF FOR TESTS ;;====================================================================== (define (dcommon:draw-test cnv x y w h name selected) (let* ((llx x) (lly y) (urx (+ x w)) (ury (+ y h))) (canvas-text! cnv (+ llx 5)(+ lly 5) name) ;; (conc testname " (" xtorig "," ytorig ")")) (canvas-rectangle! cnv llx urx lly ury) (if selected (canvas-box! cnv llx (+ llx 5) lly (+ lly 5))))) (define (dcommon:initial-draw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames) (let* ((scalef (hash-table-ref/default tests-draw-state 'scalef 8)) (test-browse-xoffset (hash-table-ref tests-draw-state 'test-browse-xoffset)) (test-browse-yoffset (hash-table-ref tests-draw-state 'test-browse-yoffset)) (xtorig (+ test-browse-xoffset (* (/ sizex 2) scalef (- 0.5 xadj)))) ;; (- xadj 1)))) (ytorig (+ test-browse-yoffset (* (/ sizey 2) scalef (- yadj 0.5)))) (boxw 90) ;; default, overriden by length estimate below (boxh 25) (gapx 20) (gapy 30) (tests-hash (hash-table-ref tests-draw-state 'tests-info)) (selected-tests (hash-table-ref tests-draw-state 'selected-tests ))) (hash-table-set! tests-draw-state 'xtorig xtorig) (hash-table-set! tests-draw-state 'ytorig ytorig) (let ((longest-str (car (sort sorted-testnames (lambda (a b)(>= (string-length a)(string-length b))))))) (let-values (((x-max y-max) (canvas-text-size cnv longest-str))) (if (> x-max boxw)(set! boxw (+ 10 x-max))))) ;; (print "sizex: " sizex " sizey: " sizey " font: " (canvas-font cnv) " originx: " originx " originy: " originy " xtorig: " xtorig " ytorig: " ytorig " xadj: " xadj " yadj: " yadj) (let loop ((hed (car (reverse sorted-testnames))) (tal (cdr (reverse sorted-testnames))) (llx xtorig) (lly ytorig) (urx (+ xtorig boxw)) (ury (+ ytorig boxh))) ; (print "hed " hed " llx " llx " lly " lly " urx " urx " ury " ury) (dcommon:draw-test cnv llx lly boxw boxh hed (hash-table-ref/default selected-tests hed #f)) ;; data used by mouse click calc. keep the wacky order for now. (hash-table-set! tests-hash hed (list llx urx (- sizey ury)(- sizey lly) lly boxw boxh)) ;; (list llx lly boxw boxh)) ;; NB// Swap ury and lly (if (not (null? tal)) ;; leave a column of space to the right to list items (let ((have-room (if #t ;; put "auto" here where some form of auto rearanging can be done (> (* 3 (+ boxw gapx)) (- urx xtorig)) (< urx (- sizex boxw gapx boxw))))) ;; is there room for another column? (loop (car tal) (cdr tal) (if have-room (+ llx boxw gapx) xtorig) ;; have room, (if have-room lly (+ lly boxh gapy)) (if have-room (+ urx boxw gapx) (+ xtorig boxw)) (if have-room ury (+ ury boxh gapy)))))))) (define (dcommon:redraw-tests cnv xadj yadj sizex sizey sizexmm sizeymm originx originy tests-draw-state sorted-testnames) (let* ((scalef (hash-table-ref/default tests-draw-state 'scalef 8)) (test-browse-xoffset (hash-table-ref tests-draw-state 'test-browse-xoffset)) (test-browse-yoffset (hash-table-ref tests-draw-state 'test-browse-yoffset)) (xtorig (+ test-browse-xoffset (* (/ sizex 2) scalef (- 0.5 xadj)))) ;; (- xadj 1)))) (ytorig (+ test-browse-yoffset (* (/ sizey 2) scalef (- yadj 0.5)))) (xdelta (- (hash-table-ref tests-draw-state 'xtorig) xtorig)) (ydelta (- (hash-table-ref tests-draw-state 'ytorig) ytorig)) (tests-hash (hash-table-ref tests-draw-state 'tests-info)) (selected-tests (hash-table-ref tests-draw-state 'selected-tests ))) (hash-table-set! tests-draw-state 'xtorig xtorig) (hash-table-set! tests-draw-state 'ytorig ytorig) (let loop ((hed (car (reverse sorted-testnames))) (tal (cdr (reverse sorted-testnames)))) (let* ((tvals (hash-table-ref tests-hash hed)) (llx (+ xdelta (list-ref tvals 0))) (lly (+ ydelta (list-ref tvals 4))) (boxw (list-ref tvals 5)) (boxh (list-ref tvals 6)) (urx (+ llx boxw)) (ury (+ lly boxh))) (dcommon:draw-test cnv llx lly boxw boxh hed (hash-table-ref/default selected-tests hed #f)) (hash-table-set! tests-hash hed (list llx urx (- sizey ury)(- sizey lly) lly boxw boxh)) (if (not (null? tal)) ;; leave a column of space to the right to list items (loop (car tal) (cdr tal))))))) |
Modified launch.scm from [f158af2890] to [45d25922cf].
︙ | |||
89 90 91 92 93 94 95 96 97 98 99 100 101 102 | 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 | + + + + + + + + + + + + + + + + + + + + + + + + | (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path (rollup-status 0)) (change-directory top-path) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) (set! keys (rmt:get-keys)) ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process ;; one of these is defunct/redundant ... (if (not (launch:setup-for-run force: #t)) (begin (debug:print 0 "Failed to setup, exiting") ;; (sqlite3:finalize! db) ;; (sqlite3:finalize! tdb) (exit 1))) (change-directory *toppath*) (let ((rconfig (full-runconfigs-read))) ;; (read-config (conc *toppath* "/runconfigs.config") #f #t sections: (list "default" target)))) ;; (setup-env-defaults (conc *toppath* "/runconfigs.config") run-id (make-hash-table) keyvals target) ;; (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id)) ;; Now have runconfigs data loaded, set environment vars (for-each (lambda (section) (for-each (lambda (varval) (let ((var (car varval)) (val (cadr varval))) (if (and (string? var)(string? val)) (begin (setenv var (config:eval-string-in-environment val))) ;; val) (debug:print 0 "ERROR: bad variable spec, " var "=" val)))) (configf:get-section rconfig section))) (list "default" target))) (change-directory work-area) (set! keyvals (keys:target->keyval keys target)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) (debug:print 4 "varpairs: " varpairs) (map (lambda (varpair) |
︙ | |||
122 123 124 125 126 127 128 | 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 | - - - - - - - - - - + - - + | (list "MT_ITEM_INFO" (conc itemdat)) (list "MT_RUNNAME" runname) (list "MT_MEGATEST" megatest) (list "MT_TARGET" target) (list "MT_LINKTREE" (configf:lookup *configdat* "setup" "linktree")))) (if mt-bindir-path (setenv "PATH" (conc (getenv "PATH") ":" mt-bindir-path))) ;; (change-directory top-path) |
︙ | |||
411 412 413 414 415 416 417 | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | - + - + | (mutex-unlock! m) (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n") (if (not (vector-ref exit-info 1)) (exit 4))))))) ;; set up the very basics needed for doing anything here. |
︙ | |||
707 708 709 710 711 712 713 | 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 | - + + | (setenv "MT_ITEMPATH" item-path) (if hosts (set! hosts (string-split hosts))) ;; set the megatest to be called on the remote host (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest")) (set! mt-bindir-path (pathname-directory remote-megatest)) (if launcher (set! launcher (string-split launcher))) ;; set up the run work area for this test |
︙ |
Modified megatest.scm from [545aadfca9] to [1c83282f36].
︙ | |||
426 427 428 429 430 431 432 | 426 427 428 429 430 431 432 433 434 435 436 437 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 472 473 474 475 476 477 478 | - + - + - + | ;; we start the server if not running else start the client thread ;;====================================================================== (if (args:get-arg "-server") ;; Server? Start up here. ;; |
︙ | |||
535 536 537 538 539 540 541 | 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 | - + - + - + | (sections (if target (list "default" target) #f)) (data (begin (setenv "MT_RUN_AREA_HOME" *toppath*) (if key-vals (for-each (lambda (kt) (setenv (car kt) (cadr kt))) key-vals)) |
︙ | |||
665 666 667 668 669 670 671 | 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 | - + | ;; Query runs ;;====================================================================== ;; NOTE: list-runs and list-db-targets operate on local db!!! ;; (if (or (args:get-arg "-list-runs") (args:get-arg "-list-db-targets")) |
︙ | |||
863 864 865 866 867 868 869 | 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 | - + | (target (args:get-arg "-target")) (toppath (assoc/default 'toppath cmdinfo))) (change-directory toppath) (if (not target) (begin (debug:print 0 "ERROR: -target is required.") (exit 1))) |
︙ | |||
909 910 911 912 913 914 915 | 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 | - + | (status (args:get-arg ":status")) (target (args:get-arg "-target"))) (change-directory testpath) (if (not target) (begin (debug:print 0 "ERROR: -target is required.") (exit 1))) |
︙ | |||
983 984 985 986 987 988 989 | 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 | - + | (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (db #f)) (change-directory testpath) |
︙ | |||
1030 1031 1032 1033 1034 1035 1036 | 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 | - + | (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (db #f) ;; (open-db)) (state (args:get-arg ":state")) (status (args:get-arg ":status"))) |
︙ | |||
1135 1136 1137 1138 1139 1140 1141 | 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 | - + | ;; Various helper commands can go below here ;;====================================================================== (if (or (args:get-arg "-showkeys") (args:get-arg "-show-keys")) (let ((db #f) (keys #f)) |
︙ | |||
1166 1167 1168 1169 1170 1171 1172 | 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 | - + - + - + - + - + | ;;====================================================================== ;; Update the database schema, clean up the db ;;====================================================================== (if (args:get-arg "-rebuild-db") (begin |
︙ | |||
1240 1241 1242 1243 1244 1245 1246 | 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 | - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + | ;;====================================================================== ;; Wait on a run to complete ;;====================================================================== (if (args:get-arg "-run-wait") (begin |
︙ |
Modified newdashboard.scm from [4e9877b3af] to [d94e7d2519].
︙ | |||
65 66 67 68 69 70 71 | 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 | - + | 0)) (if (args:get-arg "-h") (begin (print help) (exit))) |
︙ |
Modified runs.scm from [45abf9e2f5] to [d806e46083].
︙ | |||
35 36 37 38 39 40 41 | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | - + | (conc testname (if (equal? itempath "") "" (conc "(" itempath ")"))))) ;; This is the *new* methodology. One record to inform them and in the chaos, organise them. ;; (define (runs:create-run-record) (let* ((mconfig (if *configdat* *configdat* |
︙ | |||
86 87 88 89 90 91 92 | 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | - + | (for-each (lambda (varval) (set! envdat (append envdat (list varval))) (safe-setenv (car varval)(cadr varval))) (configf:get-section runconfig section))) (list "default" target)) (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id))) |
︙ | |||
204 205 206 207 208 209 210 | 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 234 235 236 237 238 239 240 241 | + - - - - + + + + - + - + + + + + + + + + - + | (define (runs:run-tests target runname test-patts user flags) ;; test-names (let* ((keys (keys:config-get-fields *configdat*)) (keyvals (keys:target->keyval keys target)) (run-id (rmt:register-run keyvals runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) (test-records (make-hash-table)) ;; need to process runconfigs before generating these lists |
︙ | |||
428 429 430 431 432 433 434 | 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 | - + + + + | ((or (null? prereqs-not-met) (and (member 'toplevel testmode) (null? non-completed))) (debug:print-info 4 "runs:expand-items: (or (null? prereqs-not-met) (and (member 'toplevel testmode)(null? non-completed)))") (let ((test-name (tests:testqueue-get-testname test-record))) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_RUNNAME" runname) |
︙ | |||
468 469 470 471 472 473 474 | 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 | - + | (if (and give-up (not (and (null? tal)(null? reg)))) (let ((trimmed-tal (mt:discard-blocked-tests run-id hed tal test-records)) (trimmed-reg (mt:discard-blocked-tests run-id hed reg test-records))) (debug:print 1 "WARNING: test " hed " has discarded prerequisites, removing it from the queue") (let ((test-id (rmt:get-test-id run-id hed ""))) |
︙ | |||
544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 | 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 | + + + + | (runs:inc-cant-run-tests hed) (debug:print-info 1 "no fails in prerequisites for " hed " but also none running, keeping " hed " for now. Try count: " (hash-table-ref/default *seen-cant-run-tests* hed 0)) ;; num-retries code was here ;; we use this opportunity to move contents of reg to tal (list (car newtal)(append (cdr newtal) reg) '() reruns)) ;; an issue with prereqs not yet met? (begin (debug:print-info 1 "no fails in prerequisites for " hed " but nothing seen running in a while, dropping test " hed " from the run queue") (let ((test-id (rmt:get-test-id run-id hed ""))) (mt:test-set-state-status-by-id run-id test-id "DEQUEDED" "TIMED_OUT" "Nothing seen running in a while.")) (list (runs:queue-next-hed tal reg reglen regfull) (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) reruns)))) ((and (not (null? fails))(member 'normal testmode)) (debug:print-info 1 "test " hed " (mode=" testmode ") has failed prerequisite(s); " (string-intersperse (map (lambda (t)(conc (db:test-get-testname t) ":" (db:test-get-state t)"/"(db:test-get-status t))) fails) ", ") ", removing it from to-do list") (let ((test-id (rmt:get-test-id run-id hed ""))) (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites")) (if (or (not (null? reg))(not (null? tal))) (begin (hash-table-set! test-registry hed 'CANNOTRUN) (list (runs:queue-next-hed tal reg reglen regfull) (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) (cons hed reruns))) |
︙ | |||
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 767 768 769 770 771 | + + + | (list (car newtal)(cdr newtal) reg reruns)) ;; the waiton is FAIL so no point in trying to run hed ever again (if (or (not (null? reg))(not (null? tal))) (if (vector? hed) (begin (debug:print 1 "WARNING: Dropping test " test-name "/" item-path " from the launch list as it has prerequistes that are FAIL") (let ((test-id (rmt:get-test-id run-id hed ""))) (mt:test-set-state-status-by-id run-id test-id "NOT_STARTED" "PREQ_FAIL" "Failed to run due to failed prerequisites")) (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) ;; (thread-sleep! *global-delta*) ;; This next is for the items (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "BLOCKED" #f) (hash-table-set! test-registry (runs:make-full-test-name test-name item-path) 'removed) (list (runs:queue-next-hed tal reg reglen regfull) (runs:queue-next-tal tal reg reglen regfull) (runs:queue-next-reg tal reg reglen regfull) reruns ;; WAS: (cons hed reruns) ;; but that makes no sense? )) |
︙ | |||
900 901 902 903 904 905 906 | 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 | - + | (newtal (append tal (list hed))) (regfull (>= (length reg) reglen)) (num-running (rmt:get-count-tests-running-for-run-id run-id))) (if (> num-running 0) (set! last-time-some-running (current-seconds))) |
︙ | |||
1114 1115 1116 1117 1118 1119 1120 | 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 | - + | "\n test-config: " (hash-table->alist test-conf) "\n itemdat: " itemdat ) (debug:print 2 "Attempting to launch test " full-test-name) (setenv "MT_TEST_NAME" test-name) ;; (setenv "MT_ITEMPATH" item-path) (setenv "MT_RUNNAME" runname) |
︙ | |||
1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 | 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 | + | (let ((sorted-tests (sort tests (lambda (a b)(let ((dira ;; (rmt:sdb-qry 'getstr (db:test-get-rundir a)) ;; ) ;; (filedb:get-path *fdb* (db:test-get-rundir a))) (dirb ;; (rmt:sdb-qry 'getstr (db:test-get-rundir b))) ;; ) ;; ((filedb:get-path *fdb* (db:test-get-rundir b)))) (if (and (string? dira)(string? dirb)) (> (string-length dira)(string-length dirb)) #f))))) (toplevel-retries (make-hash-table)) ;; try three times to loop through and remove top level tests (test-retry-time (make-hash-table)) (allow-run-time 10)) ;; seconds to allow for killing tests before just brutally killing 'em (let loop ((test (car sorted-tests)) (tal (cdr sorted-tests))) (let* ((test-id (db:test-get-id test)) (new-test-dat (rmt:get-test-info-by-id run-id test-id))) (if (not new-test-dat) |
︙ | |||
1383 1384 1385 1386 1387 1388 1389 | 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 | + - + + + + + + + | (uname (db:test-get-uname new-test-dat)) (toplevel-with-children (and (db:test-get-is-toplevel test) (> (cdb:remote-run db:test-toplevel-num-items db run-id test-name) 0)))) (case action ((remove-runs) ;; if the test is a toplevel-with-children issue an error and do not remove (if toplevel-with-children (begin |
︙ | |||
1452 1453 1454 1455 1456 1457 1458 | 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 | - + | (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) |
︙ | |||
1506 1507 1508 1509 1510 1511 1512 | 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 | - + | (exit 3)) ((not runname) (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname") (exit 3)) (else (let ((db #f) (keys #f)) |
︙ |
Modified tasks.scm from [a24fc80b64] to [0cb7ba898b].
︙ | |||
18 19 20 21 22 23 24 25 26 27 28 29 | 18 19 20 21 22 23 24 25 26 27 28 29 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 57 58 | + + + + + + + + + - - - + + + + - + + + | (include "task_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== ;; If file exists AND ;; file readable ;; ==> open it ;; If file exists AND ;; file NOT readable ;; ==> open in-mem version ;; If file NOT exists ;; ==> open in-mem version ;; (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)) |
︙ |
Modified tests.scm from [1442dbb947] to [4ca513a697].
︙ | |||
29 30 31 32 33 34 35 | 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 | - - + | (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") ;; Call this one to do all the work and get a standardized list of tests (define (tests:get-all) |
︙ | |||
472 473 474 475 476 477 478 | 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 | - + | (tests:testqueue-set-priority! b-record b-priority) (if (and a-waitons (member (tests:testqueue-get-testname b-record) a-waitons)) #f ;; cannot have a which is waiting on b happening before b (if (and b-waitons (member (tests:testqueue-get-testname a-record) b-waitons)) #t ;; this is the correct order, b is waiting on a and b is before a (if (> a-priority b-priority) #t ;; if a is a higher priority than b then we are good to go |
︙ |
Modified tests/fullrun/megatest.config from [2791752641] to [9e6357a013].
︙ | |||
9 10 11 12 13 14 15 16 17 18 19 20 21 22 | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | + | 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'" & testsort -event_time [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 |
︙ |
tests/installall/config/megatest.config.dat became a regular file with contents [736a5da885].
tests/installall/config/runconfigs.config.dat became a regular file with contents [3b8f260acb].
Modified utils/Makefile_latest.installall from [acded49260] to [89573a2276].
︙ | |||
11 12 13 14 15 16 17 18 | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 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 | + - - + + + + - - + + + + + + - - + + | # make PREFIX=/mfs/pkgs/chicken/chicken-core all help : @echo You may need to do the following first: @echo sudo apt-get install libreadline-dev @echo sudo apt-get install libwebkitgtk-dev @echo sudo apt-get install libmotif3 @echo For IUP set IUPBRANCH, currently $(IUPBRANCH) @echo You are using PREFIX=$(PREFIX) |
︙ | |||
71 72 73 74 75 76 77 78 79 | 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 | + - + | ifeq ($(ISARCHX86_64),) ARCHSIZE= else ARCHSIZE=64_ endif CSCLIBS=$(shell echo $(LD_LIBRARY_PATH) | sed 's/:/ -L/g') CSC_OPTIONS="-I$(PREFIX)/include -L$(CSCLIBS)" # CSC_OPTIONS=-I$(PREFIX)/include -L$(CSCLIBS) |
︙ | |||
101 102 103 104 105 106 107 | 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 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 | - - - + + + - + + + + + + + - - - + + + + + + + + + + + + + + + + - + - + + + + - - + + - + - + + | # some setup stuff # setup-chicken4x.sh : $(EGGFLAGS) (echo "export PATH=$(PATH)" > setup-chicken4x.sh) (echo "export LD_LIBRARY_PATH=$(LD_LIBRARY_PATH)" >> setup-chicken4x.sh) mkdir -p $(PREFIX) |
Added utils/installck.sh version [7eb094e9b0].
|
Modified utils/loadrunner from [3fad28f85d] to [9ef382563c].
1 2 3 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 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 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | + + - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + + + + + - - - - + + + + + + + + + + - + + + + | #!/bin/bash LOADRUNNER=$0 # load=`uptime|awk '{print $10}'|cut -d, -f1` |