Megatest

Check-in [dbc554c75c]
Login
☰Home Timeline Files Branches Tags Tickets Wiki 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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

︙︙
89
90
91
92
93
94
95
96

97
98
99
100
101
102
103

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


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








|
>








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

			":category"
			":variable"
			":value"
			":expected"
			":tol"
			":units"
			;; misc

			"-extract-ods"
			"-pathmod"
			"-env2file"
			"-setvars"
			"-debug" ;; for *verbosity* > 2
			) 
		 (list  "-h"








>








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

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









<








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"


			"-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

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

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








|








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

   (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)
  (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)
    (rpc:publish-procedure! 
     'remote:run 
     (lambda (procstr . params)
       (server:autoremote procstr params)))

    ;;======================================================================
    ;; db specials here








|





|
>
|
>
|
>
|
|








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

    (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:finalize! db)))
    (thread-start! th1)
    (thread-join! th1))) ;; rpc:server)))

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








|








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=?;" host:port)
	       (sqlite3:finalize! db)))
    (thread-start! th1)
    (thread-join! th1))) ;; rpc:server)))

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

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