Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -42,10 +42,19 @@ ;; (define (exit . code) ;; (if (null? code) ;; (old-exit) ;; (old-exit code))) +(define (common:debug-setup) + (debug:setup (cond ;; debug arg + ((args:get-arg "-debug-noprop") 'noprop) + ((args:get-arg "-debug") #t) + (else #f)) + (cond ;; verbosity arg + ((args:get-arg "-q") 'v) + ((args:get-arg "-q") 'q) + (else #f)))) ;; execute thunk, return value. If exception thrown, trap exception, return #f, and emit nonfatal condition note to *default-log-port* . ;; arguments - thunk, message (define (common:fail-safe thunk warning-message-on-exception) (handle-exceptions Index: commonmod.scm ================================================================== --- commonmod.scm +++ commonmod.scm @@ -209,15 +209,15 @@ (not (null? (lset-intersection! eq? vb n)))) ((and (number? vb) (list? n)) (member vb n))))) -(define (debug:setup debug-arg) ;; debug-arg= #f, #t or 'noprop +(define (debug:setup debug-arg verbose-arg) ;; debug-arg= #f, #t or 'noprop (let ((debugstr (or debug-arg ;; (args:get-arg "-debug") ;; (args:get-arg "-debug-noprop") (get-environment-variable "MT_DEBUG_MODE")))) - (debug:calc-verbosity debugstr) + (debug:calc-verbosity debugstr verbose-arg) ;; (debug:check-verbosity *verbosity* debugstr) ;; if we were handed a bad verbosity rule then we will override it with 1 and continue (if (not (verbosity))(set! (verbosity) 1)) (if (and (not (eq? debug-arg 'noprop)) (or debug-arg Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -25,10 +25,13 @@ (use regex regex-case matchable) ;; directory-utils) (declare (unit configf)) (declare (uses process)) (declare (uses env)) (declare (uses keys)) + +(declare (uses commonmod)) +(import commonmod) (include "common_records.scm") ;; return list (path fullpath configname) (define (find-config configname #!key (toppath #f)) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -54,11 +54,11 @@ (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") +;; (include "megatest-fossil-hash.scm") (include "vg_records.scm") (define help (conc "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version " @@ -354,18 +354,18 @@ tests-tree ;; used in newdashboard ) ;; 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))))) +;; (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))))) (define (dboard:tabdat-target-string vec) (let ((targ (dboard:tabdat-target vec))) @@ -504,18 +504,18 @@ 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))))) +;; (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))))) (define (dboard:rundat-make-init #!key (run #f)(key-vals #f)(tests #f));; -100 is before time began @@ -581,11 +581,11 @@ 3))) (define (get-curr-sort) (vector-ref *tests-sort-options* *tests-sort-reverse*)) -(debug:setup) +(common:debug-setup) ;; (define uidat #f) (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) (define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1)) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -27,10 +27,14 @@ (declare (unit dcommon)) (declare (uses gutils)) (declare (uses db)) + +(declare (uses commonmod)) +(import commonmod) + ;; (declare (uses synchash)) (include "megatest-version.scm") (include "common_records.scm") (include "db_records.scm") Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -657,14 +657,11 @@ ;;====================================================================== ;; Misc setup stuff ;;====================================================================== -(debug:setup (cond - ((args:get-arg "-debug-noprop") 'noprop) - ((args:get-arg "-debug") #t) - (else #f))) +(common:debug-setup) ;; (if (args:get-arg "-logging")(set! *logging* #t)) ;;(if (debug:debug-mode 3) ;; we are obviously debugging ;; (set! open-run-close open-run-close-no-exception-handling)) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -21,10 +21,13 @@ (use format typed-records) ;; RADT => purpose of json format?? (declare (unit rmt)) (declare (uses api)) (declare (uses http-transport)) + +(declare (uses commonmod)) +(import commonmod) (include "common_records.scm") ;; (declare (uses rmtmod)) ;; (import rmtmod)