Megatest

Check-in [12652f0dbd]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Minor optimization. Enabled key env vars in using -show-runconfig
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.54
Files: files | file ages | folders
SHA1: 12652f0dbdda1107dbc908d1ff6b49243a42060d
User & Date: matt on 2013-05-05 00:35:53
Other Links: branch diff | manifest | tags
Context
2013-05-05
00:43
Added MT_RUN_AREA_HOME for -show-runconfigs check-in: 2d38067787 user: matt tags: v1.54, v1.5421
00:35
Minor optimization. Enabled key env vars in using -show-runconfig check-in: 12652f0dbd user: matt tags: v1.54
2013-05-04
23:56
Simplified testpatt vs. runtests check-in: 8574e9978e user: matt tags: v1.54, v1.5421
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [df4224a57c] to [98d99ca28b].

︙
519
520
521
522
523
524
525




















526
527
528
529
530
531
532

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








	(if (equal? hed field)
	    (vector-ref row n)
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))

;;======================================================================
;;  R U N S
;;======================================================================

(define (db:get-run-name-from-id db run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (runname)
       (set! res runname))
     db
     "SELECT runname FROM runs WHERE id=?;"
     run-id)
    res))

(define (db:get-run-key-val db run-id key)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db 
     (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")
     run-id)
    res))

