Megatest

Diff
Login

Differences From Artifact [1da1e82fdc]:

To Artifact [8ae7c5dabf]:


263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

284
285
286
287
288
289
290
291
292
293
294
295






296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313

314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")
    (if (not (args:get-arg ":runname"))
	(begin
	  (debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
	  (exit 2))
	(let* ((db      (if (setup-for-run)
			    (open-db)
			    (begin
			      (debug:print 0 "Failed to setup, exiting")
			      (exit 1)))))
	  (if (not (car *configinfo*))
	      (begin
		(debug:print 0 "ERROR: Attempted to run a test but run area config file not found")
		(exit 1))
	      ;; put test parameters into convenient variables

	      (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
		(debug:print 1 "INFO: Attempting to start the following tests...")
		(debug:print 1 "     " (string-intersperse test-names ","))
		(run-tests db test-names)))
	  ;; (run-waiting-tests db)
	  (sqlite3:finalize! db)
	  (set! *didsomething* #t))))

;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")







;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory
;; 3. update the db with "test started" status, set running host
;; 4. process launch the test
;;    - monitor the process, update stats in the db every 2^n minutes
;; 5. as the test proceeds internally it calls megatest as each step is
;;    started and completed
;;    - step started, timestamp
;;    - step completed, exit status, timestamp
;; 6. test phone home
;;    - if test run time > allowed run time then kill job
;;    - if cannot access db > allowed disconnect time then kill job


(define (runtests)
  (if (not (args:get-arg ":runname"))
      (begin
	(debug:print 0 "ERROR: Missing required parameter for -runtests, you must specify the run name with :runname runname")
	(exit 2))
      (let ((db #f))
	(if (not (setup-for-run))
	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	(set! db (open-db))
	(if (not (car *configinfo*))
	    (begin
	      (debug:print 0 "ERROR: Attempted to run a test but run area config file not found")
	      (exit 1))
	    ;; put test parameters into convenient variables
	    (let* ((test-names   (string-split (args:get-arg "-runtests") ",")))
	      (run-tests db test-names)))
	;; run-waiting-tests db)
	(sqlite3:finalize! db)
	;; (run-waiting-tests #f)
	(set! *didsomething* #t))))
	  
(if (args:get-arg "-runtests")
    (runtests))

;;======================================================================
;; execute the test
;;    - gets called on remote host
;;    - receives info from the -execute param







<
<
<
<
|
<
|
<
<
<
<
<
<
|
>
|
|
|
|
<
<
<





>
>
>
>
>
>


















>

<
|
<
<
<
|
|
<
<
|
<
<
<
<
<
|
|
<
<
<
<
|







263
264
265
266
267
268
269




270

271






272
273
274
275
276
277



278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308

309



310
311


312





313
314




315
316
317
318
319
320
321
322
;;   else
;;     put task in deferred queue
;; if still ok to run tasks
;;   process deferred tasks per above steps

;; run all tests are are Not COMPLETED and PASS or CHECK
(if (args:get-arg "-runall")




    (general-run-call 

     "-runall"






     "run all tests"
     (lambda (db keys keynames keyvallst)
       (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored for now
	 (debug:print 1 "INFO: Attempting to start the following tests...")
	 (debug:print 1 "     " (string-intersperse test-names ","))
	 (run-tests db test-names)))))




;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 
     "-rollup" 
     "rollup tests" 
     (lambda (db keys keynames keyvallst)
       (let ((n (args:get-arg "-rollup")))
	 (runs:rollup db keys keynames keyvallst n)))))

;;======================================================================
;; run one test
;;======================================================================

;; 1. find the config file
;; 2. change to the test directory
;; 3. update the db with "test started" status, set running host
;; 4. process launch the test
;;    - monitor the process, update stats in the db every 2^n minutes
;; 5. as the test proceeds internally it calls megatest as each step is
;;    started and completed
;;    - step started, timestamp
;;    - step completed, exit status, timestamp
;; 6. test phone home
;;    - if test run time > allowed run time then kill job
;;    - if cannot access db > allowed disconnect time then kill job


(define (runtests)

  (general-run-call 



   "-runtests" 
   "run a test" 


   (lambda (db keys keynames keyvallst)





     (let ((test-names (string-split (args:get-arg "-runtests") ",")))
       (run-tests db test-names)))))





(if (args:get-arg "-runtests")
    (runtests))

;;======================================================================
;; execute the test
;;    - gets called on remote host
;;    - receives info from the -execute param
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
					(if (vector-ref exit-info 1) ;; look at the exit-status
					    (if (and (not kill-job?) 
						     (eq? (vector-ref exit-info 2) 0))
						"PASS"
						"FAIL")
					    "FAIL") itemdat (args:get-arg "-m"))))
		;; for automated creation of the rollup html file this is a good place...

		(tests:summarize-items db run-id test-name #f) ;; don't force - just update if no
		)
	      (mutex-unlock! m)
	      ;; (exec-results (cmd-run->list fullrunscript)) ;;  (list ">" (conc test-name "-run.log"))))
	      ;; (success      exec-results)) ;; (eq? (cadr exec-results) 0)))
	      (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
		     work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
	      (sqlite3:finalize! db)







>
|







494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
					(if (vector-ref exit-info 1) ;; look at the exit-status
					    (if (and (not kill-job?) 
						     (eq? (vector-ref exit-info 2) 0))
						"PASS"
						"FAIL")
					    "FAIL") itemdat (args:get-arg "-m"))))
		;; for automated creation of the rollup html file this is a good place...
		(if (not (equal? item-path ""))
		   (tests:summarize-items db run-id test-name #f)) ;; don't force - just update if no
		)
	      (mutex-unlock! m)
	      ;; (exec-results (cmd-run->list fullrunscript)) ;;  (list ">" (conc test-name "-run.log"))))
	      ;; (success      exec-results)) ;; (eq? (cadr exec-results) 0)))
	      (debug:print 2 "Output from running " fullrunscript ", pid " (vector-ref exit-info 0) " in work area " 
		     work-area ":\n====\n exit code " (vector-ref exit-info 2) "\n" "====\n")
	      (sqlite3:finalize! db)