Megatest

Check-in [10d6c50ecd]
Login
Overview
Comment:Added localhost as fallback when checking for cpu load
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65
Files: files | file ages | folders
SHA1: 10d6c50ecd62eaaf8476fd1f7878a7e6a4b9bf0f
User & Date: mrwellan on 2018-07-12 11:41:53
Other Links: branch diff | manifest | tags
Context
2018-07-16
13:23
Merged the create run area change. check-in: 83edad0b8e user: mrwellan tags: v1.65
2018-07-13
17:25
Creates diectories if does not exist for the disks/paths provided Leaf check-in: 27a8f638a9 user: raghavki tags: create-disk
2018-07-12
11:41
Added localhost as fallback when checking for cpu load check-in: 10d6c50ecd user: mrwellan tags: v1.65
2018-07-10
13:47
Add a condition such that,the polling stops when it crosses 5000. check-in: 97716c5057 user: raghavki tags: v1.65
Changes

Modified common.scm from [2027cc1cac] to [5d7e225d9a].

1503
1504
1505
1506
1507
1508
1509
1510

1511
1512
1513
1514
1515
1516
1517
1503
1504
1505
1506
1507
1508
1509

1510
1511
1512
1513
1514
1515
1516
1517







-
+







     exn
     #f
     (with-output-to-file fullpath (lambda ()(pp dat))))))

;; get cpu load by reading from /proc/loadavg, return all three values
;;
(define (common:get-cpu-load remote-host)
  (let* ((actual-hostname (or remote-host (get-host-name))))
  (let* ((actual-hostname (or remote-host (get-host-name) "localhost")))
    (or (common:get-cached-info actual-hostname "cpu-load")
	(let ((result (if remote-host
			  (map (lambda (res)
				 (if (eof-object? res) 9e99 res))
			       (with-input-from-pipe 
				   (conc "ssh " remote-host " cat /proc/loadavg")
				 (lambda ()(list (read)(read)(read)))))

Modified dashboard.scm from [5534187cbe] to [b32717991f].

3438
3439
3440
3441
3442
3443
3444
3445

3446
3447
3448
3449
3450
3451
3452
3438
3439
3440
3441
3442
3443
3444

3445
3446
3447
3448
3449
3450
3451
3452







-
+







	     (file-write-access? 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") ",")))) 
	(let* ((dat     (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) 
			  (if (> (length d) 1)
			      d
			      (list #f #f))))
	       (run-id  (car dat))
	       (test-id (cadr dat)))
	  (if (and (number? run-id)
		   (number? test-id)
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482











3483
3484
3485
3486
3487
3488
3489
3465
3466
3467
3468
3469
3470
3471











3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489







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







	 (lambda ()
	   (dashboard:runs-tab-updater commondat 1))
	 tab-num: 1)
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			       (mutex-lock! (dboard:commondat-update-mutex commondat))
			       (set! update-is-running (dboard:commondat-updating commondat))
			       (if (not update-is-running)
				   (dboard:commondat-updating-set! commondat #t))
			       (mutex-unlock! (dboard:commondat-update-mutex commondat))
			       (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
				   (begin
				     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
				     (mutex-lock! (dboard:commondat-update-mutex commondat))
				     (dboard:commondat-updating-set! commondat #f)
				     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)
			     (dboard:commondat-updating-set! commondat #t))
			     (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			     (begin
			     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (dboard:commondat-updating-set! commondat #f)
			     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				   ))
			     1))))
      
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))

Modified subrun.scm from [31c8151de1] to [bb7061fde4].

71
72
73
74
75
76
77
78
79
80
81
82
83
84



85
86
87


88
89
90
91
92
93
94
95
96
97
98
99
100
101
71
72
73
74
75
76
77

78
79
80
81


82
83
84
85


86
87
88

89
90

91

92
93
94
95
96
97
98







-




-
-
+
+
+

-
-
+
+

-


-

-







        (delete-file flagfile))))


(define (subrun:testconfig-defines-subrun? testconfig)
  (configf:lookup testconfig "subrun" "runwait")) ;; we use runwait as the flag that a subrun is requested

(define (subrun:initialize-toprun-test  testconfig test-run-dir)

  (let ((ra (configf:lookup testconfig "subrun" "run-area"))
        (logpro (configf:lookup testconfig "subrun" "logpro"))
        (symlink-target (conc test-run-dir "/subrun-area"))
        )
  (when (not ra)      ;; when runarea is not set we default to *toppath*. However 
              ;; we need to force the setting in the testconfig so it will
    (if (not ra)      ;; when runarea is not set we default to *toppath*. However 
	(let ((fallback-run-area (or *toppath* (conc test-run-dir "/subrun"))))
	  ;; we need to force the setting in the testconfig so it will
          ;; be preserved in the testconfig.subrun file
      (configf:set-section-var testconfig "subrun" "run-area" *toppath*)
      (set! ra *toppath*))
	  (configf:set-section-var testconfig "subrun" "run-area" fallback-run-area)
	  (set! ra fallback-run-area)))
    (configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun

    (if (common:file-exists? symlink-target)
        (delete-file symlink-target))
    
    (create-symbolic-link ra symlink-target)

    (configf:write-alist testconfig "testconfig.subrun")))

(define (subrun:set-state-status test-run-dir state status new-state-status)
  (if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
      (let* ((action-switches-str
              (conc "-set-state-status "new-state-status
                    (if state (conc " -state "state) "")