Overview
Comment: | Dashboard starts and seems to work. A run mostly works. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-wip |
Files: | files | file ages | folders |
SHA1: |
0df1257922823f33bc48f8d468825ac2 |
User & Date: | matt on 2019-10-24 20:55:25 |
Other Links: | branch diff | manifest | tags |
Context
2019-10-24
| ||
23:28 | wip check-in: 082ff62d80 user: matt tags: v1.65-wip | |
20:55 | Dashboard starts and seems to work. A run mostly works. check-in: 0df1257922 user: matt tags: v1.65-wip | |
18:51 | Added bypass sets in megatest.scm check-in: 093e8bc8c2 user: mrwellan tags: v1.65-wip | |
Changes
Modified Makefile from [c54acbcff1] to [29905b8226].
︙ | ︙ | |||
148 149 150 151 152 153 154 | # # $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm # csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl # Special dependencies for the includes tests.o db.o launch.o runs.o dashboard-tests.o dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o \ | | | > | | 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 | # # $(PREFIX)/bin/revtagfsl : utils/revtagfsl.scm # csc utils/revtagfsl.scm -o $(PREFIX)/bin/revtagfsl # Special dependencies for the includes tests.o db.o launch.o runs.o dashboard-tests.o dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o monitor.o dashboard.o \ archive.o megatest.o : db_records.scm migrate-fix.scm tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o : run_records.scm db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm tests.o tasks.o dashboard-tasks.o : task_records.scm runs.o : test_records.scm megatest.o : megatest-fossil-hash.scm rmt.scm client.scm common.scm configf.scm dashboard-guimonitor.scm dashboard-tests.scm dashboard.scm db.scm dcommon.scm ezsteps.scm fs-transport.scm http-transport.scm index-tree.scm items.scm keys.scm launch.scm megatest.scm monitor.scm mt.scm newdashboard.scm runconfig.scm runs.scm server.scm tdb.scm tests.scm tree.scm : common_records.scm common_records.scm : altdb.scm vg.o dashboard.o : vg_records.scm dcommon.o : run_records.scm migrate-fix.scm # Temporary while transitioning to new routine # runs.o : run-tests-queue-classic.scm run-tests-queue-new.scm # for the modularized stuff mofiles/dbmod.o : mofiles/commonmod.o mofiles/commonmod.o : mofiles/configfmod.o mofiles/rmtmod.o : mofiles/dbmod.o mofiles/commonmod.o # $(MOFILES) : mofiles/commonmod.o megatest-fossil-hash.scm : $(SRCFILES) megatest.scm *_records.scm echo "(define megatest-fossil-hash \"$(MTESTHASH)\")" > megatest-fossil-hash.new if ! diff -q megatest-fossil-hash.new megatest-fossil-hash.scm ; then echo copying .new to .scm;cp -f megatest-fossil-hash.new megatest-fossil-hash.scm;fi |
︙ | ︙ | |||
329 330 331 332 333 334 335 336 337 338 339 340 341 342 | $(MTQA_FOSSIL) : fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL) clean : rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt ftail.import.scm readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o rm -rf share #====================================================================== # Make the records files #====================================================================== # vg_records.scm : records.sh # ./records.sh | > | 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | $(MTQA_FOSSIL) : fossil clone https://www.kiatoa.com/fossils/megatest_qa $(MTQA_FOSSIL) clean : rm -f $(OFILES) $(GOFILES) $(MOFILES) $(TCMTOBJS) $(PREFIX)/megatest $(PREFIX)/dashboard mtest mtutil mtut tcmt ftail.import.scm readline-fix.scm serialize-env dboard dboard.o megatest.o dashboard.o megatest-fossil-hash.* altdb.scm mofiles/*.o vg.o rm -rf share rm -f *.import.scm #====================================================================== # Make the records files #====================================================================== # vg_records.scm : records.sh # ./records.sh |
︙ | ︙ |
Modified client.scm from [aa0e79bdb4] to [3b307eedbb].
︙ | ︙ | |||
71 72 73 74 75 76 77 | ;; There are two scenarios. ;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline ;; 2. We are a run tests, list runs or other interactive process and we must figure out ;; *transport-type* and *runremote* from the monitor.db ;; ;; client:setup ;; | | | 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 | ;; There are two scenarios. ;; 1. We are a test manager and we received *transport-type* and *runremote* via cmdline ;; 2. We are a run tests, list runs or other interactive process and we must figure out ;; *transport-type* and *runremote* from the monitor.db ;; ;; client:setup ;; ;; lookup_server, need to remove *runremote* stuff -> replace with *alldat* for now ;; (define (client:setup-http runremote areapath #!key (remaining-tries 100) (failed-connects 0)) ;; (area-dat #f)) (debug:print-info 2 *default-log-port* "client:setup remaining-tries=" remaining-tries) (server:start-and-wait areapath) (if (<= remaining-tries 0) (begin |
︙ | ︙ |
Modified common.scm from [f59f8f3c80] to [e80ce5a3ad].
︙ | ︙ | |||
2003 2004 2005 2006 2007 2008 2009 | (mdbspace (common:check-space-in-dir (alldat-areapath alldat) required))) (sort (list tdbspace mdbspace) (lambda (a b) (< (cadr a)(cadr b)))))) ;; check available space in dbdir, exit if insufficient ;; (define (common:check-db-dir-and-exit-if-insufficient) | | | 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 | (mdbspace (common:check-space-in-dir (alldat-areapath alldat) required))) (sort (list tdbspace mdbspace) (lambda (a b) (< (cadr a)(cadr b)))))) ;; check available space in dbdir, exit if insufficient ;; (define (common:check-db-dir-and-exit-if-insufficient) (let* ((spacedat (car (common:check-db-dir-space *alldat*))) ;; look only at worst for now (is-ok (car spacedat)) (dbspace (cadr spacedat)) (required (caddr spacedat)) (dbdir (cadddr spacedat))) (if (not is-ok) (begin (debug:print-error 0 *default-log-port* "Insufficient space in " dbdir ", require " required ", have " dbspace ", exiting now.") |
︙ | ︙ |
Modified dashboard.scm from [e75216ce64] to [7f80f1cd91].
︙ | ︙ | |||
44 45 46 47 48 49 50 51 52 | (declare (uses dcommon)) (declare (uses dashboard-context-menu)) (declare (uses vg)) (declare (uses subrun)) ;; (declare (uses dashboard-main)) (declare (uses megatest-version)) (declare (uses mt)) (declare (uses commonmod)) (import commonmod) | > | > > > | 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (declare (uses dcommon)) (declare (uses dashboard-context-menu)) (declare (uses vg)) (declare (uses subrun)) ;; (declare (uses dashboard-main)) (declare (uses megatest-version)) (declare (uses mt)) (declare (uses commonmod)) (import commonmod) (declare (uses rmtmod)) (import rmtmod) (declare (uses dbmod)) (import dbmod) (include "common_records.scm") (include "db_records.scm") (include "run_records.scm") (include "task_records.scm") (include "megatest-fossil-hash.scm") (include "vg_records.scm") |
︙ | ︙ | |||
101 102 103 104 105 106 107 108 109 110 111 112 113 114 | "-use-db-cache" "-skip-version-check" "-repl" "-rh5.11" ;; fix to allow running on rh5.11 ) args:arg-hash 0)) ;; check for MT_* environment variables and exit if found (if (not (args:get-arg "-test")) (begin (display "Checking for MT_ vars: ") (for-each (lambda (var) (display " ")(display var) | > > > > > > | 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 | "-use-db-cache" "-skip-version-check" "-repl" "-rh5.11" ;; fix to allow running on rh5.11 ) args:arg-hash 0)) ;; (set! *functions* dbmod#*functions*) ;; (set! apimod#*functions* dbmod#*functions*) ;; (set! configfmod#*functions* dbmod#*functions*) (include "migrate-fix.scm") ;; check for MT_* environment variables and exit if found (if (not (args:get-arg "-test")) (begin (display "Checking for MT_ vars: ") (for-each (lambda (var) (display " ")(display var) |
︙ | ︙ |
Modified launch.scm from [34cf73b248] to [0af6449447].
︙ | ︙ | |||
499 500 501 502 503 504 505 | (let* ((testpath (assoc/default 'testpath cmdinfo)) ;; testpath is the test spec area (top-path (assoc/default 'toppath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) ;; work-area is the test run area (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) (subrun (assoc/default 'subrun cmdinfo)) | < < < < | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 | (let* ((testpath (assoc/default 'testpath cmdinfo)) ;; testpath is the test spec area (top-path (assoc/default 'toppath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) ;; work-area is the test run area (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) (subrun (assoc/default 'subrun cmdinfo)) (serverurl (assoc/default 'serverurl cmdinfo)) (homehost (assoc/default 'homehost cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (target (assoc/default 'target cmdinfo)) (areaname (assoc/default 'areaname cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) |
︙ | ︙ | |||
1624 1625 1626 1627 1628 1629 1630 | (write (list (list 'testpath test-path) ;; (list 'transport (conc *transport-type*)) ;; (list 'serverinf *server-info*) (list 'homehost (let* ((hhdat (common:get-homehost))) (if hhdat (car hhdat) #f))) | | | | 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 | (write (list (list 'testpath test-path) ;; (list 'transport (conc *transport-type*)) ;; (list 'serverinf *server-info*) (list 'homehost (let* ((hhdat (common:get-homehost))) (if hhdat (car hhdat) #f))) (list 'serverurl (if *alldat* (alldat-server-url *alldat*) #f)) ;; (list 'areaname (common:get-area-name *alldat*)) (list 'toppath *toppath*) (list 'work-area work-area) (list 'test-name test-name) (list 'runscript runscript) (list 'run-id run-id ) |
︙ | ︙ |
Modified megatest.scm from [f0d3ba589a] to [e746b1e83f].
︙ | ︙ | |||
521 522 523 524 525 526 527 | (system (conc "mkdir -p " log-dir))) (open-output-file logpath)) (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) | < < < < < | | | < < < < < < < < < < < < < | | 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 | (system (conc "mkdir -p " log-dir))) (open-output-file logpath)) (exn () (debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath) (define *didsomething* #t) (exit 1)))) ;; (set! *functions* dbmod#*functions*) ;; (set! apimod#*functions* dbmod#*functions*) ;; (set! configfmod#*functions* dbmod#*functions*) (include "migrate-fix.scm") ;; this segment will run launch:setup only if -log is not set. This is fairly safe as servers are not ;; manually started and thus should never be started in a non-megatest area. Thus no need to handle situation ;; where (launch:setup) returns #f? ;; (if (or (args:get-arg "-log")(args:get-arg "-server")) ;; redirect the log always when a server (handle-exceptions |
︙ | ︙ |
Added migrate-fix.scm version [5b31c0d24a].
> > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | ;; this is a good place to populate the *functions* hash with ;; functions needed during the transition to modules ;; ;; NOTE: the definition in dbmod seems to "win" - make it available everywhere ;; (set-fn 'client:setup client:setup) (set-fn 'db:setup db:setup) (set-fn 'server:expiration-timeout server:expiration-timeout) (set-fn 'common:get-homehost common:get-homehost) (set-fn 'server:check-if-running server:check-if-running) (set-fn 'api:execute-requests api:execute-requests) (set-fn 'http-transport:close-connections http-transport:close-connections ) (set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive) (set-fn 'server:kind-run server:kind-run) (set-fn 'server:start-and-wait server:start-and-wait) (set-fn 'server:check-if-running server:check-if-running) (set-fn 'server:ping server:ping ) (set-fn 'common:force-server? common:force-server? ) |
Modified runs.scm from [f83c6158a9] to [ff5463fcb5].
︙ | ︙ | |||
1466 1467 1468 1469 1470 1471 1472 | testmode: testmode newtal: newtal itemmaps: itemmaps ;; prereqs-not-met: prereqs-not-met ))) (runs:dat-regfull-set! runsdat regfull) | < < < < < < < < < | 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 | testmode: testmode newtal: newtal itemmaps: itemmaps ;; prereqs-not-met: prereqs-not-met ))) (runs:dat-regfull-set! runsdat regfull) (if (> num-running 0) (set! last-time-some-running (current-seconds))) (if (> (current-seconds)(+ last-time-some-running (or (configf:lookup *configdat* "setup" "give-up-waiting") 36000))) (hash-table-set! *max-tries-hash* tfullname (+ (hash-table-ref/default *max-tries-hash* tfullname 0) 1))) ;; (debug:print 0 *default-log-port* "max-tries-hash: " (hash-table->alist *max-tries-hash*)) |
︙ | ︙ |
Modified tests.scm from [252b849c13] to [401f54db5b].
︙ | ︙ | |||
1769 1770 1771 1772 1773 1774 1775 | (let* ((test-record (hash-table-ref testrecordshash testkeyname)) (test-name (tests:testqueue-get-testname test-record)) (itemdat (tests:testqueue-get-itemdat test-record)) (item-path (tests:testqueue-get-item_path test-record)) (waitons (tests:testqueue-get-waitons test-record)) (keep-test #t) (test-id (rmt:get-test-id run-id test-name item-path)) | | | | 1769 1770 1771 1772 1773 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 | (let* ((test-record (hash-table-ref testrecordshash testkeyname)) (test-name (tests:testqueue-get-testname test-record)) (itemdat (tests:testqueue-get-itemdat test-record)) (item-path (tests:testqueue-get-item_path test-record)) (waitons (tests:testqueue-get-waitons test-record)) (keep-test #t) (test-id (rmt:get-test-id run-id test-name item-path)) (tdat (rmt:get-testinfo-state-status run-id test-id))) (if tdat (begin ;; Look at the test state and status (if (or (and (member (db:test-get-status tdat) '("PASS" "WARN" "WAIVED" "CHECK" "SKIP")) (equal? (db:test-get-state tdat) "COMPLETED")) (member (db:test-get-state tdat) '("INCOMPLETE" "KILLED"))) (set! keep-test #f)) ;; examine waitons for any fails. If it is FAIL or INCOMPLETE then eliminate this test ;; from the runnable list (if keep-test (for-each (lambda (waiton) ;; for now we are waiting only on the parent test (let* ((parent-test-id (rmt:get-test-id run-id waiton "")) (wtdat (rmt:get-testinfo-state-status run-id test-id))) (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED") (member (db:test-get-status wtdat) '("FAIL" "ABORT"))) (member (db:test-get-status wtdat) '("KILLED")) (member (db:test-get-state wtdat) '("INCOMPETE"))) ;; (if (or (member (db:test-get-status wtdat) ;; '("FAIL" "KILLED")) ;; (member (db:test-get-state wtdat) |
︙ | ︙ |