Megatest

Check-in [c6cee5cbb1]
Login
Overview
Comment:Converted couple more calls in runs.scm to full remote
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | network-only-transport
Files: files | file ages | folders
SHA1: c6cee5cbb16d802f0bc2e212a2b1ab86824789a1
User & Date: matt on 2013-02-28 23:28:11
Other Links: branch diff | manifest | tags
Context
2013-03-04
22:27
Disabled fs and got zmq working again (I think) check-in: 9bf6d9d0fe user: matt tags: network-only-transport
2013-02-28
23:28
Converted couple more calls in runs.scm to full remote check-in: c6cee5cbb1 user: matt tags: network-only-transport
23:08
Converted dashboard to remote calls check-in: c1e7692bac user: matt tags: network-only-transport
Changes

Modified launch.scm from [9c1957ce23] to [9d5e223a7b].

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
	       (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))
	       (megatest  (assoc/default 'megatest  cmdinfo))
	       (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))


	       (fullrunscript (if (not runscript)
                                  #f
                                  (if (substring-index "/" runscript)
                                      runscript ;; use unadultered if contains slashes
                                      (let ((fulln (conc testpath "/" runscript)))
	                                  (if (and (file-exists? fulln)
                                                   (file-execute-access? fulln))
                                              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)


	  ;; 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)
		(map (lambda (varpair)
		       (let ((varval (string-split varpair "=")))







>
>














>
>







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
	       (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))
	       (megatest  (assoc/default 'megatest  cmdinfo))
	       (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
	       (keys      #f)
	       (keyvals   #f)
	       (fullrunscript (if (not runscript)
                                  #f
                                  (if (substring-index "/" runscript)
                                      runscript ;; use unadultered if contains slashes
                                      (let ((fulln (conc testpath "/" runscript)))
	                                  (if (and (file-exists? fulln)
                                                   (file-execute-access? fulln))
                                              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)
		(map (lambda (varpair)
		       (let ((varval (string-split varpair "=")))
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
	  ;; Can setup as client for server mode now
	  (server:client-setup)

	  (change-directory *toppath*) 
	  (set-megatest-env-vars run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 

	  (open-run-close set-run-config-vars #f run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")
	  (open-run-close test-set-meta-info #f test-id run-id test-name itemdat 0)
	  (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)







|







119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
	  ;; Can setup as client for server mode now
	  (server:client-setup)

	  (change-directory *toppath*) 
	  (set-megatest-env-vars run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 

	  (open-run-close set-run-config-vars #f run-id keys keyvals)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars run-id)
	  (set-item-env-vars itemdat)
	  (save-environment-as-files "megatest")
	  (open-run-close test-set-meta-info #f test-id run-id test-name itemdat 0)
	  (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f)

Modified runconfig.scm from [e60c2bb3c8] to [09fb252607].

8
9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
(declare (unit runconfig))
(declare (uses common))

(include "common_records.scm")



(define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t))

  (let* ((keys    (db:get-keys db))
	 (keyvals (if run-id (db:get-key-vals db run-id) #f))
	 (thekey  (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")
		      (if (args:get-arg "-reqtarg") 
			  (args:get-arg "-reqtarg")
			  (if (args:get-arg "-target")
			      (args:get-arg "-target")
			      (begin
				(debug:print 0 "ERROR: setup-env-defaults called with no run-id or -target or -reqtarg")







|
>
|
|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
(declare (unit runconfig))
(declare (uses common))

(include "common_records.scm")



;; (define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t))
(define (setup-env-defaults fname run-id already-seen keys keyvals #!key (environ-patt #f)(change-env #t))
  (let* (;; (keys    (db:get-keys db))
	 ;; (keyvals (if run-id (db:get-key-vals db run-id) #f))
	 (thekey  (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")
		      (if (args:get-arg "-reqtarg") 
			  (args:get-arg "-reqtarg")
			  (if (args:get-arg "-target")
			      (args:get-arg "-target")
			      (begin
				(debug:print 0 "ERROR: setup-env-defaults called with no run-id or -target or -reqtarg")
56
57
58
59
60
61
62
63
64
65
66
67
68

69
70
71
72
73
74
	  (for-each (lambda (fullkey)
		      (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
		    sections)
	  (debug:print 2 "---")
	  (set! *already-seen-runconfig-info* #t)))
    finaldat))

(define (set-run-config-vars db run-id)
  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))
	(targ       (or (args:get-arg "-target")
			(args:get-arg "-reqtarg")
			(db:get-target db run-id))))
    (if (file-exists? runconfigf)

	(setup-env-defaults db runconfigf run-id #t environ-patt: (conc "(default"
									(if targ
									    (conc "|" targ ")")
									    ")")))
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))
 







|





>
|
|
|
|


57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
	  (for-each (lambda (fullkey)
		      (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0))))
		    sections)
	  (debug:print 2 "---")
	  (set! *already-seen-runconfig-info* #t)))
    finaldat))

(define (set-run-config-vars db run-id keys keyvals)
  (let ((runconfigf (conc  *toppath* "/runconfigs.config"))
	(targ       (or (args:get-arg "-target")
			(args:get-arg "-reqtarg")
			(db:get-target db run-id))))
    (if (file-exists? runconfigf)
	(setup-env-defaults runconfigf run-id #t keys keyvals
			    environ-patt: (conc "(default"
						(if targ
						    (conc "|" targ ")")
						    ")")))
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))))
 

Modified runs.scm from [1aa6b158e4] to [7ba96bae1f].

213
214
215
216
217
218
219

220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
;;            
(define (runs:run-tests target runname test-names test-patts user flags)
  (common:clear-caches) ;; clear all caches
  (let* ((db          #f)
	 (keys        (cdb:remote-run db:get-keys #f))
	 (keyvallst   (keys:target->keyval keys target))
	 (run-id      (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user))  ;;  test-name)))

	 (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

    (if (file-exists? runconfigf)
	(open-run-close setup-env-defaults db runconfigf run-id *already-seen-runconfig-info* "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)

    (set! test-names (tests:get-valid-tests *toppath* test-names))
    (set! test-names (delete-duplicates test-names))







>










|







213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
;;            
(define (runs:run-tests target runname test-names test-patts user flags)
  (common:clear-caches) ;; clear all caches
  (let* ((db          #f)
	 (keys        (cdb:remote-run db:get-keys #f))
	 (keyvallst   (keys:target->keyval keys target))
	 (run-id      (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user))  ;;  test-name)))
	 (keyvals     (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f))
	 (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

    (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)

    (set! test-names (tests:get-valid-tests *toppath* test-names))
    (set! test-names (delete-duplicates test-names))