Overview
| Comment: | minor improvements to debugger |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.61 |
| Files: | files | file ages | folders |
| SHA1: |
28c2958fa3df1974b730b2c10d830094 |
| User & Date: | matt on 2016-05-13 00:06:09 |
| Other Links: | branch diff | manifest | tags |
Context
|
2016-05-13
| ||
| 00:22 | Decrease notification rate on some messages check-in: ea28efec2e user: matt tags: v1.61 | |
| 00:06 | minor improvements to debugger check-in: 28c2958fa3 user: matt tags: v1.61 | |
|
2016-05-12
| ||
| 23:09 | Added variable watcher debugger thingy (might help until feathers is usable) check-in: 4daccede49 user: matt tags: v1.61 | |
Changes
Modified debugger.scm from [d03c93cb9e] to [f446c83fb1].
| ︙ | ︙ | |||
15 16 17 18 19 20 21 | (dialog (let ((pause #f) (mtrx (matrix #:expand "YES" #:numlin 30 #:numcol 3 #:numlin-visible 20 | | > | | | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
(dialog
(let ((pause #f)
(mtrx (matrix
#:expand "YES"
#:numlin 30
#:numcol 3
#:numlin-visible 20
#:numcol-visible 2
#:alignment1 "ALEFT"
)))
(set! pause (button "Pause"
#:action (lambda (obj)
(set! *debugger-control* (not *debugger-control*))
(attribute-set! pause "BGCOLOR" (if *debugger-control*
"200 0 0"
"0 0 200")))))
(set! *debugger-matrix* mtrx)
(attribute-set! mtrx "WIDTH1" "300")
(vbox
mtrx
(hbox
pause)))))
(main-loop)))))))
(define (debugger-start #!key (start 2))
(set! *debugger-rownum* start))
(define (debugger-trace-var varname varval)
(let ((oldval (attribute *debugger-matrix* (conc *debugger-rownum* ":1")))
(newval (conc varval)))
(if (not (equal? oldval newval))
(begin
|
| ︙ | ︙ | |||
56 57 58 59 60 61 62 |
(attribute-set! *debugger-matrix* "REDRAW" "ALL")
(let loop ()
(if *debugger-control*
(begin
(print "PAUSED!")
(thread-sleep! 1)
(loop))
| | > | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 |
(attribute-set! *debugger-matrix* "REDRAW" "ALL")
(let loop ()
(if *debugger-control*
(begin
(print "PAUSED!")
(thread-sleep! 1)
(loop))
;;(thread-sleep! 0.01)
)))
;; ;; lets use the debugger eh?
;; (debugger-start)
;; (debugger-trace-var "can-run-more" can-run-more)
;; (debugger-trace-var "hed" hed)
;; (debugger-trace-var "prereqs-not-met" (runs:pretty-string prereqs-not-met))
;; (debugger-pauser)
|
Modified rmt.scm from [b7f6f86358] to [b3e339430d].
| ︙ | ︙ | |||
71 72 73 74 75 76 77 | (if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id) (client:setup run-id) #f)))) (define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id (define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected ;; clean out old connections | | | | 71 72 73 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 |
(if (tasks:server-running-or-starting? (db:delay-if-busy (tasks:open-db)) run-id)
(client:setup run-id)
#f))))
(define *send-receive-mutex* (make-mutex)) ;; should have separate mutex per run-id
(define (rmt:send-receive cmd rid params #!key (attemptnum 1)) ;; start attemptnum at 1 so the modulo below works as expected
;; clean out old connections
;; (mutex-lock! *db-multi-sync-mutex*)
(let ((expire-time (- (current-seconds) (server:get-timeout) 10))) ;; don't forget the 10 second margin
(for-each
(lambda (run-id)
(let ((connection (hash-table-ref/default *runremote* run-id #f)))
(if (and (vector? connection)
(< (http-transport:server-dat-get-last-access connection) expire-time))
(begin
(debug:print-info 0 "Discarding connection to server for run-id " run-id ", too long between accesses")
;; SHOULD CLOSE THE CONNECTION HERE
(case *transport-type*
((nmsg)(nn-close (http-transport:server-dat-get-socket
(hash-table-ref *runremote* run-id)))))
(hash-table-delete! *runremote* run-id)))))
(hash-table-keys *runremote*)))
;; (mutex-unlock! *db-multi-sync-mutex*)
;; (mutex-lock! *send-receive-mutex*)
(let* ((run-id (if rid rid 0))
(connection-info (rmt:get-connection-info run-id)))
;; the nmsg method does the encoding under the hood (the http method should be changed to do this also)
(if connection-info
;; use the server if have connection info
(let* ((dat (case *transport-type*
|
| ︙ | ︙ |
Modified runs.scm from [68632cd62e] to [f4173c79cf].
| ︙ | ︙ | |||
488 489 490 491 492 493 494 |
"\n (member 'toplevel testmode): " (member 'toplevel testmode)
"\n (null? non-completed): " (null? non-completed)
"\n reruns: " reruns
"\n items: " items
"\n can-run-more: " can-run-more)
;; lets use the debugger eh?
| | > | 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 |
"\n (member 'toplevel testmode): " (member 'toplevel testmode)
"\n (null? non-completed): " (null? non-completed)
"\n reruns: " reruns
"\n items: " items
"\n can-run-more: " can-run-more)
;; lets use the debugger eh?
(debugger-start start: 2)
(debugger-trace-var "runs:expand-items" "")
(debugger-trace-var "can-run-more" can-run-more)
(debugger-trace-var "hed" hed)
(debugger-trace-var "prereqs-not-met" (runs:pretty-string prereqs-not-met))
(debugger-pauser)
(cond
;; all prereqs met, fire off the test
|
| ︙ | ︙ | |||
1039 1040 1041 1042 1043 1044 1045 | "\n reruns: " reruns "\n regfull: " regfull "\n reglen: " reglen "\n length reg: " (length reg) "\n reg: " reg) ;; lets use the debugger eh? | | > > | | 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 | "\n reruns: " reruns "\n regfull: " regfull "\n reglen: " reglen "\n length reg: " (length reg) "\n reg: " reg) ;; lets use the debugger eh? (debugger-start start: 7) (debugger-trace-var "runs:run-tests-queue" "") (debugger-trace-var "hed" hed) (debugger-trace-var "tal" tal) (debugger-trace-var "items" items) (debugger-trace-var "item-path" item-path) (debugger-trace-var "waitons" waitons) (debugger-pauser) ;; check for hed in waitons => this would be circular, remove it and issue an ;; error (if (member test-name waitons) |
| ︙ | ︙ |