Megatest

Check-in [166fac4584]
Login
Overview
Comment:Cleaned up auto server start a little
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.55
Files: files | file ages | folders
SHA1: 166fac4584b977412a82650349eb67adf3103970
User & Date: matt on 2013-08-04 21:21:20
Other Links: branch diff | manifest | tags
Context
2013-08-04
21:56
Refactor code that choose transport. Priorities between options were not handled correctly in the three contexts; commandline override, cmdinfo and megatest.config check-in: d29828129b user: matt tags: v1.55
21:21
Cleaned up auto server start a little check-in: 166fac4584 user: matt tags: v1.55
18:34
Made fs the default transport as it seems to work much better now check-in: de5a88efa7 user: matt tags: v1.55
Changes

Modified launch.scm from [b23191ac40] to [67cde5b85f].

382
383
384
385
386
387
388
389

390
391
392
393
394
395
396
382
383
384
385
386
387
388

389
390
391
392
393
394
395
396







-
+







			    environ-patt: "env-override"
			    given-toppath: (get-environment-variable "MT_RUN_AREA_HOME")
			    pathenvvar: "MT_RUN_AREA_HOME"))
	(set! *configdat*  (if (car *configinfo*)(car *configinfo*) #f))
	(set! *toppath*    (if (car *configinfo*)(cadr *configinfo*) #f))
	(if *toppath*
	    (setenv "MT_RUN_AREA_HOME" *toppath*) ;; to be deprecated
	    (debug:print 0 "ERROR: failed to find the top path to your run setup."))))
	    (debug:print 0 "ERROR: failed to find the top path to your Megatest area."))))
  *toppath*)

(define (get-best-disk confdat)
  (let* ((disks    (hash-table-ref/default confdat "disks" #f))
	 (best     #f)
	 (bestsize 0))
    (if disks 

Modified megatest.scm from [073256ec29] to [958ed9b034].

301
302
303
304
305
306
307





308

309
310
311
312
313
314
315
301
302
303
304
305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320







+
+
+
+
+
-
+








;;======================================================================
;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================

(if (args:get-arg "-server")

    ;; Server? Start up here.
    ;;
    (let ((tl        (setup-for-run))
	  (transport (or (configf:lookup *configdat* "setup" "transport")
    (let ((transport (args:get-arg "-transport" "http")))
			 (args:get-arg "-transport" "http"))))
      (debug:print 2 "Launching server using transport " transport)
      (server:launch (string->symbol transport)))

    ;; Not a server? This section will decide how to communicate
    ;;
    (if (not (null? (lset-intersection 
		     equal?
428
429
430
431
432
433
434

435

436
437
438
439
440
441
442
433
434
435
436
437
438
439
440

441
442
443
444
445
446
447
448







+
-
+







       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
       (else
	(debug:print 0 "ERROR: -dumpmode of " (args:get-arg "-dumpmode") " not recognised")))
      (set! *didsomething* #t)))

(if (args:get-arg "-show-config")
    (let ((tl   (setup-for-run))
    (let ((data *configdat*)) ;; (read-config "megatest.config" #f #t)))
	  (data *configdat*)) ;; (read-config "megatest.config" #f #t)))
      ;; keep this one local
      (cond 
       ((not (args:get-arg "-dumpmode"))
	(pp (hash-table->alist data)))
       ((string=? (args:get-arg "-dumpmode") "json")
	(json-write data))
       (else

Modified tests/fullrun/megatest.config from [5c702558fc] to [4419360fc2].

17
18
19
20
21
22
23




24
25
26
27
28
29
30
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34







+
+
+
+







[tests-paths]
1 #{get misc parent}/simplerun/tests

[setup]
# Set launchwait to yes to use the old launch run code that waits for the launch process to return before 
# proceeding.
# launchwait yes

# Use http instead of direct filesystem access
transport http


# If set to "default" the old code is used. Otherwise defaults to 200 or uses
# numeric value given.
#
runqueue 20