Megatest

Diff
Login

Differences From Artifact [a20d21ae37]:

To Artifact [c22e67eca1]:


41
42
43
44
45
46
47
48

49
50
51
52
53
54
55
56
41
42
43
44
45
46
47

48

49
50
51
52
53
54
55







-
+
-







		           *configdat*
		           (if (setup-for-run)
		               *configdat*
		               (begin
		                 (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting")
		                 (exit 1)))))
	  (runrec      (runs:runrec-make-record))
	  (target      (or (args:get-arg "-reqtarg")
	  (target      (common:args-get-target))
		           (args:get-arg "-target")))
	  (runname     (or (args:get-arg ":runname")
		           (args:get-arg "-runname")))
	  (testpatt    (or (args:get-arg "-testpatt")
		           (args:get-arg "-runtests")))
	  (keys        (keys:config-get-fields mconfig))
	  (keyvals     (keys:target->keyval keys target))
	  (toppath     *toppath*)
88
89
90
91
92
93
94
95

96
97
98
99
100
101
102
103
87
88
89
90
91
92
93

94

95
96
97
98
99
100
101







-
+
-







			    (set! envdat (append envdat (list varval)))
			    (safe-setenv (car varval)(cadr varval)))
			  (configf:get-section runconfig section)))
	      (list "default" target))
    (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id)))

(define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f))
  (let* ((target      (or (args:get-arg "-reqtarg")
  (let* ((target      (or (common:args-get-target)
			  (args:get-arg "-target")
			  (get-environment-variable "MT_TARGET")))
	 (keys    (if inkeys    inkeys    (rmt:get-keys)))
	 (keyvals (if inkeyvals inkeyvals (keys:target->keyval keys target)))
	 (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)))
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1386
1387
1388
1389
1390
1391
1392

1393



1394
1395
1396
1397
1398
1399
1400
1401
1402

1403


1404
1405
1406
1407
1408
1409
1410







-
+
-
-
-









-
+
-
-







;; Routines for manipulating runs
;;======================================================================

;; Since many calls to a run require pretty much the same setup 
;; this wrapper is used to reduce the replication of code
(define (general-run-call switchname action-desc proc)
  (let ((runname (args:get-arg ":runname"))
	(target  (if (args:get-arg "-target")
	(target  (common:args-get-target)))
		     (args:get-arg "-target")
		     (args:get-arg "-reqtarg"))))
	;; (th1     #f))
    (cond
     ((not target)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the target with -target")
      (exit 3))
     ((not runname)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with :runname runname")
      (exit 3))
     (else
      (let ((db   #f)
	    (keys #f)
	    (keys #f))
	    (target (or (args:get-arg "-reqtarg")
			(args:get-arg "-target"))))
	(if (not (setup-for-run))
	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	;; (if (args:get-arg "-server")
	;;     (cdb:remote-run server:start db (args:get-arg "-server")))
	(set! keys (keys:config-get-fields *configdat*))