Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -80,30 +80,31 @@ (configf:include-rx ( x include-file ) (begin (read-config include-file res allow-system environ-patt: environ-patt) (loop (read-line inp) curr-section-name #f #f))) (configf:section-rx ( x section-name ) (loop (read-line inp) section-name #f #f)) (configf:key-sys-pr ( x key cmd ) (if allow-system - (let ((alist (hash-table-ref/default res curr-section-name '())) - (val-proc (lambda () - (let* ((cmdres (cmd-run->list cmd)) - (status (cadr cmdres)) - (res (car cmdres))) - (if (not (eq? status 0)) - (begin - (debug:print 0 "ERROR: problem with " inl ", return code " status) - (exit 1))) - (if (null? res) - "" - (string-intersperse res " ")))))) - (hash-table-set! res curr-section-name - (config:assoc-safe-add alist - key - (if (eq? allow-system 'return-procs) - val-proc - (val-proc)))) - (loop (read-line inp) curr-section-name #f #f)) - (loop (read-line inp) curr-section-name #f #f))) + (let ((alist (hash-table-ref/default res curr-section-name '())) + (val-proc (lambda () + (let* ((cmdres (cmd-run->list cmd)) + (status (cadr cmdres)) + (res (car cmdres))) + (if (not (eq? status 0)) + (begin + (debug:print 0 "ERROR: problem with " inl ", return code " status) + (exit 1))) + (if (null? res) + "" + (string-intersperse res " ")))))) + (hash-table-set! res curr-section-name + (config:assoc-safe-add alist + key + (case allow-system + ((return-procs) val-proc) + ((return-string) cmd) + (else (val-proc))))) + (loop (read-line inp) curr-section-name #f #f)) + (loop (read-line inp) curr-section-name #f #f))) (configf:key-val-pr ( x key val ) (let* ((alist (hash-table-ref/default res curr-section-name '())) (envar (and environ-patt (string-match (regexp environ-patt) curr-section-name))) (realval (if envar (config:eval-string-in-environment val) val))) Index: dashboard-main.scm ================================================================== --- dashboard-main.scm +++ dashboard-main.scm @@ -55,11 +55,11 @@ (define (mtest) (let* ((curr-row-num 0) (rawconfig (read-config (conc *toppath* "/megatest.config") #f 'return-string)) (keys-matrix (iup:matrix - #:expand "YES" + #:expand "VERTICAL" ;; #:scrollbar "YES" #:numcol 1 #:numlin 20 #:numcol-visible 1 #:numlin-visible 5 @@ -78,11 +78,11 @@ #:numcol-visible 1 #:numlin-visible 3)) (validvals-matrix (iup:matrix #:expand "YES" #:numcol 1 - #:numlin 5 + #:numlin 2 #:numcol-visible 1 #:numlin-visible 2)) (envovrd-matrix (iup:matrix #:expand "YES" #:numcol 1 @@ -95,20 +95,15 @@ #:numlin 20 #:numcol-visible 1 #:numlin-visible 8))) (iup:attribute-set! keys-matrix "0:0" "Field Num") (iup:attribute-set! keys-matrix "0:1" "Field Name") - (for-each - (lambda (mat) - (iup:attribute-set! mat "0:1" "Value") - (iup:attribute-set! mat "0:0" "Var") - (iup:attribute-set! mat "ALIGNMENT1" "ALEFT") - (iup:attribute-set! mat "FIXTOTEXT" "C1") - (iup:attribute-set! mat "RESIZEMATRIX" "YES")) - (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix)) + (iup:attribute-set! keys-matrix "WIDTH1" "100") (iup:attribute-set! disks-matrix "0:0" "Disk Name") (iup:attribute-set! disks-matrix "0:1" "Disk Path") + (iup:attribute-set! disks-matrix "WIDTH1" "120") + (iup:attribute-set! disks-matrix "WIDTH0" "100") (iup:attribute-set! disks-matrix "ALIGNMENT1" "ALEFT") (iup:attribute-set! disks-matrix "FIXTOTEXT" "C1") (iup:attribute-set! disks-matrix "RESIZEMATRIX" "YES") ;; fill in keys (set! curr-row-num 1) @@ -130,38 +125,62 @@ (set! curr-row-num (+ curr-row-num 1))) (configf:section-vars rawconfig fname))) (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix disks-matrix) (list "setup" "jobtools" "validvalues" "env-override" "disks")) + (for-each + (lambda (mat) + (iup:attribute-set! mat "0:1" "Value") + (iup:attribute-set! mat "0:0" "Var") + (iup:attribute-set! mat "ALIGNMENT1" "ALEFT") + (iup:attribute-set! mat "FIXTOTEXT" "C1") + (iup:attribute-set! mat "RESIZEMATRIX" "YES") + (iup:attribute-set! mat "WIDTH1" "120") + (iup:attribute-set! mat "WIDTH0" "100") + ) + (list setup-matrix jobtools-matrix validvals-matrix envovrd-matrix)) + (iup:vbox (iup:hbox - ;; The keys - (iup:frame - #:title "Keys" - keys-matrix) - (iup:vbox - ;; The setup section - (iup:frame - #:title "Setup" - setup-matrix) - ;; The jobtools - (iup:frame - #:title "Jobtools" - jobtools-matrix) - ;; The valid values - (iup:frame - #:title "Validvalues" - validvals-matrix)) - (iup:vbox - ;; The Environment Overrides - (iup:frame - #:title "Env override" - envovrd-matrix) - ;; The disks - (iup:frame - #:title "Disks" - disks-matrix)) + ;; The keys + (iup:frame + #:title "Keys (required)" + (iup:vbox + (iup:label (conc "Set the fields for organising your runs\n" + "here. Note: can only be changed before\n" + "running the first run when megatest.db\n" + "is created.")) + keys-matrix)) + (iup:vbox + (let ((tabs (iup:tabs + ;; The required tab + (iup:vbox + ;; The setup section + (iup:frame + #:title "Setup" + setup-matrix) + ;; The jobtools + (iup:frame + #:title "Jobtools" + jobtools-matrix) + ;; The valid values + ;; The disks + (iup:frame + #:title "Disks" + disks-matrix)) + (iup:vbox + ;; The Environment Overrides + (iup:frame + #:title "Env override" + envovrd-matrix) + (iup:frame + #:title "Validvalues" + validvals-matrix) + )))) + (iup:attribute-set! tabs "TABTITLE0" "Required settings") + (iup:attribute-set! tabs "TABTITLE1" "Optional settings") + tabs)) )))) (define (rconfig) (iup:vbox (iup:frame #:title "Default"))) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -371,17 +371,17 @@ (key-vals (get-key-vals db run-id)) (key-str (string-intersperse key-vals "/")) (dfullp (conc disk-path "/" key-str "/" runname "/" testname item-path)) (toptest-path (conc disk-path "/" key-str "/" runname "/" testname)) - (runsdir (let ((rd (config-lookup *configdat* "setup" "runsdir"))) + (linktree (let ((rd (config-lookup *configdat* "setup" "linktree"))) (if rd rd (conc *toppath* "/runs")))) - (lnkpath (conc runsdir "/" key-str "/" runname item-path))) - (if (not (file-exists? runsdir)) + (lnkpath (conc linktree "/" key-str "/" runname item-path))) + (if (not (file-exists? linktree)) (begin - (debug:print 0 "WARNING: runsdir did not exist! Creating it now at " runsdir) - (system (conc "mkdir -p " runsdir)))) + (debug:print 0 "WARNING: linktree did not exist! Creating it now at " linktree) + (system (conc "mkdir -p " linktree)))) ;; since this is an iterated test this is as good a place as any to ;; update the toptest record with its location rundir (if (not (equal? item-path "")) (db:test-set-rundir! db run-id testname "" toptest-path)) (debug:print 2 "Setting up test run area") Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -4,11 +4,11 @@ datapath TEXT [setup] # exectutable /path/to/megatest max_concurrent_jobs 50 -runsdir /tmp/runs +linktree /tmp/runs [jobtools] # useshell yes # ## launcher launches jobs, the job is managed on the target host ## by megatest, comment out launcher to run local