Megatest

Check-in [78985bc0f1]
Login
Overview
Comment:Bumped version. Removed sig/stop from exit handler. Added calls to load <stepname>.dat into db
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.61
Files: files | file ages | folders
SHA1: 78985bc0f17662f983cd95a0b8a0bb405b588b3e
User & Date: mrwellan on 2016-05-09 10:05:47
Other Links: branch diff | manifest | tags
Context
2016-05-09
12:33
Refactored launch.scm run and monitor jobs code check-in: 5b74ca3241 user: mrwellan tags: v1.61
10:05
Bumped version. Removed sig/stop from exit handler. Added calls to load <stepname>.dat into db check-in: 78985bc0f1 user: mrwellan tags: v1.61
2016-05-08
23:49
Added -clean-cache check-in: 97837ebda4 user: matt tags: v1.61
Changes

Modified launch.scm from [e2e9ee1a64] to [d762027aa5].

53
54
55
56
57
58
59








60
61
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85







+
+
+
+
+
+
+
+










+







  (let ((enccmd (if encoded-cmd encoded-cmd (getenv "MT_CMDINFO"))))
    (if enccmd
	(common:read-encoded-string enccmd)
	'())))

;;                       0           1              2              3
(defstruct launch:einf (pid #t)(exit-status #t)(exit-code #t)(rollup-status 0))

(define (launch:load-logpro-dat stepname)
  (let* ((dat  (read-config (conc stepname ".dat") #f #f))
	 (csvr (db:logpro-dat->csv dat stepname))
	 (csvt (let-values (( (fmt-cell fmt-record fmt-csv) (make-format ",")))
			   (fmt-csv (map list->csv-record csvr)))))
    (rmt:csv->test-data run-id test-id csvt)))


(define (launch:runstep ezstep run-id test-id exit-info m tal testconfig)
  (let* ((stepname       (car ezstep))  ;; do stuff to run the step
	 (stepinfo       (cadr ezstep))
	 (stepparts      (string-match (regexp "^(\\{([^\\}]*)\\}\\s*|)(.*)$") stepinfo))
	 (stepparms      (list-ref stepparts 2)) ;; for future use, {VAR=1,2,3}, run step for each 
	 (stepcmd        (list-ref stepparts 3))
	 (script         "") ; "#!/bin/bash\n") ;; yep, we depend on bin/bash FIXME!!!\
	 (logpro-file    (conc stepname ".logpro"))
	 (html-file      (conc stepname ".html"))
	 (dat-file       (conc stepname ".dat"))
	 (tconfig-logpro (configf:lookup testconfig "logpro" stepname))
	 (logpro-used    (file-exists? logpro-file)))

    (if (and tconfig-logpro
	     (not logpro-used)) ;; no logpro file found but have a defn in the testconfig
	(begin
	  (with-output-to-file logpro-file
132
133
134
135
136
137
138




139

140
141
142
143
144
145
146
141
142
143
144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
159







+
+
+
+
-
+







			      (processloop (+ i 1)))))
	    (debug:print-info 0 "logpro for step " stepname " exited with code " (launch:einf-exit-code exit-info))))) ;; (vector-ref exit-info 2)))))
    
    (let ((exinfo (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
	  (logfna (if logpro-used (conc stepname ".html") "")))
      (rmt:teststep-set-status! run-id test-id stepname "end" exinfo #f logfna))
    (if logpro-used
	(let ((datfile (conc stepname ".dat")))
	  ;; load the .dat file into the test_data table if it exists
	  (if (file-exists? datfile)
	      (launch:load-logpro-dat stepname))
	(rmt:test-set-log! run-id test-id (conc stepname ".html")))
	(rmt:test-set-log! run-id test-id (conc stepname ".html"))))
    ;; set the test final status
    (let* ((process-exit-status (launch:einf-exit-code exit-info)) ;; (vector-ref exit-info 2))
	   (this-step-status (cond
			      ((and (eq? process-exit-status 2) logpro-used) 'warn)   ;; logpro 2 = warnings
			      ((and (eq? process-exit-status 3) logpro-used) 'check)  ;; logpro 3 = check
			      ((and (eq? process-exit-status 4) logpro-used) 'waived) ;; logpro 4 = waived
			      ((and (eq? process-exit-status 5) logpro-used) 'abort)  ;; logpro 5 = abort
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289
285
286
287
288
289
290
291

292
293


294
295
296
297
298
299
300







-
+

-
-







						     (debug:print 0 "Done")
						     (exit 4)))))
			     (thread-start! th2)
			     (thread-start! th1)
			     (thread-join! th2)))))
	    (set-signal-handler! signal/int sighand)
	    (set-signal-handler! signal/term sighand)
	    (set-signal-handler! signal/stop sighand))
	    ) ;; (set-signal-handler! signal/stop sighand)
	  
	  ;; (set-signal-handler! signal/int (lambda ()
					    
	  ;; Do not run the test if it is REMOVING, RUNNING, KILLREQ or REMOTEHOSTSTART,
	  ;; Mark the test as REMOTEHOSTSTART *IMMEDIATELY*
	  ;;
	  (let* ((test-info (rmt:get-test-info-by-id run-id test-id))
		 (test-host (db:test-get-host        test-info))
		 (test-pid  (db:test-get-process_id  test-info)))
	    (cond
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408

409
410
411
412
413
414
415
399
400
401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426







-
+












-
+







	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")
	  ;; open-run-close not needed for test-set-meta-info
	  ;; (tests:set-full-meta-info #f test-id run-id 0 work-area)
	  ;; (tests:set-full-meta-info test-id run-id 0 work-area)
	  (tests:set-full-meta-info #f test-id run-id 0 work-area 10)

	  (thread-sleep! 0.3) ;; NFS slowness has caused grief here
	  ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here

	  (if (args:get-arg "-xterm")
	      (set! fullrunscript "xterm")
	      (if (and fullrunscript 
		       (file-exists? fullrunscript)
		       (not (file-execute-access? fullrunscript)))
		  (system (conc "chmod ug+x " fullrunscript))))

	  ;; We are about to actually kick off the test
	  ;; so this is a good place to remove the records for 
	  ;; any previous runs
	  ;; (db:test-remove-steps db run-id testname itemdat)
	  
	  ;; 
	  (let* ((m            (make-mutex))
		 (kill-job?    #f)
		 (exit-info    (make-launch:einf pid: #t exit-status: #t exit-code: #t rollup-status: 0)) ;; pid exit-status exit-code (i.e. process was successfully run) rollup-status
		 (job-thread   #f)
		 (keep-going   #t)
		 (runit        (lambda ()
				 ;; (let-values
474
475
476
477
478
479
480
481
482

483
484
485
486
487
488
489
490
491
492
485
486
487
488
489
490
491


492



493
494
495
496
497
498
499







-
-
+
-
-
-







						      (prevstep #f))
					     ;; check exit-info (vector-ref exit-info 1)
					     (if (launch:einf-exit-status exit-info) ;; (vector-ref exit-info 1)
						 (let ((logpro-used (launch:runstep ezstep run-id test-id exit-info m tal testconfig))
						       (stepname    (car ezstep)))
						   ;; if logpro-used read in the stepname.dat file
						   (if (and logpro-used (file-exists? (conc stepname ".dat")))
						       (let* ((dat  (read-config (conc stepname ".dat") #f #f))
							      (csvr (db:logpro-dat->csv dat stepname))
						       (launch:load-logpro-dat stepname))
							      (csvt (let-values (( (fmt-cell fmt-record fmt-csv) (make-format ",")))
								      (fmt-csv (map list->csv-record csvr)))))
							 (rmt:csv->test-data run-id test-id csvt)))
						   (if (steprun-good? logpro-used (launch:einf-exit-code exit-info))
						       (if (not (null? tal))
							   (loop (car tal) (cdr tal) stepname))
						       (debug:print 4 "WARNING: step " (car ezstep) " failed. Stopping")))
						 (debug:print 4 "WARNING: a prior step failed, stopping at " ezstep))))))))
		 (monitorjob   (lambda ()
				 (let* ((start-seconds (current-seconds))

Modified megatest-version.scm from [36f50f6de5] to [1d4899be81].

1
2

3
4
5
6

7
1

2
3
4
5

6
7

-
+



-
+

;; Always use two or four digit decimal
;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00..
;; 1.01, 1.02...1.10,1.11,1.1101 ... 1.99,2.00..

(declare (unit megatest-version))

(define megatest-version 1.6101)
(define megatest-version 1.6102)