diff --git a/racket/src/io/logger/level.rkt b/racket/src/io/logger/level.rkt index 27b51058b0..b6380c2b9b 100644 --- a/racket/src/io/logger/level.rkt +++ b/racket/src/io/logger/level.rkt @@ -7,7 +7,8 @@ level-min parse-filters filters-level-for-topic - filters-max-level) + filters-max-level + level->user-representation) ;; A filter set is represented as an improper list of pairs ending ;; with a (non-pair) level symbol. The ending symbol is the level that @@ -87,3 +88,10 @@ (level-max best-level (cdar filters)))] [else (level-max best-level filters)]))) + +;; ---------------------------------------- + +(define (level->user-representation lvl) + (if (eq? lvl 'none) + #f + lvl)) diff --git a/racket/src/io/logger/logger.rkt b/racket/src/io/logger/logger.rkt index ebe3990572..00e15ca7a3 100644 --- a/racket/src/io/logger/logger.rkt +++ b/racket/src/io/logger/logger.rkt @@ -16,7 +16,7 @@ topic-level-cache ; topic -> level cache [local-level-timestamp #:mutable] ; integer root-level-timestamp-box ; box of integer - [level-sema #:mutable])) ; to report when a receiver is added + level-sema-box)) ; box for sema to report when a receiver is added (define/who (logger-name logger) (check who logger? logger) @@ -35,7 +35,9 @@ (if parent (logger-root-level-timestamp-box parent) (box 0)) - #f)) ; level-sema + (if parent + (logger-level-sema-box parent) + (box #f)))) ;; Get log receivers, dropping any boxes made empty due to a weak ;; reference: diff --git a/racket/src/io/logger/main.rkt b/racket/src/io/logger/main.rkt index 7b7a911e02..1484474284 100644 --- a/racket/src/io/logger/main.rkt +++ b/racket/src/io/logger/main.rkt @@ -68,8 +68,9 @@ (define/who (log-max-level logger [topic #f]) (check who logger? logger) (check who #:or-false symbol? topic) - (atomically/no-interrupts/no-wind - (logger-wanted-level logger topic))) + (level->user-representation + (atomically/no-interrupts/no-wind + (logger-wanted-level logger topic)))) (define/who (log-all-levels logger) (check who logger? logger) @@ -80,11 +81,11 @@ (define s (atomically (cond - [(logger-level-sema logger) + [(unbox (logger-level-sema-box logger)) => (lambda (s) s)] [else (define s (make-semaphore)) - (set-logger-level-sema! logger s) + (set-box! (logger-level-sema-box logger) s) s]))) (semaphore-peek-evt s)) diff --git a/racket/src/io/logger/receiver.rkt b/racket/src/io/logger/receiver.rkt index 7aa1e6a6db..8ddf94fdeb 100644 --- a/racket/src/io/logger/receiver.rkt +++ b/racket/src/io/logger/receiver.rkt @@ -12,7 +12,8 @@ make-log-receiver add-stderr-log-receiver! add-stdout-log-receiver! - log-receiver-send!) + log-receiver-send! + receiver-add-topics) (struct log-receiver (filters)) @@ -144,9 +145,10 @@ (set-box! ts-box (add1 (unbox ts-box))) ;; Post a semaphore to report that wanted levels may have ;; changed: - (when (logger-level-sema logger) - (semaphore-post (logger-level-sema logger)) - (set-logger-level-sema! logger #f)))) + (define sema-box (logger-level-sema-box logger)) + (when (unbox sema-box) + (semaphore-post (unbox sema-box)) + (set-box! sema-box #f)))) ;; Called in atomic mode and with interrupts disabled (define (log-receiver-send! r msg in-interrupt?) @@ -157,3 +159,13 @@ ;; Record any any other message for posting later: (unsafe-add-pre-poll-callback! (lambda () ((receiver-send-ref r) r msg))))) + +;; ---------------------------------------- + +(define (receiver-add-topics r topics default-level) + (let loop ([filters (log-receiver-filters r)] [topics topics]) + (cond + [(pair? filters) + (loop (cdr filters) (hash-set topics (caar filters) #t))] + [else + (values topics (level-max default-level filters))]))) diff --git a/racket/src/io/logger/wanted.rkt b/racket/src/io/logger/wanted.rkt index 1dad94adf2..2d2347f82c 100644 --- a/racket/src/io/logger/wanted.rkt +++ b/racket/src/io/logger/wanted.rkt @@ -33,7 +33,7 @@ (atomically/no-interrupts/no-wind (cond [((logger-local-level-timestamp logger) . >= . (unbox (logger-root-level-timestamp-box logger))) - ;; Ccahed value is up-to-date + ;; Cached value is up-to-date (logger-max-receiver-level logger)] [else ;; Traverse to set cache: @@ -49,7 +49,7 @@ ;; As we traverse the parent chain, keep track of the "ceiling" ;; level as the maximum level that would be propagated; for any ;; receiver, clip the wanted levels to that ceiling. - (let loop ([parent logger] [ceiling-level 'debug] [old-max-level 'none] [old-topic-max-level 'none]) + (let loop ([parent logger] [ceiling-level 'debug] [old-max-level 'none] [topic-ceiling-level 'debug] [old-topic-max-level 'none]) (define-values (max-level topic-max-level) (for/fold ([max-level old-max-level] [topic-max-level old-topic-max-level]) ([r (in-list (logger-receivers parent))] @@ -62,14 +62,19 @@ (and topic (level-max topic-max-level (level-min (filters-level-for-topic (log-receiver-filters r) topic) - ceiling-level)))))) + topic-ceiling-level)))))) (cond [(and (or (ceiling-level . level>=? . max-level) (and topic (ceiling-level . level>=? . topic-max-level))) (logger-parent parent)) => (lambda (next-parent) - (let ([ceiling-level (level-min ceiling-level (filters-max-level (logger-propagate-filters parent)))]) - (loop next-parent ceiling-level max-level topic-max-level)))] + (define filters (logger-propagate-filters parent)) + (let ([ceiling-level (level-min ceiling-level (filters-max-level filters))] + [topic-ceiling-level (if topic + (level-min topic-ceiling-level + (filters-level-for-topic filters topic)) + topic-ceiling-level)]) + (loop next-parent ceiling-level max-level topic-ceiling-level topic-max-level)))] [else ;; No more parents, so save the result (set-logger-max-receiver-level! logger max-level) @@ -93,4 +98,26 @@ (define (logger-all-levels logger) - '(none #f)) + (define-values (topics default-level) + (let loop ([topics #hasheq()] [default-level 'none] [max-default-level 'debug] [logger logger]) + (define-values (new-topics new-default-level) + (for*/fold ([topics topics] [default-level 'none]) ([r (in-list (logger-receivers logger))]) + (receiver-add-topics r topics default-level))) + (define next-default-level (level-max (level-min new-default-level max-default-level) + default-level)) + (define parent-logger (logger-parent logger)) + (if parent-logger + (let ([max-default-level (level-min max-default-level + (filters-level-for-topic + (logger-propagate-filters logger) + #f))]) + (loop new-topics next-default-level max-default-level parent-logger)) + (values new-topics next-default-level)))) + (list* (level->user-representation default-level) #f + (apply + append + (for/list ([topic (in-hash-keys topics)]) + (list (level->user-representation + (atomically/no-interrupts/no-wind + (logger-wanted-level logger topic))) + topic)))))