Overview
Comment: | removed references to set-fn and exec-fn. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.65-try3 |
Files: | files | file ages | folders |
SHA1: |
841c3f498e72b482c6dc66631427ab12 |
User & Date: | matt on 2019-12-03 21:45:33 |
Other Links: | branch diff | manifest | tags |
Context
2019-12-03
| ||
22:28 | Turned off callback causing crash in dashboard while debugging ... check-in: bf33407036 user: matt tags: v1.65-try3 | |
21:45 | removed references to set-fn and exec-fn. check-in: 841c3f498e user: matt tags: v1.65-try3 | |
20:30 | Unit tests basically working now. check-in: 27e03ab10c user: matt tags: v1.65-try3 | |
Changes
Modified common_records.scm from [eda55d2477] to [454bf13df1].
︙ | ︙ | |||
26 27 28 29 30 31 32 | (define *verbosity* 0) (define *default-log-port* (current-error-port)) (define *logging* #f) (define *functions* (make-hash-table)) ;; symbol => fn ### TEMPORARY!!! ;; (define *toppath* #f) (define *transport-type* 'http) | | | < < < < < < < < < < < < < < | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 | (define *verbosity* 0) (define *default-log-port* (current-error-port)) (define *logging* #f) (define *functions* (make-hash-table)) ;; symbol => fn ### TEMPORARY!!! ;; (define *toppath* #f) (define *transport-type* 'http) #;(define (exec-fn fn . params) (if (hash-table-exists? *functions* fn) (apply (hash-table-ref *functions* fn) params) (begin (debug:print-error 0 "exec-fn " fn " not found") #f))) #;(define (set-fn fn-name fn) (hash-table-set! *functions* fn-name fn)) (include "altdb.scm") ;; Pulled from http-transport.scm (define (make-http-transport:server-dat)(make-vector 6)) (define (http-transport:server-dat-get-iface vec) (vector-ref vec 0)) (define (http-transport:server-dat-get-port vec) (vector-ref vec 1)) (define (http-transport:server-dat-get-api-uri vec) (vector-ref vec 2)) |
︙ | ︙ | |||
360 361 362 363 364 365 366 | (string-intersperse (map conc *verbosity*) ",") (conc *verbosity*)))))) (define (debug:print n e . params) (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () | | | | | | 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 | (string-intersperse (map conc *verbosity*) ",") (conc *verbosity*)))))) (define (debug:print n e . params) (if (debug:debug-mode n) (with-output-to-port (or e (current-error-port)) (lambda () ;; (if *logging* ;; (exec-fn 'db:log-event (apply conc params)) (apply print params) )))) ;; ) ;; Brandon's debug printer shortcut (indulge me :) (define *BB-process-starttime* (current-milliseconds)) (define (BB> . in-args) (let* ((stack (get-call-chain)) (location "??")) (for-each |
︙ | ︙ | |||
439 440 441 442 443 444 445 | [(_ x y ...) (begin (inspect x) (inspect y ...))])) (define (debug:print-error n e . params) ;; normal print (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () | | | | | | | | | | | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 | [(_ x y ...) (begin (inspect x) (inspect y ...))])) (define (debug:print-error n e . params) ;; normal print (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () ;; (if *logging* ;; (exec-fn 'db:log-event (apply conc params)) ;; (apply print "pid:" (current-process-id) " " params) (apply print "ERROR: " params) ))) ;; ) ;; pass important messages to stderr (if (and (eq? n 0)(not (eq? e (current-error-port)))) (with-output-to-port (current-error-port) (lambda () (apply print "ERROR: " params) )))) (define (debug:print-info n e . params) (if (debug:debug-mode n) (with-output-to-port (if (port? e) e (current-error-port)) (lambda () ;; (if *logging* ;; (let ((res (format#format #f "INFO: (~a) ~a" n (apply conc params)))) ;; (exec-fn 'db:log-event res)) ;; (apply print "pid:" (current-process-id) " " "INFO: (" n ") " params) ;; res) (apply print "INFO: (" n ") " params) ;; res) )))) ;; ) ;; if a value is printable (i.e. string or number) return the value ;; else return an empty string (define-inline (printable val) (if (or (number? val)(string? val)) val "")) |
Modified migrate-fix.scm from [52db327d51] to [c8a7b4ffb2].
1 2 3 4 5 | ;; this is a good place to populate the *functions* hash with ;; functions needed during the transition to modules ;; ;; NOTE: the definition in dbmod seems to "win" - make it available everywhere ;; | | | | | | | | | | | | | | | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | ;; this is a good place to populate the *functions* hash with ;; functions needed during the transition to modules ;; ;; NOTE: the definition in dbmod seems to "win" - make it available everywhere ;; ;; (set-fn 'client:setup client:setup) ;; ;; (set-fn 'db:setup db:setup) ;; (set-fn 'server:expiration-timeout server:expiration-timeout) ;; (set-fn 'common:get-homehost common:get-homehost) ;; (set-fn 'server:check-if-running server:check-if-running) ;; (set-fn 'api:execute-requests api:execute-requests) ;; (set-fn 'http-transport:close-connections http-transport:close-connections ) ;; (set-fn 'http-transport:client-api-send-receive http-transport:client-api-send-receive) ;; (set-fn 'server:kind-run server:kind-run) ;; (set-fn 'server:start-and-wait server:start-and-wait) ;; (set-fn 'server:check-if-running server:check-if-running) ;; (set-fn 'server:ping server:ping ) ;; (set-fn 'common:force-server? common:force-server? ) |
Modified tests/unittests/all-rmt.scm from [17fc57f528] to [5bf1fc0612].
︙ | ︙ | |||
39 40 41 42 43 44 45 | (define toppath (current-directory)) (test #f #f (server:check-if-running toppath)) ;; these are used by server:start-and-wait (test #f #t (list? (server:get-list toppath))) (test #f '() (server:get-best '())) (test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15)) (test #f "test.lock" (common:simple-file-release-lock "test.lock")) | | | | 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | (define toppath (current-directory)) (test #f #f (server:check-if-running toppath)) ;; these are used by server:start-and-wait (test #f #t (list? (server:get-list toppath))) (test #f '() (server:get-best '())) (test #f #t (common:simple-file-lock-and-wait "test.lock" expire-time: 15)) (test #f "test.lock" (common:simple-file-release-lock "test.lock")) (test #f #t (string? (server:get-best-guess-address (get-host-name)))) (test #f #t (list? (common:get-homehost))) ;; clean out any old running servers ;; (let ((servers (server:get-list toppath))) (print "Known servers: " servers) (if (not (null? servers)) (begin |
︙ | ︙ | |||
69 70 71 72 73 74 75 | ;; let's start up a server the mechanical way (system "nbfake megatest -server -") (thread-sleep! 2) ;; (test #f #t (string? (server:start-and-wait *toppath*))) (test "setup for run" #t (begin (launch:setup) (string? (getenv "MT_RUN_AREA_HOME")))) | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 | ;; let's start up a server the mechanical way (system "nbfake megatest -server -") (thread-sleep! 2) ;; (test #f #t (string? (server:start-and-wait *toppath*))) (test "setup for run" #t (begin (launch:setup) (string? (getenv "MT_RUN_AREA_HOME")))) (test #f #t (vector? (client:setup-http toppath))) (test #f #t (vector? (client:setup toppath))) (test #f #t (vector? (rmt:get-connection-info toppath))) ;; TODO: push areapath down. (test #f #t (string? (server:check-if-running "."))) ;; DEF (test #f #f (rmt:send-receive-no-auto-client-setup *runremote* 'get-keys #f '())) ;; DEF (rmt:kill-server run-id) ;; DEF (rmt:start-server run-id) |
︙ | ︙ |