Megatest

Check-in [7a7ceab729]
Login
Overview
Comment:Fixed read-only access issues. However it still fails if the db is old (i.e. is missing last_update field).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.62
Files: files | file ages | folders
SHA1: 7a7ceab729b0bd845be650d8202a4c2e4a4f94cc
User & Date: mrwellan on 2016-10-03 15:49:19
Other Links: branch diff | manifest | tags
Context
2016-10-03
16:24
updated the api doc check-in: 481e6c18c6 user: pjhatwal tags: v1.62
15:49
Fixed read-only access issues. However it still fails if the db is old (i.e. is missing last_update field). check-in: 7a7ceab729 user: mrwellan tags: v1.62
14:05
removed nanomsg dependency check-in: 4aaf0c61b9 user: bjbarcla tags: v1.62
Changes

Modified dashboard.scm from [af8a5f91f3] to [a779400c71].

90
91
92
93
94
95
96


97
98
99
100
101
102
103
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))



(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;







>
>







90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
      (exit)))

;; TODO: Move this inside (main)
;;
(if (not (launch:setup))
    (begin
      (print "Failed to find megatest.config, exiting") 
      (exit 1)))

;; data common to all tabs goes here
;;
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270



3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
;;  (dboard:common-run-curr-updater commondat)))
;; (set! *last-recalc-ended-time* (current-milliseconds))))))))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(define (main)



  (if (not (args:get-arg "-skip-version-check"))
      (let ((th1 (make-thread common:exit-on-version-changed)))
	(thread-start! th1)
	(if (> megatest-version (common:get-last-run-version-number))
	    (debug:print-info 0 *default-log-port* "Version bump detected, blocking until db sync complete")
	    (thread-join! th1))))
  (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") ",")))) ;; RADT couldn't find string->number, though it works
			(if (> (length d) 1)
			    d







<
<
<
<
<

>
>
>





|







3260
3261
3262
3263
3264
3265
3266





3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
;;  (dboard:common-run-curr-updater commondat)))
;; (set! *last-recalc-ended-time* (current-milliseconds))))))))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================






(define (main)
  (let ((mtdb-path (conc *toppath* "/megatest.db"))) ;; 
    (if (and (file-exists? mtdb-path)
	     (file-write-access? mtdb-path))
  (if (not (args:get-arg "-skip-version-check"))
      (let ((th1 (make-thread common:exit-on-version-changed)))
	(thread-start! th1)
	(if (> megatest-version (common:get-last-run-version-number))
	    (debug:print-info 0 *default-log-port* "Version bump detected, blocking until db sync complete")
		  (thread-join! th1)))))
  (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") ",")))) ;; RADT couldn't find string->number, though it works
			(if (> (length d) 1)
			    d
3336
3337
3338
3339
3340
3341
3342
3343





3344
3345
3346
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
			      ;; (dboard:commondat-please-update-set! commondat #t) ;; MRW: ww36.3 - why was please update set true here? Removing it for now.
			      ;; (dashboard:run-update commondat)
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      ;; (thread-start! th1)
      (thread-start! th2)
      (thread-join! th2))))






(main)








|
>
>
>
>
>



3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
			      (dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
			      ;; (dboard:commondat-please-update-set! commondat #t) ;; MRW: ww36.3 - why was please update set true here? Removing it for now.
			      ;; (dashboard:run-update commondat)
			      ) "update buttons once"))
	  (th2 (make-thread iup:main-loop "Main loop")))
      ;; (thread-start! th1)
      (thread-start! th2)
	(thread-join! th2)))))

;; ease debugging by loading ~/.dashboardrc
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc")))
  (if (file-exists? debugcontrolf)
      (load debugcontrolf)))

(main)

Modified launch.scm from [8739862733] to [a58a11e1e1].

699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)
;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup-new #!key (force #f))
  (let* ((toppath  (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
	 (runname  (common:args-get-runname))
	 (target   (common:args-get-target))
	 (linktree (common:get-linktree))
	 (sections (if target (list "default" target) #f)) ;; for runconfigs
	 (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config 
	 (rundir   (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))







|







699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
;;   returns:
;;     *toppath*
;;   side effects:
;;     sets; *configdat*    (megatest.config info)
;;           *runconfigdat* (runconfigs.config info)
;;           *configstatus* (status of the read data)
;;
(define (launch:setup #!key (force #f))
  (let* ((toppath  (or *toppath* (getenv "MT_RUN_AREA_HOME"))) ;; preserve toppath
	 (runname  (common:args-get-runname))
	 (target   (common:args-get-target))
	 (linktree (common:get-linktree))
	 (sections (if target (list "default" target) #f)) ;; for runconfigs
	 (mtconfig (or (args:get-arg "-config") "megatest.config")) ;; allow overriding megatest.config 
	 (rundir   (if (and runname target linktree)(conc linktree "/" target "/" runname) #f))
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
    (if (and *toppath*
	     (directory-exists? *toppath*))
	(setenv "MT_RUN_AREA_HOME" *toppath*)
	(begin
	  (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
    *toppath*))

(define launch:setup launch:setup-new)

(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))
    (if disks 
	(let ((res (common:get-disk-with-most-free-space disks minspace))) ;; min size of 1000, seems tad dumb







<
<







827
828
829
830
831
832
833


834
835
836
837
838
839
840
    (if (and *toppath*
	     (directory-exists? *toppath*))
	(setenv "MT_RUN_AREA_HOME" *toppath*)
	(begin
	  (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
    *toppath*))



(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))
    (if disks 
	(let ((res (common:get-disk-with-most-free-space disks minspace))) ;; min size of 1000, seems tad dumb