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: |
1c689c2903b33bcd5ae9efac0d6a4bfa |
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 | ;; 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) | | | | 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 | (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. | | > > > | | | | | < | 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 | (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) |