Overview
Comment: | Cross-pollinated v1.65 run-testdat work. This likely still does not pass obfusc-skel. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | v1.65-sidework |
Files: | files | file ages | folders |
SHA1: |
b17e77a3ea5b2ad32ae3d904f2b11bfc |
User & Date: | matt on 2020-10-05 23:07:30 |
Other Links: | branch diff | manifest | tags |
Context
2020-10-05
| ||
23:07 | Cross-pollinated v1.65 run-testdat work. This likely still does not pass obfusc-skel. Closed-Leaf check-in: b17e77a3ea user: matt tags: v1.65-sidework | |
22:49 | Do not exit on failure to create directory - race conditons on NFS cause false fail scenarios - just keep going and cross your fingers... (cherrypicked from v1.6572) check-in: 05b253a452 user: matt tags: v1.65-sidework | |
Changes
Modified TODO from [da5eae4898] to [dcd0f52bc7].
︙ | |||
14 15 16 17 18 19 20 21 22 23 24 25 26 27 | 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 | + + + + + + + | # # You should have received a copy of the GNU General Public License # along with Megatest. If not, see <http://www.gnu.org/licenses/>. TODO ==== WW38 . Add test_rundat to no-sync ==> correction, put in <testdir>/.meta/test-run.dat . Add STATE/STATUS transitions to .meta/test-run.dat or similar . Swizzle update-test-rundat to operate on no-sync . Swizzle update-run-duration, -uname-host and cpuload-diskfree to no-sync . On state/status change update tests table with duration WW15 . fill newview matrix with data, filter pipeline gui elements . improve [script], especially indent handling WW16 . split db into megatest.db (runs etc.) db/<something>.db . release basic newview implementation |
︙ |
Modified common.scm from [33c7316880] to [a37bf38bb2].
︙ | |||
499 500 501 502 503 504 505 | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 | - + | ;; logs directory you wish to log-rotate. ;; (define (common:rotate-logs) (let* ((all-files (make-hash-table)) (stats (make-hash-table)) (inc-stat (lambda (key) (hash-table-set! stats key (+ (hash-table-ref/default stats key 0) 1)))) |
︙ |
Modified dashboard.scm from [935bf4d2df] to [d4733659e1].
︙ | |||
210 211 212 213 214 215 216 217 218 219 220 221 222 223 | 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | + + | ;; (define (dboard:common-set-tabdat! commondat tabnum tabdat) (hash-table-set! (dboard:commondat-tabdats commondat) tabnum tabdat)) (define *updater-running* #f) ;; move this into one of the stucts ;; gets and calls updater list based on curr-tab-num ;; (define (dboard:common-run-curr-updaters commondat #!key (tab-num #f)) (if (dboard:common-get-tabdat commondat tab-num: tab-num) ;; only update if there is a tabdat (let* ((tnum (or tab-num (dboard:commondat-curr-tab-num commondat))) (updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum |
︙ | |||
238 239 240 241 242 243 244 | 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 | - + + + | (curr-updaters (hash-table-ref/default (dboard:commondat-updaters commondat) tnum '()))) (hash-table-set! (dboard:commondat-updaters commondat) tnum (cons updater curr-updaters)))) ;; data for each specific tab goes here ;; |
︙ | |||
643 644 645 646 647 648 649 | 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 | - + | ;; ;; NOTE: Yes, this is used ;; (define (dboard:get-tests-for-run-duplicate tabdat run-id run testnamepatt key-vals) (let* ((start-time (current-seconds)) (access-mode (dboard:tabdat-access-mode tabdat)) (num-to-get (string->number (or (configf:lookup *configdat* "setup" "num-tests-to-get") |
︙ | |||
899 900 901 902 903 904 905 | 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 | - + + - - + + - - - - + + | (elapsed-time (- (current-seconds) start-time))) (if (null? all-test-ids) (hash-table-delete! (dboard:tabdat-allruns-by-id tabdat) run-id) (hash-table-set! (dboard:tabdat-allruns-by-id tabdat) run-id run-struct)) (if (or (null? tal) (> elapsed-time 2)) ;; stop loading data after 5 seconds, on the next call more data *should* be loaded since get-tests-for-run uses last update (begin |
︙ | |||
2503 2504 2505 2506 2507 2508 2509 | 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 | - - - - | sort-lb))) ) ;; insert extra widget here (if extra-widget extra-widget (iup:hbox)) ;; empty widget |
︙ | |||
3731 3732 3733 3734 3735 3736 3737 | 3730 3731 3732 3733 3734 3735 3736 3737 3738 3739 3740 3741 3742 3743 3744 3745 3746 3747 3748 3749 3750 3751 3752 3753 3754 | - - - - - - - - - - + + + + + + + + + + + | tabdat (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "runname" "%") (dboard:tabdat-numruns tabdat) (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) "test-name" "%/%") ;; generate key patterns from the target stored in tabdat (let* ((dbkeys (dboard:tabdat-dbkeys tabdat))) (let ((fres (if (dboard:tabdat-target tabdat) |
︙ | |||
3799 3800 3801 3802 3803 3804 3805 | 3799 3800 3801 3802 3803 3804 3805 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 3821 3822 3823 3824 3825 3826 3827 | - - - - - - - - - - - - + + + + + + + + + + + + + + + | commondat (lambda () (dashboard:runs-tab-updater commondat 1)) tab-num: 2) (iup:callback-set! *tim* "ACTION_CB" (lambda (time-obj) |
︙ |
Modified db.scm from [fb3a18f52f] to [2c7b396933].
︙ | |||
1774 1775 1776 1777 1778 1779 1780 | 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 | + + - - - - - + + + + + + + + + + + + + + + + + + + + + | (debug:print 0 *default-log-port* "ERROR: cannot read " infile) (debug:print 0 *default-log-port* "ERROR: run-dir is " run-dir) #f ) (with-input-from-file infile read-lines) ))) ;; check duration against test-run.dat file if it exists and update the value in ;; the db if necessary |
︙ | |||
1826 1827 1828 1829 1830 1831 1832 | 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856 1857 1858 1859 1860 1861 1862 1863 1864 1865 1866 1867 1868 1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 | + - - - - - - - - - - - + + + + + + + + + + + - + + - - - - - - - - - - - + + + + + + + + + + + | ;; HOWEVER: this code in run:test seems to work fine ;; (> (- (current-seconds)(+ (db:test-get-event_time testdat) ;; (db:test-get-run_duration testdat))) ;; 600) ;; (db:delay-if-busy dbdat) (sqlite3:for-each-row (lambda (test-id run-dir uname testname item-path event-time run-duration) (if (not (db:adjust-run-duration dbstruct test-id run-dir event-time run-duration)) |
︙ | |||
3465 3466 3467 3468 3469 3470 3471 | 3485 3486 3487 3488 3489 3490 3491 3492 3493 3494 3495 3496 3497 3498 3499 | - + | (let* ((run-ids (db:get-all-run-ids mtdb))) (for-each (lambda (run-id) (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))) (db:prep-megatest.db-adj-test-ids (db:dbdat-get-db mtdb) run-id testrecs))) run-ids))) |
︙ |
Modified launch.scm from [6b92672067] to [3e2d417312].
︙ | |||
203 204 205 206 207 208 209 | 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 | - + - + + + | (round (- (current-seconds) start-seconds))))) (kill-tries 0)) ;; (tests:set-full-meta-info #f test-id run-id (calc-minutes) work-area) ;; (tests:set-full-meta-info test-id run-id (calc-minutes) work-area) |
︙ | |||
231 232 233 234 235 236 237 | 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 | - + - + - + - - - - + - - | (do-sync (or new-cpu-load new-disk-free over-time)) (test-info (rmt:get-test-info-by-id run-id test-id)) (state (db:test-get-state test-info)) (status (db:test-get-status test-info)) (kill-reason "no kill reason specified") (kill-job? #f)) |
︙ | |||
310 311 312 313 314 315 316 | 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 | - + | (begin (thread-sleep! 3) ;; (+ 3 (random 6))) ;; add some jitter to the call home time to spread out the db accesses (if (hash-table-ref/default misc-flags 'keep-going #f) ;; keep originals for cpu-load and disk-free unless they change more than the allowed delta (loop (calc-minutes) (or new-cpu-load cpu-load) (or new-disk-free disk-free) (if do-sync (current-seconds) last-sync))))))) |
︙ | |||
463 464 465 466 467 468 469 470 471 472 473 474 475 476 | 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 | + + + | (db:test-get-host test-info) (begin (debug:print 0 *default-log-port* "ERROR: failed to find a record for test-id " test-id ", exiting.") (exit)))) (test-pid (db:test-get-process_id test-info))) (cond ;; -mrw- I'm removing KILLREQ from this list so that a test in KILLREQ state is treated as a "do not run" flag. ;; ((or (member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun ;; (and (equal? (db:test-get-state test-info) "COMPLETED") ;; completed/abort => rerun if asked ;; (member (db:test-get-status test-info) '("ABORT")))) ((member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun (debug:print 0 *default-log-port* "INFO: test is INCOMPLETE or KILLED, treat this execute call as a rerun request") ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") (rmt:general-call 'set-test-start-time #f test-id) (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f) ) ;; prime it for running |
︙ | |||
769 770 771 772 773 774 775 | 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 | + + - + | (item-path (vector-ref running-test 11))) (debug:print 0 *default-log-port* "test " test-name "/" item-path " not completed") (if (not (null? tal)) (loop (car tal) (cdr tal))))))))))) (define (launch:is-test-alive host pid) (if (and host pid (not (equal? host "n/a"))) (let* ((is-local (equal? host (get-host-name))) (ssh-cmd (if is-local " " (conc "ssh " host " "))) |
︙ |
Modified rmt.scm from [39d97c528a] to [29d7593e43].
︙ | |||
20 21 22 23 24 25 26 27 28 29 30 31 32 33 | 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | + + | (use format typed-records) ;; RADT => purpose of json format?? (declare (unit rmt)) (declare (uses api)) (declare (uses http-transport)) (include "common_records.scm") (include "db_records.scm") ;; (declare (uses rmtmod)) ;; (import rmtmod) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; |
︙ | |||
523 524 525 526 527 528 529 | 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 | - + - + + + + + + + + + + | ;; Just some syntatic sugar (define (rmt:register-test run-id test-name item-path) (rmt:general-call 'register-test run-id run-id test-name item-path)) (define (rmt:get-test-id run-id testname item-path) (rmt:send-receive 'get-test-id run-id (list run-id testname item-path))) |
︙ |
Modified runs.scm from [030b929939] to [497a5137ad].
︙ | |||
1787 1788 1789 1790 1791 1792 1793 | 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 | - + - - | (debug:print-info 4 *default-log-port* "cond branch - " "rtq-4") (let ((can-run-more #f)) ;; (runs:can-run-more-tests runsdat run-id jobgroup max-concurrent-jobs))) (if (not can-run-more) #;(and (list? can-run-more) (car can-run-more)) (let ((loop-list (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmaps))) ;; itemized test expanded here (if loop-list (apply loop loop-list) |
︙ |
Modified server.scm from [7b2af2dc7e] to [e17aad21de].
︙ | |||
344 345 346 347 348 349 350 351 352 353 354 355 356 357 | 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 | + + + + + + + + + + + + + + + + + + | (equal? server-key res)))) #t ;; (system (conc "touch " start-flag)) ;; lazy but safe (begin (debug:print-info 0 *default-log-port* "Gating server start, last start: " fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go) (thread-sleep! reftime) (server:wait-for-server-start-last-flag areapath))))))) ;; wait for server=start-last to be three seconds old - this might be what was causing the obfusc-skel fails ;; #;(define (server:wait-for-server-start-last-flag areapath) (let* ((start-flag (conc areapath "/logs/server-start-last"))) (if (file-exists? start-flag) (let* ((fmodtime (file-modification-time start-flag)) (reftime (+ 2 (random 3))) (delta (- (current-seconds) fmodtime)) (all-go (> delta reftime))) (if all-go #t ;; (system (conc "touch " start-flag)) ;; lazy but safe (begin (debug:print-info 0 *default-log-port* "Gating server start, last start: " fmodtime ", delta: " delta ", reftime: " reftime ", all-go=" all-go) (thread-sleep! 5) (server:wait-for-server-start-last-flag areapath)))) #;(system (conc "touch " start-flag))))) ;; kind start up of servers, wait 40 seconds before allowing another server for a given ;; run-id to be launched ;; (define (server:kind-run areapath) ;; look for $MT_RUN_AREA_HOME/logs/server-start-last ;; and wait for it to be at least 3 seconds old |
︙ |
Modified tests.scm from [0094b671e6] to [9198f1fbaa].
︙ | |||
1942 1943 1944 1945 1946 1947 1948 | 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 | + - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + + - + | (lambda (count) (set! res count)) tdb "SELECT count(id) FROM test_rundat;") res)) 0) ;; |
︙ | |||
1982 1983 1984 1985 1986 1987 1988 | 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 | - + - | (let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (debug:print-error 0 *default-log-port* "tried for over a minute to update meta info and failed. Giving up") (debug:print 0 *default-log-port* "EXCEPTION: database probably overloaded or unreadable.") (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn)) (debug:print 5 *default-log-port* "exn=" (condition->list exn)) (debug:print 0 *default-log-port* " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (print-call-chain (current-error-port)))) |