;; keys list to key1,key2,key3 ...
(define (runs:get-std-run-fields keys remfields)
  (let* ((header    (append (map key:get-fieldname keys)
			    remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
︙

Modified megatest.scm from [a6c4f0612e] to [a2be3fd7a9].

︙
411
412
413
414
415
416
417

418

419
420
421
422

423





424

425
426
427
428
429
430
431

411
412
413
414
415
416
417
418

419
420
421
422
423
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438








+
-
+




+

+
+
+
+
+
-
+








      (for-each (lambda (x)
		  ;; (print "[" x "]"))
		  (print x))
		targets)
      (set! *didsomething* #t)))

(if (args:get-arg "-show-runconfig")
    (let* ((keys   (cdb:remote-run get-keys #f))
    (let* ((target (if (args:get-arg "-reqtarg")
	   (target (if (args:get-arg "-reqtarg")
		       (args:get-arg "-reqtarg")
		       (if (args:get-arg "-target")
			   (args:get-arg "-target")
			   #f)))
	   (key-vals (if target (keys:target->keyval keys target) #f))
	   (sections (if target (list "default" target) #f))
	   (data     (begin
		       (if key-vals
			   (for-each (lambda (kt)
				       (setenv (car kt) (cadr kt)))
				     key-vals))
	   (data     (read-config "runconfigs.config" #f #t sections: sections)))
		       (read-config "runconfigs.config" #f #t sections: sections))))

      ;; keep this one local
      (cond
       ((not (args:get-arg "-dumpmode"))
	(pp (hash-table->alist data)))
       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
︙

Modified run-tests-queue-classic.scm from [70e6801543] to [7273016cde].

︙
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234

220
221
222
223
224
225
226

227
228
229
230
231
232
233
234








-
+








		       ((or (null? prereqs-not-met) ;; all prereqs met, fire off the test
			    ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch
			    (and (eq? testmode 'toplevel)
				 (null? non-completed)))
			(let ((test-name (tests:testqueue-get-testname test-record)))
			  (setenv "MT_TEST_NAME" test-name) ;; 
			  (setenv "MT_RUNNAME"   runname)
			  (set-megatest-env-vars run-id) ;; these may be needed by the launching process
			  (set-megatest-env-vars run-id inrunname: runname) ;; these may be needed by the launching process
			  (let ((items-list (items:get-items-from-config tconfig)))
			    (if (list? items-list)
				(begin
				  (tests:testqueue-set-items! test-record items-list)
				  ;; (thread-sleep! *global-delta*)
				  (loop hed tal reruns))
				(begin
︙

Modified runs.scm from [5f0f872d62] to [67d716378c].

︙
65
66
67
68
69
70
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
102
103
104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119

65
66
67
68
69
70
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








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


















-
+








    (vector header res)))

(define (runs:test-get-full-path test)
  (let* ((testname (db:test-get-testname   test))
	 (itempath (db:test-get-item-path test)))
    (conc testname (if (equal? itempath "") "" (conc "(" itempath ")")))))

(define (db:get-run-key-val db run-id key)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (val)
       (set! res val))
     db 
     (conc "SELECT " (key:get-fieldname key) " FROM runs WHERE id=?;")
     run-id)
    res))

(define (db:get-run-name-from-id db run-id)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (runname)
       (set! res runname))
     db
     "SELECT runname FROM runs WHERE id=?;"
     run-id)
    res))

(define (set-megatest-env-vars run-id)
  (let ((keys (cdb:remote-run db:get-keys #f))
(define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f))
  (let ((keys (if inkeys inkeys (cdb:remote-run db:get-keys #f)))
	(vals (hash-table-ref/default *env-vars-by-run-id* run-id #f)))
    ;; get the info from the db and put it in the cache
    (if (not vals)
	(let ((ht (make-hash-table)))
	  (hash-table-set! *env-vars-by-run-id* run-id ht)
	  (set! vals ht)
	  (for-each
	   (lambda (key)
	     (hash-table-set! vals key (cdb:remote-run db:get-run-key-val #f run-id key)))
	   keys)))
    ;; from the cached data set the vars
    (hash-table-for-each
     vals
     (lambda (key val)
       (debug:print 2 "setenv " (key:get-fieldname key) " " val)
       (setenv (key:get-fieldname key) val)))
    (alist->env-vars (hash-table-ref/default *configdat* "env-override" '()))
    ;; Lets use this as an opportunity to put MT_RUNNAME in the environment
    (setenv "MT_RUNNAME" (cdb:remote-run db:get-run-name-from-id #f run-id))
    (setenv "MT_RUNNAME" (if inrunname inrunname (cdb:remote-run db:get-run-name-from-id #f run-id)))
    (setenv "MT_RUN_AREA_HOME" *toppath*)
    ))

(define (set-item-env-vars itemdat)
  (for-each (lambda (item)
	      (debug:print 2 "setenv " (car item) " " (cadr item))
	      (setenv (car item) (cadr item)))
︙
185
186
187
188
189
190
191
192

193
194
195
196
197
198
199

165
166
167
168
169
170
171

172
173
174
175
176
177
178
179








-
+








	 (deferred    '()) ;; delay running these since they have a waiton clause
	 ;; keepgoing is the defacto modality now, will add hit-n-run a bit later
	 ;; (keepgoing   (hash-table-ref/default flags "-keepgoing" #f))
	 (runconfigf   (conc  *toppath* "/runconfigs.config"))
	 (required-tests '())
	 (test-records (make-hash-table)))

    (set-megatest-env-vars run-id) ;; these may be needed by the launching process
    (set-megatest-env-vars run-id inkeys: keys) ;; these may be needed by the launching process

    (if (file-exists? runconfigf)
	(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars")
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))
    
    ;; look up all tests matching the comma separated list of globs in
    ;; test-patts (using % as wildcard)
︙
371
372
373
374
375
376
377
378

379
380
381
382
383
384
385

351
352
353
354
355
356
357

358
359
360
361
362
363
364
365








-
+








		 )
    ;; setting itemdat to a list if it is #f
    (if (not itemdat)(set! itemdat '()))
    (set! item-path (item-list->path itemdat))
    (debug:print 2 "Attempting to launch test " test-name (if (equal? item-path "/") "/" item-path))
    (setenv "MT_TEST_NAME" test-name) ;; 
    (setenv "MT_RUNNAME"   runname)
    (set-megatest-env-vars run-id) ;; these may be needed by the launching process
    (set-megatest-env-vars run-id inrunname: runname) ;; these may be needed by the launching process
    (change-directory *toppath*)

    ;; Here is where the test_meta table is best updated
    ;; Yes, another use of a global for caching. Need a better way?
    (if (not (hash-table-ref/default *test-meta-updated* test-name #f))
        (begin
	   (hash-table-set! *test-meta-updated* test-name #t)
︙

This page was generated in about 0.125s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00