58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
(let* ((testpath (assoc/default 'testpath cmdinfo)) ;; How is testpath different from work-area ??
(top-path (assoc/default 'toppath cmdinfo))
(work-area (assoc/default 'work-area cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(ezsteps (assoc/default 'ezsteps cmdinfo))
(runremote (assoc/default 'runremote cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(test-id (assoc/default 'test-id cmdinfo))
(target (assoc/default 'target cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(env-ovrd (assoc/default 'env-ovrd cmdinfo))
(set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar
(runname (assoc/default 'runname cmdinfo))
|
>
|
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(let* ((testpath (assoc/default 'testpath cmdinfo)) ;; How is testpath different from work-area ??
(top-path (assoc/default 'toppath cmdinfo))
(work-area (assoc/default 'work-area cmdinfo))
(test-name (assoc/default 'test-name cmdinfo))
(runscript (assoc/default 'runscript cmdinfo))
(ezsteps (assoc/default 'ezsteps cmdinfo))
(runremote (assoc/default 'runremote cmdinfo))
(transport (assoc/default 'transport cmdinfo))
(run-id (assoc/default 'run-id cmdinfo))
(test-id (assoc/default 'test-id cmdinfo))
(target (assoc/default 'target cmdinfo))
(itemdat (assoc/default 'itemdat cmdinfo))
(env-ovrd (assoc/default 'env-ovrd cmdinfo))
(set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar
(runname (assoc/default 'runname cmdinfo))
|
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
fulln
runscript))))) ;; assume it is on the path
(rollup-status 0))
(debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name))
;; Setup the *runremote* global var
(if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time"))
(set! *runremote* runremote)
(set! keys (cdb:remote-run db:get-keys #f))
(set! keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f))
;; apply pre-overrides before other variables. The pre-override vars must not
;; clobbers things from the official sources such as megatest.config and runconfigs.config
(if (string? set-vars)
(let ((varpairs (string-split set-vars ",")))
(debug:print 4 "varpairs: " varpairs)
|
>
|
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
fulln
runscript))))) ;; assume it is on the path
(rollup-status 0))
(debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name))
;; Setup the *runremote* global var
(if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time"))
(set! *runremote* runremote)
(set! *transport-type* transport)
(set! keys (cdb:remote-run db:get-keys #f))
(set! keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f))
;; apply pre-overrides before other variables. The pre-override vars must not
;; clobbers things from the official sources such as megatest.config and runconfigs.config
(if (string? set-vars)
(let ((varpairs (string-split set-vars ",")))
(debug:print 4 "varpairs: " varpairs)
|
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
(create-directory work-area #t)
(debug:print 0 "WARNING: No disk work area specified - running in the test directory under tmp_run")))
(set! cmdparms (base64:base64-encode
(with-output-to-string
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'runremote *runremote*)
(list 'toppath *toppath*)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
(list 'itemdat itemdat )
|
>
|
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
|
(create-directory work-area #t)
(debug:print 0 "WARNING: No disk work area specified - running in the test directory under tmp_run")))
(set! cmdparms (base64:base64-encode
(with-output-to-string
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'runremote *runremote*)
(list 'transport *transport-type*)
(list 'toppath *toppath*)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
(list 'itemdat itemdat )
|