Megatest

Check-in [1c689c2903]
Login
Overview
Comment:Starting massive refactor for v2.0
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | massive-refactor
Files: files | file ages | folders
SHA1: 1c689c2903b33bcd5ae9efac0d6a4bfa893d8030
User & Date: matt on 2012-05-06 22:10:38
Other Links: branch diff | manifest | tags
Context
2012-05-06
23:26
ititbity changes check-in: 3afc52233e user: matt tags: massive-refactor
22:10
Starting massive refactor for v2.0 check-in: 1c689c2903 user: matt tags: massive-refactor
2012-05-04
10:47
Added MT_TARGET check-in: 1c1e1205c5 user: mrwellan tags: trunk
Changes

Modified db.scm from [b8582e66d4] to [261d702a1b].

32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data*      '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex*     (make-mutex))
(define *cache-on* #f)

(define (open-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc *toppath* "/megatest.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   36000)))) ;; 136000)))
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)







|
|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; timestamp type (val1 val2 ...)
;; type: meta-info, step
(define *incoming-data*      '())
(define *incoming-last-time* (current-seconds))
(define *incoming-mutex*     (make-mutex))
(define *cache-on* #f)

(define (open-db #!key (path #f)) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc (if path path *toppath*) "/megatest.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   36000)))) ;; 136000)))
    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)

Modified launch.scm from [ec07a7aa76] to [6528b06ddb].

346
347
348
349
350
351
352
353



354
355
356
357
358
359
360
361
362
363
364
365
366
		(exit 4)))))))

;; set up the very basics needed for doing anything here.
(define (setup-for-run)
  ;; would set values for KEYS in the environment here for better support of env-override but 
  ;; have chicken/egg scenario. need to read megatest.config then read it again. Going to 
  ;; pass on that idea for now.
  (set! *configinfo* (find-and-read-config (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override"))



  (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."))
  *toppath*)

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







|
>
>
>
|
|
|
|
|
<







346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
		(exit 4)))))))

;; set up the very basics needed for doing anything here.
(define (setup-for-run)
  ;; would set values for KEYS in the environment here for better support of env-override but 
  ;; have chicken/egg scenario. need to read megatest.config then read it again. Going to 
  ;; pass on that idea for now.
  (find-and-read-config (if (args:get-arg "-config")
			    (args:get-arg "-config") 
			    "megatest.config")
			environ-patt: "env-override"))
        ;; (*configdat*  (if (car *configinfo*)(car *configinfo*) #f))
	;; (*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."))


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

Modified process.scm from [71a058a91c] to [833fe6b14b].

74
75
76
77
78
79
80
81































    (let loop ((i 0))
      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
         (if (eq? pid-val 0)
	     (begin
	       (thread-sleep! 2)
	       (loop (+ i 1)))
	     (values pid-val exit-status exit-code))))))
  






































|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
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
99
100
101
102
103
104
105
106
107
108
109
110
111
112
    (let loop ((i 0))
      (let-values (((pid-val exit-status exit-code) (process-wait pid #t)))
         (if (eq? pid-val 0)
	     (begin
	       (thread-sleep! 2)
	       (loop (+ i 1)))
	     (values pid-val exit-status exit-code))))))

;;======================================================================
;; A persistent shell to which we can send many commands
;;    WATCH for flush issues!
;;    ALWAYS call with > /dev/null OR > logfile to cmd
;;======================================================================  
(define (cmdshell:make-shell cmd . params)
  ;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
  (handle-exceptions
   exn
   (begin
     (print "ERROR:  Failed to run command: " cmd " " (string-intersperse params " "))
     #f)
   (let-values (((fh fho pid) (if (null? params)
				  (process cmd)
				  (process cmd params))))
      (vector fh fho pid))))

;; WARNING!! This will fail horribly if varname or varvalue have escaped or quoted portions
(define (cmdshell:set-env-var cmdshell varname varvalue)
  (with-output-to-port (vector-ref cmdshell 1)
    (lambda ()
      (print "export " varname "=" varvalue))))

(define (cmdshell:run-cmd cmdshell cmd)
  (with-output-to-port (vector-ref cmdshell 1)
    (lambda ()
      (print cmd))))

      ;; (close-input-port fh)
      ;;   (close-output-port fho)