Overview
Comment: | dashboard almost starts |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.6584-nanomsg |
Files: | files | file ages | folders |
SHA1: |
23a7cfadcba74f5558f5787d86f6d805 |
User & Date: | matt on 2021-11-08 20:48:09 |
Other Links: | branch diff | manifest | tags |
Context
2021-11-10
| ||
05:21 | Dashboard starts check-in: 0c6edac10b user: matt tags: v1.6584-nanomsg | |
2021-11-08
| ||
20:48 | dashboard almost starts check-in: 23a7cfadcb user: matt tags: v1.6584-nanomsg | |
19:18 | wip check-in: ac5d1bc5af user: matt tags: v1.6584-nanomsg | |
Changes
Modified dashboard.scm from [b4f6f8abed] to [f51aa849a8].
︙ | ︙ | |||
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 | (declare (uses itemsmod)) (declare (uses launchmod)) (declare (uses mtargs)) (declare (uses mtmod)) (declare (uses mtver)) (declare (uses processmod)) (declare (uses runsmod)) (declare (uses subrunmod)) (declare (uses tree)) (declare (uses vgmod)) ;; (declare (uses dashboard-guimonitor)) ;; (declare (uses dashboard-main)) (import (prefix iup iup:)) (import canvas-draw) ;; (import canvas-draw-iup) (import ducttape-lib bigmod) (import (prefix sqlite3 sqlite3:) srfi-1 chicken.file.posix chicken.string chicken.process-context regex regex-case srfi-69 typed-records sparse-vectors | > > | > > | 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 | (declare (uses itemsmod)) (declare (uses launchmod)) (declare (uses mtargs)) (declare (uses mtmod)) (declare (uses mtver)) (declare (uses processmod)) (declare (uses runsmod)) (declare (uses rmtmod)) (declare (uses subrunmod)) (declare (uses tree)) (declare (uses vgmod)) ;; (declare (uses dashboard-guimonitor)) ;; (declare (uses dashboard-main)) (import (prefix iup iup:)) (import canvas-draw) ;; (import canvas-draw-iup) (import ducttape-lib bigmod) (import (prefix sqlite3 sqlite3:) srfi-1 chicken.file.posix chicken.string chicken.process-context chicken.process-context.posix regex regex-case srfi-69 typed-records sparse-vectors format srfi-4 ) ;; (include "common_records.scm") ;; (include "db_records.scm") ;; (include "run_records.scm") ;; (include "task_records.scm") ;; (include "megatest-version.scm") (include "megatest-fossil-hash.scm") |
︙ | ︙ | |||
79 80 81 82 83 84 85 86 87 88 89 90 91 92 | itemsmod launchmod (prefix mtargs args:) mtmod mtver processmod runsmod subrunmod vgmod dcommon tree dashboard-context-menu dashboard-tests) | > | 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 | itemsmod launchmod (prefix mtargs args:) mtmod mtver processmod runsmod rmtmod subrunmod vgmod dcommon tree dashboard-context-menu dashboard-tests) |
︙ | ︙ | |||
307 308 309 310 311 312 313 | (lambda (updater) ;; (debug:print 3 *default-log-port* "Running " updater) (updater)) updaters)))) ;; register tabdat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle | | | 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 | (lambda (updater) ;; (debug:print 3 *default-log-port* "Running " updater) (updater)) updaters)))) ;; register tabdat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:tabdat into a composition of lists that pp will handle #;(hash-table-set! *BBpp_custom_expanders_list* TABDAT: (cons dboard:tabdat? (lambda (tabdat-item) (filter (lambda (alist-entry) (member (car alist-entry) '(allruns-by-id allruns))) ;; FIELDS OF INTEREST (dboard:tabdat->alist tabdat-item))))) |
︙ | ︙ | |||
334 335 336 337 338 339 340 | (define (dboard:setup-tabdat tabdat) (dboard:tabdat-dbdir-set! tabdat (common:get-db-tmp-area)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (dboard:tabdat-dbfpath-set! tabdat (common:get-db-tmp-area)) (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) ;; HACK ALERT: this is a hack, please fix. | | | 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 | (define (dboard:setup-tabdat tabdat) (dboard:tabdat-dbdir-set! tabdat (common:get-db-tmp-area)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db")) (dboard:tabdat-dbfpath-set! tabdat (common:get-db-tmp-area)) (dboard:tabdat-monitor-db-path-set! tabdat (conc (dboard:tabdat-dbdir tabdat) "/monitor.db")) ;; HACK ALERT: this is a hack, please fix. (dboard:tabdat-ro-set! tabdat (not (file-readable? (dboard:tabdat-dbfpath tabdat)))) (dboard:tabdat-keys-set! tabdat (rmt:get-keys)) (dboard:tabdat-dbkeys-set! tabdat (append (dboard:tabdat-keys tabdat) (list "runname"))) (dboard:tabdat-tot-runs-set! tabdat (rmt:get-num-runs "%")) ) ;; RADT => Matrix defstruct addition |
︙ | ︙ | |||
450 451 452 453 454 455 456 | status start-time duration ) ;; register dboard:rundat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle | | | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 | status start-time duration ) ;; register dboard:rundat with BBpp ;; this is used by BBpp (Brandon's pretty printer) to convert dboard:rundat into a composition of lists that pp will handle #;(hash-table-set! *BBpp_custom_expanders_list* RUNDAT: (cons dboard:rundat? (lambda (tabdat-item) (filter (lambda (alist-entry) (member (car alist-entry) '(run run-data-offset ))) ;; FIELDS OF INTEREST (dboard:rundat->alist tabdat-item))))) |
︙ | ︙ | |||
1940 1941 1942 1943 1944 1945 1946 | ;;====================================================================== ;; S U M M A R Y ;;====================================================================== ;; ;; General info about the run(s) and megatest area (define (dashboard:summary commondat tabdat #!key (tab-num #f)) | | | 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 | ;;====================================================================== ;; S U M M A R Y ;;====================================================================== ;; ;; General info about the run(s) and megatest area (define (dashboard:summary commondat tabdat #!key (tab-num #f)) (let* ((rawconfig (configf:read-config (conc *toppath* "/megatest.config") #f #f)) ;; changed to #f since I want #{} to be expanded by [system ...] to NOT be expanded. WAS: 'return-string))) (changed #f)) (iup:vbox (iup:split #:value 300 (iup:frame #:title "General Info" (iup:vbox |
︙ | ︙ | |||
1982 1983 1984 1985 1986 1987 1988 | (define (dboard:add-external-tab commondat view-name views-cfgdat tabs tab-num) (let* ((success #t) ;; at any stage of the process set this flag to #f to skip downstream steps. Intention here is to recover gracefully if user provided tabs fail to load. (source (configf:lookup views-cfgdat view-name "source")) (viewgen (configf:lookup views-cfgdat view-name "viewgen")) (updater (configf:lookup views-cfgdat view-name "updater")) (result-child #f)) (if (and (common:file-exists? source) | | | 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 | (define (dboard:add-external-tab commondat view-name views-cfgdat tabs tab-num) (let* ((success #t) ;; at any stage of the process set this flag to #f to skip downstream steps. Intention here is to recover gracefully if user provided tabs fail to load. (source (configf:lookup views-cfgdat view-name "source")) (viewgen (configf:lookup views-cfgdat view-name "viewgen")) (updater (configf:lookup views-cfgdat view-name "updater")) (result-child #f)) (if (and (common:file-exists? source) (file-readable? source)) (handle-exceptions exn (begin (print-call-chain) (debug:print 0 *default-log-port* " message: " ((condition-property-accessor 'exn 'message) exn) ", exn=" exn) (debug:print 0 *default-log-port* "ERROR: failed to load " source ", try loading in the repl: megatest -repl") (set! success #f)) |
︙ | ︙ | |||
3164 3165 3166 3167 3168 3169 3170 | (dbpth (if (< (length parts) 2) ;; assume then a filename was provided dbstr (if (equal? (car parts) "sqlite3") (cadr parts) (begin (debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr) #f))))) | | | 3169 3170 3171 3172 3173 3174 3175 3176 3177 3178 3179 3180 3181 3182 3183 | (dbpth (if (< (length parts) 2) ;; assume then a filename was provided dbstr (if (equal? (car parts) "sqlite3") (cadr parts) (begin (debug:print 0 *default-log-port* "ERROR: I only know sqlite3 databases for now: " dbstr) #f))))) (if (and dbpth (file-readable? dbpth)) (let ((db (sqlite3:open-database dbpth))) ;; (open-database dbpth))) (sqlite3:set-busy-handler! db (make-busy-timeout 10000)) db) #f))) ;; sqlite3:path tablename timefieldname varfieldname field1 field2 ... ;; |
︙ | ︙ | |||
3619 3620 3621 3622 3623 3624 3625 | ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== (define (main) (let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; | | | | 3624 3625 3626 3627 3628 3629 3630 3631 3632 3633 3634 3635 3636 3637 3638 3639 | ;;====================================================================== ;; The heavy lifting starts here ;;====================================================================== (define (main) (let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; #;(if (and (common:file-exists? mtdb-path) (file-writable? mtdb-path)) (if (not (args:get-arg "-skip-version-check")) (common:exit-on-version-changed))) (let* ((commondat (dboard:commondat-make))) ;; Move this stuff to db.scm? I'm not sure that is the right thing to do... (cond ((args:get-arg "-test") ;; run-id,test-id (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) |
︙ | ︙ |
Modified debugprint.scm from [fdf96a030a] to [4552843dbc].
1 2 3 4 5 6 7 8 9 10 11 | (declare (unit debugprint)) (declare (uses mtargs)) (module debugprint * ;;(import scheme chicken data-structures extras files ports) (import scheme chicken.base chicken.string chicken.port | > | > > > > > > > > > > > > > > > > > > > > > > > > | 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 | (declare (unit debugprint)) (declare (uses mtargs)) (module debugprint * ;;(import scheme chicken data-structures extras files ports) (import scheme chicken.base chicken.string chicken.port chicken.process-context (prefix mtargs args:) srfi-1 ) ;;====================================================================== ;; debug stuff ;;====================================================================== (define verbosity (make-parameter '())) (define *default-log-port* (current-error-port)) (define (debug:setup) (let ((debugstr (or (args:get-arg "-debug") (args:get-arg "-debug-noprop") (get-environment-variable "MT_DEBUG_MODE")))) (verbosity (debug:calc-verbosity debugstr 'q)) (debug:check-verbosity (verbosity) debugstr) ;; if we were handed a bad verbosity rule then we will override it with 1 and continue (if (verbosity)(verbosity 1)) (if (and (not (args:get-arg "-debug-noprop")) (or (args:get-arg "-debug") (not (get-environment-variable "MT_DEBUG_MODE")))) (set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity)) (string-intersperse (map conc (verbosity)) ",") (conc (verbosity))))))) ;; check verbosity, #t is ok (define (debug:check-verbosity verbosity vstr) (if (not (or (number? verbosity) (list? verbosity))) (begin (print "ERROR: Invalid debug value \"" vstr "\"") #f) #t)) ;;====================================================================== ;; (define (debug:print . params) #f) ;; (define (debug:print-info . params) #f) ;; ;; (define (set-functions dbgp dbgpinfo) ;; (set! debug:print dbgp) ;; (set! debug:print-info dbgpinfo)) |
︙ | ︙ |
Modified megatest.scm from [6a393624b5] to [d542feff12].
︙ | ︙ | |||
318 319 320 321 322 323 324 | (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-in) (define *didsomething* #t) (exit 1)))) | < < < < < < < < < < < < < < < < < < < < < < < < | 318 319 320 321 322 323 324 325 326 327 328 329 330 331 | (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-in) (define *didsomething* #t) (exit 1)))) ;; Disabled help items ;; -rollup : (currently disabled) fill run (set by :runname) with latest test(s) ;; from prior runs with same keys ;; -daemonize : fork into background and disconnect from stdin/out (define help (conc " Megatest, documentation at http://www.kiatoa.com/fossils/megatest |
︙ | ︙ |