Megatest

Check-in [7d33809fbf]
Login
Overview
Comment:Fixed few problems with actual launching of runs.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | run-mgr
Files: files | file ages | folders
SHA1: 7d33809fbf8f0986e441902d48f1324561985589
User & Date: matt on 2017-02-13 22:48:29
Other Links: branch diff | manifest | tags
Context
2017-02-13
23:58
Added basics of -contour support. db still needed, also some other changes in this commit. check-in: 0f4fa8cf1a user: matt tags: run-mgr
22:48
Fixed few problems with actual launching of runs. check-in: 7d33809fbf user: matt tags: run-mgr
22:04
File sensing now working check-in: a83fac111f user: matt tags: run-mgr
Changes

Modified common.scm from [a19079c68b] to [e8e9c53bae].

849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
(define (common:args-get-state)
  (or (args:get-arg "-state")(args:get-arg ":state")))

(define (common:args-get-status)
  (or (args:get-arg "-status")(args:get-arg ":status")))

(define (common:args-get-testpatt rconf)
  (let* ((tagexpr (args:get-arg "-tagexpr"))
         (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
         (testpatt-key  (if (args:get-arg "--modepatt") (args:get-arg "--modepatt") "TESTPATT"))
         (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
         (rtestpatt     (if rconf (runconfigs-get rconf testpatt-key) #f)))
    (cond
     (tags-testpatt
      (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
      tags-testpatt)
     ((and (equal? args-testpatt "%") rtestpatt)
      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
      rtestpatt)
     (else args-testpatt))))
     
(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")







|
|




|
|
|







849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
(define (common:args-get-state)
  (or (args:get-arg "-state")(args:get-arg ":state")))

(define (common:args-get-status)
  (or (args:get-arg "-status")(args:get-arg ":status")))

(define (common:args-get-testpatt rconf)
  (let* (;; (tagexpr       (args:get-arg "-tagexpr"))
         ;; (tags-testpatt (if tagexpr (string-join (runs:get-tests-matching-tags tagexpr) ",") #f))
         (testpatt-key  (if (args:get-arg "--modepatt") (args:get-arg "--modepatt") "TESTPATT"))
         (args-testpatt (or (args:get-arg "-testpatt") (args:get-arg "-runtests") "%"))
         (rtestpatt     (if rconf (runconfigs-get rconf testpatt-key) #f)))
    (cond
     ;; (tags-testpatt
     ;;  (debug:print-info 0 *default-log-port* "-tagexpr "tagexpr" selects testpatt "tags-testpatt)
     ;;  tags-testpatt)
     ((and (equal? args-testpatt "%") rtestpatt)
      (debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
      rtestpatt)
     (else args-testpatt))))
     
(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")

Modified mtut.scm from [e2f38ea970] to [e088c8d9d0].

248
249
250
251
252
253
254
255
256


257
258
259
260
261
262
263

;;======================================================================
;; Runs
;;======================================================================

;; make a runname
;;
(define (make-runname valparts)
  "ww07.1a")



;; collect, translate, collate and assemble a pkt from the command-line
;;
(define (command-line->pkt action args-alist)
  (let* ((args-data (if args-alist
			args-alist
			(hash-table->alist args:arg-hash)))







|
<
>
>







248
249
250
251
252
253
254
255

256
257
258
259
260
261
262
263
264

;;======================================================================
;; Runs
;;======================================================================

;; make a runname
;;
(define (make-runname pre post)

 (time->string
  (seconds->local-time (current-seconds)) "%Yw%V.%w-%H%M"))

;; collect, translate, collate and assemble a pkt from the command-line
;;
(define (command-line->pkt action args-alist)
  (let* ((args-data (if args-alist
			args-alist
			(hash-table->alist args:arg-hash)))
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
	       (let* ((key        (car sense))
		      (val        (cadr sense))
		      (keyparts   (string-split key ":"))
		      (contour    (car keyparts))
		      (ruletype   (let ((res (cdr keyparts)))
				    (if (null? res) #f (cadr keyparts))))
		      (valparts   (string-split val)) ;; runname-rule params
		      (runname    (make-runname #f))
		      (runstarts  (find-pkts pdb '(runstart) `((o . ,contour)
							       (t . ,runkey))))
		      (rspkts     (map (lambda (x)
					 (alist-ref 'pkta x))
				       runstarts))
		      (starttimes ;; sort by age (youngest first) and delete duplicates by target
		       (delete-duplicates







|







345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
	       (let* ((key        (car sense))
		      (val        (cadr sense))
		      (keyparts   (string-split key ":"))
		      (contour    (car keyparts))
		      (ruletype   (let ((res (cdr keyparts)))
				    (if (null? res) #f (cadr keyparts))))
		      (valparts   (string-split val)) ;; runname-rule params
		      (runname    (make-runname "" ""))
		      (runstarts  (find-pkts pdb '(runstart) `((o . ,contour)
							       (t . ,runkey))))
		      (rspkts     (map (lambda (x)
					 (alist-ref 'pkta x))
				       runstarts))
		      (starttimes ;; sort by age (youngest first) and delete duplicates by target
		       (delete-duplicates
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
	     keydats)))
	(hash-table-keys rgconf))
       
       ;; now have torun populated
       (for-each
	(lambda (contour)
	  (let* ((mode-tag  (string-split (or (configf:lookup mtconf "contours" contour) "") "/"))
		 (mode-patt (if (eq? (length mode-tag) 2)(cadr mode-tag) #f))
		 (tag-expr  (if (null? mode-tag) #f (car mode-tag))))
	    (for-each
	     (lambda (runkeydat)
	       (let* ((runkey (car runkeydat))
		      (info   (cadr runkeydat)))
		 (for-each
		  (lambda (area)
		    (let ((runname (cadr info))







|
|







388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
	     keydats)))
	(hash-table-keys rgconf))
       
       ;; now have torun populated
       (for-each
	(lambda (contour)
	  (let* ((mode-tag  (string-split (or (configf:lookup mtconf "contours" contour) "") "/"))
		 (tag-expr  (if (eq? (length mode-tag) 2)(cadr mode-tag) #f))
		 (mode-patt (if (null? mode-tag) #f (car mode-tag))))
	    (for-each
	     (lambda (runkeydat)
	       (let* ((runkey (car runkeydat))
		      (info   (cadr runkeydat)))
		 (for-each
		  (lambda (area)
		    (let ((runname (cadr info))

Modified runs.scm from [a06e687141] to [26d4a85389].

209
210
211
212
213
214
215
216

217
218
219
220
221
222
223
	 (all-tests-registry #f)  ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
	 (all-test-names     #f)  ;; (hash-table-keys all-tests-registry))
	 (test-names         #f)  ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
	 (required-tests     #f)  ;; Put fully qualified test/testpath names in this list to be done
	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
	 (tdbdat             (tasks:open-db))
	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
			       (if x (string->number x) #f))))


    ;; per user request. If less than 100Meg space on dbdir partition, bail out with error
    ;; this will reduce issues in database corruption
    (common:check-db-dir-and-exit-if-insufficient)
    
    ;; override the number of reruns from the configs
    (if (and config-reruns







|
>







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
	 (all-tests-registry #f)  ;; (tests:get-all)) ;; (tests:get-valid-tests (make-hash-table) test-search-path)) ;; all valid tests to check waiton names
	 (all-test-names     #f)  ;; (hash-table-keys all-tests-registry))
	 (test-names         #f)  ;; Generated by a call to (tests:filter-test-names all-test-names test-patts))
	 (required-tests     #f)  ;; Put fully qualified test/testpath names in this list to be done
	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
	 (tdbdat             (tasks:open-db))
	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
			       (if x (string->number x) #f)))
	 (allowed-tests      #f))

    ;; per user request. If less than 100Meg space on dbdir partition, bail out with error
    ;; this will reduce issues in database corruption
    (common:check-db-dir-and-exit-if-insufficient)
    
    ;; override the number of reruns from the configs
    (if (and config-reruns
251
252
253
254
255
256
257


258
259
260
261
262
263
264
265

266




267
268
269
270
271
272
273
		      (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
		      (begin
			(debug:print 0 *default-log-port* "WARNING: You do not have a run config file: " runconfigf)
			#f)))

    (if (not test-patts) ;; first time in - adjust testpatt
	(set! test-patts (common:args-get-testpatt runconf)))



    ;; register this run in monitor.db
    (rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
    (rmt:tasks-set-state-given-param-key task-key "running")

    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all))   ;; hash of testname => path-to-test
    (set! all-test-names     (hash-table-keys all-tests-registry))

    (set! test-names         (tests:filter-test-names all-test-names test-patts))





    ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.

    ;; NEW STRATEGY HERE:
    ;; 1. fill required tests with test-patts
    ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt
    ;; 3. repeat until all deps propagated







>
>








>
|
>
>
>
>







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
		      (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
		      (begin
			(debug:print 0 *default-log-port* "WARNING: You do not have a run config file: " runconfigf)
			#f)))

    (if (not test-patts) ;; first time in - adjust testpatt
	(set! test-patts (common:args-get-testpatt runconf)))
    (if (args:get-arg "-tagexpr")
	(set! allowed-tests (string-join (runs:get-tests-matching-tags (args:get-arg "-tagexpr")) ","))) ;; tests will be ANDed with this list

    ;; register this run in monitor.db
    (rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
    (rmt:tasks-set-state-given-param-key task-key "running")

    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all))   ;; hash of testname => path-to-test
    (set! all-test-names     (hash-table-keys all-tests-registry))
    ;; filter first for allowed-tests (from -tagexpr) then for test-patts.
    (set! test-names         (tests:filter-test-names
			      (if allowed-tests
				  (tests:filter-test-names all-test-names allowed-tests)
				  all-test-names)
			      test-patts))

    ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up.

    ;; NEW STRATEGY HERE:
    ;; 1. fill required tests with test-patts
    ;; 2. scan testconfigs and if waitons, itemwait, itempatt calc prior test test-patt
    ;; 3. repeat until all deps propagated