Megatest

Check-in [776745031a]
Login
Overview
Comment:updated testpanel launcher to launch dashboard rather than sourcing cfg.sh then dboard as
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-catch-failed-launch
Files: files | file ages | folders
SHA1: 776745031ae77aa2af8cafe7d4f6084780499182
User & Date: bjbarcla on 2018-01-19 14:56:09
Other Links: branch diff | manifest | tags
Context
2018-01-19
17:42
fixed issue in subrun:get-runarea Leaf check-in: ece2bfcae2 user: bjbarcla tags: v1.65-catch-failed-launch
14:56
updated testpanel launcher to launch dashboard rather than sourcing cfg.sh then dboard as check-in: 776745031a user: bjbarcla tags: v1.65-catch-failed-launch
10:29
added message for launch failure check-in: 3d4ae9e02e user: bjbarcla tags: v1.65-catch-failed-launch
Changes

Modified common.scm from [95706b6dd6] to [16edb8a716].

1023
1024
1025
1026
1027
1028
1029
1030

1031
1032
1033
1034

1035


1036
1037
1038
1039
1040
1041
1042
1023
1024
1025
1026
1027
1028
1029

1030
1031
1032
1033
1034
1035

1036
1037
1038
1039
1040
1041
1042
1043
1044







-
+




+
-
+
+







(define (common:false-on-exception thunk #!key (message #f))
  (handle-exceptions exn
                     (begin
                       (if message
                           (debug:print-info 0 *default-log-port* message))
                       #f) (thunk) ))

(define (common:file-exists? path-string)
(define (common:file-exists? path-string #!key (silent #f))
  ;; this avoids stack dumps in the case where 

  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings, eg:  system error while trying to access file: "/nfs/pdx/disks/icf_env_disk001/bjbarcla/gwa/issues/mtdev/randy-slow/reproduce/q...
  (common:false-on-exception (lambda () (file-exists? path-string))
                             message: (if (not silent)
                             message: (conc "Unable to access path: " path-string)
                                          (conc "Unable to access path: " path-string)
                                          #f)
                             ))

(define (common:directory-exists? path-string)
  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings, eg:  system error while trying to access file: "/nfs/pdx/disks/icf_env_disk001/bjbarcla/gwa/issues/mtdev/randy-slow/reproduce/q...
  (common:false-on-exception (lambda () (directory-exists? path-string))
                             message: (conc "Unable to access path: " path-string)
                             ))

Modified dashboard-tests.scm from [4a059bb6ef] to [531072a2c7].

244
245
246
247
248
249
250
251

252
253
254
255
256
257
258
244
245
246
247
248
249
250

251
252
253
254
255
256
257
258







-
+







	    )))))

;; if there is a submegatest create a button to launch dashboard in that area
;;
(define (submegatest-panel dbstruct keydat testdat runname testconfig)
  (let* ((test-run-dir      (db:test-get-rundir testdat))
	 (subarea           (subrun:get-runarea test-run-dir))
	 (area-exists       (and subarea (common:file-exists? subarea))))
	 (area-exists       (and subarea (common:file-exists? subarea silent: #t))))
    (if subarea
	(iup:frame 
	 #:title "Megatest Run Info" ; #:expand "YES"
	 (iup:button
	  "Launch Dashboard"
	  #:action (lambda (obj)
                     (subrun:launch-dashboard test-run-dir))))

Modified dashboard.scm from [36a3358eb5] to [414a79db6e].

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339











340
341
342
343
344
345
346
325
326
327
328
329
330
331








332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349







-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+







                          (lambda (alist-entry)
                            (member (car alist-entry)
                                    '(allruns-by-id allruns))) ;; FIELDS OF INTEREST
                          (dboard:tabdat->alist tabdat-item)))))


(define (dboard:launch-testpanel run-id test-id)
  (let* ((cfg-sh  (conc *common:this-exe-dir* "/cfg.sh"))
         (cmd (conc
               (if (common:file-exists? cfg-sh)
                   (conc "source "cfg-sh" && ")
                   "")
               *common:this-exe-fullpath*
               " -test " run-id "," test-id
               " &")))
  (let* (;; (cfg-sh  (conc *common:this-exe-dir* "/cfg.sh"))
         ;; (cmd (conc
         ;;       (if (common:file-exists? cfg-sh)
         ;;           (conc "source "cfg-sh" && ")
         ;;           "")
         ;;       *common:this-exe-fullpath*
         ;;       " -test " run-id "," test-id
         ;;       " &"))
         (cmd (conc *common:this-exe-dir*"/../dashboard "
                    "-test " run-id "," test-id
                    " &")))
    (system cmd)))

(define (dboard:tabdat-target-string vec)
  (let ((targ (dboard:tabdat-target vec)))
    (if (list? targ)(string-intersperse targ "/") "no-target-specified")))

(define (dboard:tabdat-test-patts-use vec)