diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/logging.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/logging.scrbl index 2eda1db814..f431a3d734 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/logging.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/logging.scrbl @@ -84,13 +84,26 @@ otherwise.} @defproc[(make-logger [name (or/c symbol? #f) #f] - [parent (or/c logger? #f) #f]) + [parent (or/c logger? #f) #f] + [propagate-level (or/c 'none 'fatal 'error 'warning 'info 'debug) 'debug] + [propagate-name (or/c #f symbol?) #f] + ... ...) logger?]{ Creates a new @tech{logger} with an optional name and parent. +The optional @racket[propagate-level] and @racket[propagate-name] +arguments constrain the events that are propagated from the new logger +to @racket[parent] (when @racket[parent] is not @racket[#f]) in the +same way that events are described for a log receiver in +@racket[make-log-receiver]. By default, all events are propagated to +@racket[parent]. + @history[#:changed "6.1.1.3" @elem{Removed an optional argument to - specify a notification callback.}]} + specify a notification callback, + and added @racket[propagate-level] and + @racket[propagate-name] constraints for + events to propagate.}]} @defproc[(logger-name [logger logger?]) (or/c symbol? #f)]{ @@ -148,11 +161,8 @@ by @racket[": "] before it is sent to receivers. Reports whether any @tech{log receiver} attached to @racket[logger] or one of its ancestors is interested in @racket[level] events (or potentially lower) or @racket[name]. If @racket[name] is @racket[#f], -the result indicates whether any @tech{log receiver} is interested in -events at @racket[level] for any name. A true result for -@racket[(log-level? logger level name)] implies a true result for -@racket[(log-level? logger level #f)], but not vice versa if -@racket[name] is a symbol. +the result indicates whether a @tech{log receiver} is interested in +events at @racket[level] for any name. Use this function to avoid work generating an event for @racket[log-message] if no receiver is interested in the diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl b/pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl index aa75f5e8d0..a9da52967c 100644 --- a/pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl +++ b/pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl @@ -13,7 +13,7 @@ (test #f logger-name (make-logger)) -(arity-test make-logger 0 2) +(arity-test make-logger 0 -1) ; -------------------- @@ -100,23 +100,28 @@ (let () (define-logger test) - (define r (make-log-receiver (current-logger) 'info 'test 'warning)) + (define r (make-log-receiver (current-logger) 'info 'test2 'warning)) (test #t log-level? test-logger 'warning) (test #t log-level? test-logger 'info) - (test #t log-level? test-logger 'info 'test) + (test #t log-level? test-logger 'info 'test2) (test #f log-level? test-logger 'info 'not-test) - (test #f log-level? test-logger 'debug 'test) + (test #f log-level? test-logger 'debug 'test2) (test 'info log-max-level test-logger) - (test 'info log-max-level test-logger 'test) + (test 'info log-max-level test-logger 'test2) (test 'warning log-max-level test-logger 'not-test) - (define r2 (make-log-receiver (current-logger) 'warning 'test 'info)) - (test #t log-level? test-logger 'info 'test) + ;; Retain receiver to avoid GC influence on tests + (test #f sync/timeout 0 r)) + +(let () + (define-logger test) + (define r2 (make-log-receiver (current-logger) 'warning 'test3 'info)) + (test #f log-level? test-logger 'info 'test3) (test #t log-level? test-logger 'info 'not-test) - (test #f log-level? test-logger 'debug 'test) + (test #f log-level? test-logger 'debug 'test3) (test 'info log-max-level test-logger) - (test 'info log-max-level test-logger 'test) + (test 'warning log-max-level test-logger 'test3) (test 'info log-max-level test-logger 'not-test) - (test #f sync/timeout 0 r) + ;; Retain receiver to avoid GC influence on tests (test #f sync/timeout 0 r2)) ; ---------------------------------------- @@ -170,6 +175,57 @@ (log-message l 'info 'sub "hey" #f) (test '#(info "sub: hey" #f sub) sync/timeout 0 r)) +;; -------------------- +;; Check logger propagate constraints + +(let () + (define l (make-logger)) + (define l2 (make-logger #f l 'error)) + (define l3 (make-logger #f l2 'warning 'test 'info)) + (define l32 (make-logger #f l2 'info 'test 'warning)) + + (define r (make-log-receiver l 'debug)) + (test #f sync/timeout 0 r) + + (log-message l 'debug "debug message" #f) + (test #t vector? (sync/timeout 0 r)) + + (define r2 (make-log-receiver l2 'info)) + (test (void) log-message l2 'warning "warning message not propagated" #f) + (test #f sync/timeout 0 r) + (test #t vector? (sync/timeout 0 r2)) + + (test (void) log-message l3 'error "error message propagated" #f) + (test #t vector? (sync/timeout 0 r)) + (test #t vector? (sync/timeout 0 r2)) + + (test (void) log-message l3 'info "info message partially propagated" #f) + (test #f sync/timeout 0 r) + (test #t vector? (sync/timeout 0 r2)) + + (test (void) log-message l3 'info 'test "info message not propagated" #f) + (test #f sync/timeout 0 r) + (test #f sync/timeout 0 r2) + + (test 'debug log-max-level l) + (test 'info log-max-level l2) + (test 'info log-max-level l3) + + (define r22 (make-log-receiver l2 'debug)) + (test 'debug log-max-level l) + (test 'debug log-max-level l2) + (test 'info log-max-level l3) + (test 'warning log-max-level l3 'test) + (test 'info log-max-level l3 'not-test) + (test 'info log-max-level l32) + (test 'warning log-max-level l32 'not-test) + (test 'info log-max-level l32 'test) + + ;; Retain receivers to avoid GC influence on tests + (test #f sync/timeout 0 r) + (test #f sync/timeout 0 r2) + (test #f sync/timeout 0 r22)) + ; -------------------- (report-errs) diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index 33adcd338b..d724392512 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -727,7 +727,7 @@ void scheme_init_error(Scheme_Env *env) GLOBAL_NONCM_PRIM("exit", scheme_do_exit, 0, 1, env); GLOBAL_NONCM_PRIM("log-level?", log_level_p, 2, 3, env); GLOBAL_NONCM_PRIM("log-max-level", log_max_level, 1, 2, env); - GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, 2, env); + GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, -1, env); GLOBAL_NONCM_PRIM("make-log-receiver", make_log_reader, 2, -1, env); GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 6, env); @@ -3458,19 +3458,12 @@ static int extract_max_spec_level(Scheme_Object *level_spec, Scheme_Object *name void update_want_level(Scheme_Logger *logger, Scheme_Object *name) { Scheme_Log_Reader *lr; - Scheme_Object *stack = NULL, *queue, *b, *prev; - Scheme_Logger *parent = logger, *orig_logger = logger; - int want_level, level; - - while (parent) { - stack = scheme_make_raw_pair((Scheme_Object *)parent, stack); - parent = parent->parent; - } + Scheme_Object *queue, *b, *prev; + Scheme_Logger *parent = logger; + int want_level, level, ceiling_level = SCHEME_LOG_DEBUG; want_level = 0; - while (stack) { - parent = (Scheme_Logger *)SCHEME_CAR(stack); - + while (parent) { queue = parent->readers; prev = NULL; while (queue) { @@ -3479,8 +3472,12 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name) lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b); if (lr) { level = extract_max_spec_level(lr->level, name); + if (level > ceiling_level) + level = ceiling_level; if (level > want_level) want_level = level; + if (want_level >= ceiling_level) + break; prev = queue; } else { if (prev) @@ -3498,7 +3495,17 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name) if (level > want_level) want_level = level; - stack = SCHEME_CDR(stack); + if (parent->propagate_level) + level = extract_max_spec_level(parent->propagate_level, name); + else + level = SCHEME_LOG_DEBUG; + if (level <= ceiling_level) + ceiling_level = level; + + if (want_level >= ceiling_level) + break; + + parent = parent->parent; } if (!name) { @@ -3508,8 +3515,6 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name) # define WANT_NAME_LEVEL_CACHE_SIZE 8 int i; - logger = orig_logger; - b = logger->want_name_level_cache; if (!b) { b = scheme_make_vector(3 * WANT_NAME_LEVEL_CACHE_SIZE, scheme_make_integer(-1)); @@ -3783,6 +3788,11 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object queue = SCHEME_CDR(queue); } + if (logger->parent && logger->propagate_level) { + if (extract_spec_level(logger->propagate_level, name) < level) + break; + } + logger = logger->parent; } } @@ -3991,10 +4001,42 @@ log_max_level(int argc, Scheme_Object *argv[]) } } +static Scheme_Object *get_levels_and_names(const char *who, int i, int argc, Scheme_Object **argv, + int default_lvl) +{ + int lvl; + Scheme_Object *level = scheme_null, *last = NULL; + + for (; i < argc; i += 2) { + lvl = extract_level(who, 1, i, argc, argv); + if ((i+1) < argc) { + if (SCHEME_FALSEP(argv[i+1])) + default_lvl = lvl; + else { + if (!SCHEME_SYMBOLP(argv[i+1])) + scheme_wrong_contract(who, "(or/c symbol? #f)", i+1, argc, argv); + level = scheme_make_pair(argv[i+1], level); + if (!last) last = level; + level = scheme_make_pair(scheme_make_integer(lvl), level); + } + } else { + default_lvl = lvl; + } + } + + if (last) + SCHEME_CDR(last) = scheme_make_integer(default_lvl); + else + level = scheme_make_integer(default_lvl); + + return level; +} + static Scheme_Object * make_logger(int argc, Scheme_Object *argv[]) { Scheme_Logger *parent, *logger; + Scheme_Object *propagate_level; if (argc) { if (!SCHEME_FALSEP(argv[0]) && !SCHEME_SYMBOLP(argv[0])) @@ -4013,11 +4055,17 @@ make_logger(int argc, Scheme_Object *argv[]) } else parent = NULL; + propagate_level = get_levels_and_names("make-logger", 2, argc, argv, + SCHEME_LOG_DEBUG); + logger = scheme_make_logger(parent, (argc ? (SCHEME_FALSEP(argv[0]) ? NULL : argv[0]) : NULL)); - + + if (parent) + logger->propagate_level = propagate_level; + return (Scheme_Object *)logger; } @@ -4076,34 +4124,13 @@ make_log_reader(int argc, Scheme_Object *argv[]) Scheme_Logger *logger; Scheme_Log_Reader *lr; Scheme_Object *sema, *q; - int default_lvl = 0, lvl, i; - Scheme_Object *level = scheme_null, *last = NULL; + Scheme_Object *level; if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type)) scheme_wrong_contract("make-log-receiver", "logger?", 0, argc, argv); logger = (Scheme_Logger *)argv[0]; - for (i = 1; i < argc; i += 2) { - lvl = extract_level("make-log-receiver", 1, i, argc, argv); - if ((i+1) < argc) { - if (SCHEME_FALSEP(argv[i+1])) - default_lvl = lvl; - else { - if (!SCHEME_SYMBOLP(argv[i+1])) - scheme_wrong_contract("make-log-receiver", "(or/c symbol? #f)", i+1, argc, argv); - level = scheme_make_pair(argv[i+1], level); - if (!last) last = level; - level = scheme_make_pair(scheme_make_integer(lvl), level); - } - } else { - default_lvl = lvl; - } - } - - if (last) - SCHEME_CDR(last) = scheme_make_integer(default_lvl); - else - level = scheme_make_integer(default_lvl); + level = get_levels_and_names("make-log-receiver", 1, argc, argv, 0); lr = MALLOC_ONE_TAGGED(Scheme_Log_Reader); lr->so.type = scheme_log_reader_type; diff --git a/racket/src/racket/src/mzmark_type.inc b/racket/src/racket/src/mzmark_type.inc index 33d1eeb162..27105fda95 100644 --- a/racket/src/racket/src/mzmark_type.inc +++ b/racket/src/racket/src/mzmark_type.inc @@ -3008,6 +3008,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) { gcMARK2(l->timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); return gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); @@ -3021,6 +3022,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(l->timestamp, gc); gcFIXUP2(l->syslog_level, gc); gcFIXUP2(l->stderr_level, gc); + gcFIXUP2(l->propagate_level, gc); gcFIXUP2(l->readers, gc); return gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 343dae2355..b310267fb8 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -1211,6 +1211,7 @@ mark_logger { gcMARK2(l->timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); size: gcBYTES_TO_WORDS(sizeof(Scheme_Logger)); diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index d7a0e6b98f..af5c2cec45 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3697,6 +3697,7 @@ struct Scheme_Logger { intptr_t *timestamp, local_timestamp; /* determines when want_level is up-to-date */ Scheme_Object *syslog_level; /* (list* ... ) */ Scheme_Object *stderr_level; + Scheme_Object *propagate_level; /* can be NULL */ Scheme_Object *readers; /* list of (cons (make-weak-box ) ) */ };