Megatest

Check-in [dbc554c75c]
Login
Overview
Comment:Add ability to override hostname
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | archiving
Files: files | file ages | folders
SHA1: dbc554c75c059ffa522d22778306c6c87a589336
User & Date: matt on 2012-02-24 00:44:48
Other Links: branch diff | manifest | tags
Context
2012-02-24
14:58
Accidental check in of rpc related junk Closed-Leaf check-in: 7502542dd9 user: mrwellan tags: archiving
03:21
No need for the archiving branch, work not happening there anyway so merging to trunk check-in: ad71efd688 user: matt tags: trunk
00:44
Add ability to override hostname check-in: dbc554c75c user: matt tags: archiving
00:22
Typo check-in: 80e341f6e8 user: matt tags: archiving
Changes

Modified megatest.scm from [020b44b20d] to [89234220c0].

89
90
91
92
93
94
95
96


97
98
99
100
101
102
103
89
90
91
92
93
94
95

96
97
98
99
100
101
102
103
104







-
+
+







  -rollup                 : fill run (set by :runname)  with latest test(s) from
                            prior runs with same keys
  -update-meta            : update the tests metadata for all tests
  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -archive                : archive tests, use -target, :runname, -itempatt and -testpatt
  -server                 : start the server (reduces contention on megatest.db)
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style
149
150
151
152
153
154
155

156
157
158
159
160
161
162
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164







+







			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"
			;; misc
			"-server"
			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-setvars"
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
178
179
180
181
182
183
184

185
186
187
188
189
190
191







-







			"-runall"    ;; run all tests
			"-remove-runs"
			"-keepgoing"
			"-usequeue"
			"-rebuild-db"
			"-rollup"
			"-update-meta"
			"-server"

			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
		       )
		 args:arg-hash
		 0))

387
388
389
390
391
392
393
394

395
396
397
398
399
400
401
388
389
390
391
392
393
394

395
396
397
398
399
400
401
402







-
+







;;======================================================================
;; Start the server
;;======================================================================
(if (args:get-arg "-server")
    (let* ((toppath (setup-for-run))
	   (db      (if toppath (open-db) #f)))
      (if db 
	  (server:start db)
	  (server:start db (args:get-arg "-server"))
	  (debug:print 0 "ERROR: Failed to setup for megatest"))))

;;;======================================================================
;; Rollup into a run
;;======================================================================
(if (args:get-arg "-rollup")
    (general-run-call 

Modified server.scm from [7ced522a2e] to [ed22148f79].

29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
46








47
48
49
50
51
52
53
29
30
31
32
33
34
35

36
37
38
39
40
41





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







-
+





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







   (begin
     (debug:print 1 "Remote failed for " proc " " params)
     (apply (eval (string->symbol proc)) params))
   (if *runremote*
       (apply (eval (string->symbol (conc "remote:" procstr))) params)
       (eval (string->symbol procstr) params))))

(define (server:start db)
(define (server:start db hostn)
  (debug:print 0 "Attempting to start the server ...")
  (let* ((rpc:listener   (server:find-free-port-and-open (rpc:default-server-port)))
	 (th1            (make-thread
			  (cute (rpc:make-server rpc:listener) "rpc:server")
			  'rpc:server))
	 (hostname       (get-host-name))
	 (ipaddr         (hostname->ip hostname))
	 (ipaddrstr      (string-intersperse (map number->string (u8vector->list ipaddr)) "."))
	 (ipaddrstr:port (conc ipaddrstr ":" (rpc:default-server-port))))
    (db:set-var db "SERVER" ipaddrstr:port)
	 (hostname       (if (string=? "-" hostn)
			     (get-host-name) 
			     hostn))
	 (ipaddrstr      (if (string=? "-" hostn)
			     (string-intersperse (map number->string (u8vector->list (hostname->ip hostname))) ".")
			     #f))
	 (host:port      (conc (if ipaddrstr ipaddrstr hostname) ":" (rpc:default-server-port))))
    (db:set-var db "SERVER" host:port)
    (rpc:publish-procedure! 
     'remote:run 
     (lambda (procstr . params)
       (server:autoremote procstr params)))

    ;;======================================================================
    ;; db specials here
91
92
93
94
95
96
97
98

99
100
101
102
103
104
105
94
95
96
97
98
99
100

101
102
103
104
105
106
107
108







-
+







    (rpc:publish-procedure!
     'rpc:test-set-log!
     (lambda (run-id test-name item-path logf)
       (db:test-set-log! db run-id test-name item-path logf)))

    (set! *rpc:listener* rpc:listener)
    (on-exit (lambda ()
	       (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" ipaddrstr:port)
	       (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port)
	       (sqlite3:finalize! db)))
    (thread-start! th1)
    (thread-join! th1))) ;; rpc:server)))

(define (server:find-free-port-and-open port)
  (handle-exceptions
   exn