diff --git a/pkgs/racket-test-core/tests/racket/logger.rktl b/pkgs/racket-test-core/tests/racket/logger.rktl index 2a13c704fe..d320f79947 100644 --- a/pkgs/racket-test-core/tests/racket/logger.rktl +++ b/pkgs/racket-test-core/tests/racket/logger.rktl @@ -274,6 +274,22 @@ warning-counter)) (test 2 test-intercepted-logging2) +; -------------------- +;; Check that a blocked log receiver is not GCed if +;; if might receiver something + +(let () + (define s (make-semaphore)) + (let ([lr (make-log-receiver (current-logger) + 'info)]) + (thread (lambda () + (semaphore-post s)))) + (sync (system-idle-evt)) + (collect-garbage) + (log-message (current-logger) 'info "" 'c) + ;; If receiver is GCed, then this will block + (sync s)) + ; -------------------- (report-errs) diff --git a/racket/src/io/logger/logger.rkt b/racket/src/io/logger/logger.rkt index 20a5f435f9..ebe3990572 100644 --- a/racket/src/io/logger/logger.rkt +++ b/racket/src/io/logger/logger.rkt @@ -9,7 +9,7 @@ (struct logger (topic ; symbol or #f parent ; logger or #f propagate-filters - [receiver-boxes #:mutable] ; list of weak boxes + [receiver-box+backrefs #:mutable] ; list of (cons weak-box any) [prune-counter #:mutable] ; number of adds before checking empied boxes [permanent-receivers #:mutable] ; receivers to retain strongly [max-receiver-level #:mutable] ; up-to-date if `local-level-timestamp` = `(unbox root-level-timestamp-box)` @@ -26,7 +26,7 @@ (logger topic parent propagate-filters - null ; receiver-boxes + null ; receiver-box+backrefs 8 ; prune-counter null ; permanent-receivers 'none ; max-receiver-level @@ -40,7 +40,7 @@ ;; Get log receivers, dropping any boxes made empty due to a weak ;; reference: (define (logger-receivers logger) - (for*/list ([rb (in-list (logger-receiver-boxes logger))] - [b (in-value (weak-box-value rb))] - #:when b) - b)) + (for*/list ([b+r (in-list (logger-receiver-box+backrefs logger))] + [lr (in-value (weak-box-value (car b+r)))] + #:when lr) + lr)) diff --git a/racket/src/io/logger/main.rkt b/racket/src/io/logger/main.rkt index 79db89fa16..6567feeec0 100644 --- a/racket/src/io/logger/main.rkt +++ b/racket/src/io/logger/main.rkt @@ -76,7 +76,8 @@ => (lambda (s) s)] [else (define s (make-semaphore)) - (set-logger-level-sema! logger s)]))) + (set-logger-level-sema! logger s) + s]))) (semaphore-peek-evt s)) ;; Can be called in any host Scheme thread and in interrupt handler, diff --git a/racket/src/io/logger/receiver.rkt b/racket/src/io/logger/receiver.rkt index a6a9e73ce6..7bc9964b68 100644 --- a/racket/src/io/logger/receiver.rkt +++ b/racket/src/io/logger/receiver.rkt @@ -21,7 +21,8 @@ ;; ---------------------------------------- (struct queue-log-receiver log-receiver (msgs ; queue of messages ready for `sync` [if `waiters` is null] - waiters) ; queue of (box callback) to receive ready messages [if `msgs` is null] + waiters ; queue of (box callback) to receive ready messages [if `msgs` is null] + backref) ; box to make a self reference to avoid GC of a waiting receiver #:reflection-name 'log-receiver #:property prop:receiver-send @@ -33,6 +34,7 @@ (define b (queue-remove! (queue-log-receiver-waiters lr))) (cond [b + (decrement-receiever-waiters! lr) (define select! (unbox b)) (set-box! b msg) (select!)] @@ -47,11 +49,14 @@ (values (list msg) #f)] [else (define b (box (poll-ctx-select-proc ctx))) - (define n (atomically/no-interrupts/no-wind (queue-add! (queue-log-receiver-waiters lr) b))) + (define n (atomically/no-interrupts/no-wind + (increment-receiever-waiters! lr) + (queue-add! (queue-log-receiver-waiters lr) b))) (values #f (control-state-evt (wrap-evt async-evt (lambda (e) (unbox b))) (lambda () (atomically/no-interrupts/no-wind - (queue-remove-node! (queue-log-receiver-waiters lr) n))) + (queue-remove-node! (queue-log-receiver-waiters lr) n) + (decrement-receiever-waiters! lr))) void (lambda () (atomically/no-interrupts/no-wind @@ -61,17 +66,31 @@ (set-box! b msg) (values msg #t)] [else + (increment-receiever-waiters! lr) (set! n (queue-add! (queue-log-receiver-waiters lr) b)) (values #f #f)])))))])))) (define/who (make-log-receiver logger level . args) (check who logger? logger) + (define backref (box #f)) (define lr (queue-log-receiver (parse-filters 'make-log-receiver (cons level args) #:default-level 'none) (make-queue) - (make-queue))) - (add-log-receiver! logger lr) + (make-queue) + backref)) + (add-log-receiver! logger lr backref) lr) + +;; In atomic mode +(define (decrement-receiever-waiters! lr) + (when (queue-empty? (queue-log-receiver-waiters lr)) + (set-box! (queue-log-receiver-backref lr) #f))) + +;; In atomic mode +(define (increment-receiever-waiters! lr) + (when (queue-empty? (queue-log-receiver-waiters lr)) + (set-box! (queue-log-receiver-backref lr) lr))) + ;; ---------------------------------------- (struct stdio-log-receiver log-receiver (which) @@ -95,7 +114,7 @@ (define lr (stdio-log-receiver (parse-filters parse-who args #:default-level 'none) which)) (atomically - (add-log-receiver! logger lr) + (add-log-receiver! logger lr #f) (set-logger-permanent-receivers! logger (cons lr (logger-permanent-receivers logger))))) (define/who (add-stderr-log-receiver! logger . args) @@ -106,19 +125,21 @@ ;; ---------------------------------------- -(define (add-log-receiver! logger lr) +(define (add-log-receiver! logger lr backref) (atomically/no-interrupts/no-wind - ;; Add receiver to the logger's list, purning empty boxes + ;; Add receiver to the logger's list, pruning empty boxes ;; every time the list length doubles (roughly): (cond [(zero? (logger-prune-counter logger)) - (set-logger-receiver-boxes! logger (cons (make-weak-box lr) - (for/list ([b (in-list (logger-receiver-boxes logger))] - #:when (weak-box-value b)) - b))) - (set-logger-prune-counter! logger (max 8 (length (logger-receiver-boxes logger))))] + (set-logger-receiver-box+backrefs! logger + (cons (cons (make-weak-box lr) backref) + (for/list ([b+r (in-list (logger-receiver-box+backrefs logger))] + #:when (weak-box-value (car b+r))) + b+r))) + (set-logger-prune-counter! logger (max 8 (length (logger-receiver-box+backrefs logger))))] [else - (set-logger-receiver-boxes! logger (cons (make-weak-box lr) (logger-receiver-boxes logger))) + (set-logger-receiver-box+backrefs! logger (cons (cons (make-weak-box lr) backref) + (logger-receiver-box+backrefs logger))) (set-logger-prune-counter! logger (sub1 (logger-prune-counter logger)))]) ;; Increment the timestamp, so that wanted levels will be ;; recomputed on demand: