Check-in [1ea16b0407]
Not logged in
Overview
SHA1 Hash:1ea16b04079981b1381a0d009fc5faa53036827b
Date: 2011-06-27 21:52:47
User: mrwellan
Comment:Removed queuing behavior when in -keepgoing mode
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Changes

Modified megatest.scm from [14746c53af9fa95d] to [b78a28ba5c5a919c].

94
95
96
97
98
99
100

101
102
103
104
105
106
107
...
113
114
115
116
117
118
119




120
121
122
123
124
125
126
		        "-xterm"
		        "-showkeys"
		        "-test-status"
		        "-gui"
			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"

		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
................................................................................
(include "configf.scm")
(include "process.scm")
(include "launch.scm")
(include "runs.scm")
;; (include "gui.scm")

(define *didsomething* #f)





;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first







>







 







>
>
>
>







94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
...
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
		        "-xterm"
		        "-showkeys"
		        "-test-status"
		        "-gui"
			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"
			"-usequeue"
		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)
................................................................................
(include "configf.scm")
(include "process.scm")
(include "launch.scm")
(include "runs.scm")
;; (include "gui.scm")

(define *didsomething* #f)

;;======================================================================
;; Misc setup stuff
;;======================================================================

;;======================================================================
;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first

Modified runs.scm from [b2c0b4b62776bb46] to [b1e1d474d08de862].

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
401
402
403
404
405
406
407

408
409
410
411
412
413
414
415

(define (register-test db run-id test-name item-path)
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (for-each 
     (lambda (pth)
       (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path) VALUES (?,?,strftime('%s','now'),?);" run-id test-name pth))
     item-paths)))

;;  (define db (open-db))
;;  (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer")

(define (test-set-status! db run-id test-name state status itemdat-or-path . comment)
  (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))))
................................................................................
						       (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
				    (launch-cmd      (lambda ()
						       (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
				    (testrundat      (list get-prereqs-cmd launch-cmd)))
			       (if (or (args:get-arg "-force")
				       (null? ((car testrundat)))) ;; are there any tests that must be run before this one...
				   ((cadr testrundat)) ;; this is the line that launches the test to the remote host

				   (hash-table-set! *waiting-queue* new-test-name testrundat))))))
		      ((KILLED) 
		       (print "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
		      ((LAUNCHED REMOTEHOSTSTART RUNNING)  
		       (if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
						     (db:test-get-run_duration testdat)))
			      100) ;; i.e. no update for more than 100 seconds
			   (begin







|







 







>
|







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416

(define (register-test db run-id test-name item-path)
  (let ((item-paths (if (equal? item-path "")
			(list item-path)
			(list item-path ""))))
    (for-each 
     (lambda (pth)
       (sqlite3:execute db "INSERT OR IGNORE INTO tests (run_id,testname,event_time,item_path,state,status) VALUES (?,?,strftime('%s','now'),?,'NOT_STARTED','n/a');" run-id test-name pth))
     item-paths)))

;;  (define db (open-db))
;;  (test-set-status! db 2 "runfirst" "COMPLETED" "PASS" "summer")

(define (test-set-status! db run-id test-name state status itemdat-or-path . comment)
  (let ((item-path (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path))))
................................................................................
						       (db-get-prereqs-not-met db run-id waiton))) ;; check before running ....
				    (launch-cmd      (lambda ()
						       (launch-test db run-id test-conf keyvallst test-name test-path itemdat)))
				    (testrundat      (list get-prereqs-cmd launch-cmd)))
			       (if (or (args:get-arg "-force")
				       (null? ((car testrundat)))) ;; are there any tests that must be run before this one...
				   ((cadr testrundat)) ;; this is the line that launches the test to the remote host
				   (if (not (args:get-arg "-keepgoing"))
				       (hash-table-set! *waiting-queue* new-test-name testrundat)))))))
		      ((KILLED) 
		       (print "NOTE: " new-test-name " is already running or was explictly killed, use -force to launch it."))
		      ((LAUNCHED REMOTEHOSTSTART RUNNING)  
		       (if (> (- (current-seconds)(+ (db:test-get-event_time testdat)
						     (db:test-get-run_duration testdat)))
			      100) ;; i.e. no update for more than 100 seconds
			   (begin