suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

log-level?, log-max-level: accept optional name argument

Browse Source 
Change `log-error`, etc., to check the name that will be used for
the message, in addition to the log level.
This commit is contained in:
Matthew Flatt 2014-10-28 10:57:23 -06:00
parent 65e323d266
commit 83b4595741
7 changed files with 155 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pkgs/racket-pkgs/racket-doc/scribblings/reference/logging.scrbl
View File

@ -141,12 +141,20 @@ by @racket[": "] before it is sent to receivers.
@defproc[(log-level? [logger logger?]
[level (or/c 'fatal 'error 'warning 'info 'debug)])
[level (or/c 'fatal 'error 'warning 'info 'debug)]
[name (or/c symbol? #f) #f])
boolean?]{
Reports whether any @tech{log receiver} attached to @racket[logger] or
one of its ancestors is interested in @racket[level] events (or
potentially lower). Use this function to avoid work generating an
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.
Use this function to avoid work generating an
event for @racket[log-message] if no receiver is interested in the
information; this shortcut is built into @racket[log-fatal],
@racket[log-error], @racket[log-warning], @racket[log-info],
@ -155,16 +163,21 @@ however, so it should not be used with those forms.
The result of this function can change if a garbage collection
determines that a log receiver is no longer accessible (and therefore
that any event information it receives will never become accessible).}
that any event information it receives will never become accessible).
@history[#:changed "6.1.1.3" @elem{Added the @racket[name] argument.}]}
@defproc[(log-max-level [logger logger?])
@defproc[(log-max-level [logger logger?]
[name (or/c symbol? #f) #f])
(or/c #f 'fatal 'error 'warning 'info 'debug)]{
Similar to @racket[log-level?], but reports the maximum level of logging for
which @racket[log-level?] on @racket[logger] returns @racket[#t]. The
which @racket[log-level?] on @racket[logger] and @racket[name] returns @racket[#t]. The
result is @racket[#f] if @racket[log-level?] with @racket[logger]
currently returns @racket[#f] for all levels.}
currently returns @racket[#f] for all levels.
@history[#:changed "6.1.1.3" @elem{Added the @racket[name] argument.}]}
@deftogether[(

21
pkgs/racket-pkgs/racket-test/tests/racket/logger.rktl
View File

@ -98,6 +98,27 @@
(log-test-warning "warning")
(test "test: warning" (lambda (v) (vector-ref v 1)) (sync r)))
(let ()
(define-logger test)
(define r (make-log-receiver (current-logger) 'info 'test 'warning))
(test #t log-level? test-logger 'warning)
(test #t log-level? test-logger 'info)
(test #t log-level? test-logger 'info 'test)
(test #f log-level? test-logger 'info 'not-test)
(test #f log-level? test-logger 'debug 'test)
(test 'info log-max-level test-logger)
(test 'info log-max-level test-logger 'test)
(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)
(test #t log-level? test-logger 'info 'not-test)
(test #f log-level? test-logger 'debug 'test)
(test 'info log-max-level test-logger)
(test 'info log-max-level test-logger 'test)
(test 'info log-max-level test-logger 'not-test)
(test #f sync/timeout 0 r)
(test #f sync/timeout 0 r2))
; ----------------------------------------
(let ()

29
racket/collects/racket/private/logger.rkt
View File

@ -6,25 +6,26 @@
(#%provide log-fatal log-error log-warning log-info log-debug
define-logger)
(define-for-syntax (make-define-log mode X-logger-stx)
(define-for-syntax (make-define-log mode X-logger-stx name)
(lambda (stx)
(with-syntax ([X-logger X-logger-stx]
[mode mode])
[mode mode]
[name name])
(syntax-case stx ()
[(_ str-expr)
#'(let ([l X-logger])
(when (log-level? l 'mode)
(when (log-level? l 'mode name)
(log-message l 'mode str-expr (current-continuation-marks))))]
[(_ str-expr arg ...)
#'(let ([l X-logger])
(when (log-level? l 'mode)
(when (log-level? l 'mode name)
(log-message l 'mode (format str-expr arg ...) (current-continuation-marks))))]))))
(define-syntax log-fatal (make-define-log 'fatal #'(current-logger)))
(define-syntax log-error (make-define-log 'error #'(current-logger)))
(define-syntax log-warning (make-define-log 'warning #'(current-logger)))
(define-syntax log-info (make-define-log 'info #'(current-logger)))
(define-syntax log-debug (make-define-log 'debug #'(current-logger)))
(define-syntax log-fatal (make-define-log 'fatal #'(current-logger) #'(logger-name l)))
(define-syntax log-error (make-define-log 'error #'(current-logger) #'(logger-name l)))
(define-syntax log-warning (make-define-log 'warning #'(current-logger) #'(logger-name l)))
(define-syntax log-info (make-define-log 'info #'(current-logger) #'(logger-name l)))
(define-syntax log-debug (make-define-log 'debug #'(current-logger) #'(logger-name l)))
(define (check-logger who)
(lambda (v)
@ -50,8 +51,8 @@
[X X])
#'(begin
(define X-logger (make-logger 'X (current-logger)))
(define-syntax log-X-fatal (make-define-log 'fatal #'X-logger))
(define-syntax log-X-error (make-define-log 'error #'X-logger))
(define-syntax log-X-warning (make-define-log 'warning #'X-logger))
(define-syntax log-X-info (make-define-log 'info #'X-logger))
(define-syntax log-X-debug (make-define-log 'debug #'X-logger)))))])))
(define-syntax log-X-fatal (make-define-log 'fatal #'X-logger #''X))
(define-syntax log-X-error (make-define-log 'error #'X-logger #''X))
(define-syntax log-X-warning (make-define-log 'warning #'X-logger #''X))
(define-syntax log-X-info (make-define-log 'info #'X-logger #''X))
(define-syntax log-X-debug (make-define-log 'debug #'X-logger #''X)))))])))

118
racket/src/racket/src/error.c
View File

@ -133,7 +133,7 @@ static int log_reader_get(Scheme_Object *ch, Scheme_Schedule_Info *sinfo);
static Scheme_Object *do_raise(Scheme_Object *arg, int need_debug, int barrier);
static Scheme_Object *nested_exn_handler(void *old_exn, int argc, Scheme_Object *argv[]);
static void update_want_level(Scheme_Logger *logger);
static void update_want_level(Scheme_Logger *logger, Scheme_Object *name);
static Scheme_Object *check_arity_property_value_ok(int argc, Scheme_Object *argv[]);
@ -725,8 +725,8 @@ void scheme_init_error(Scheme_Env *env)
/* logging */
GLOBAL_NONCM_PRIM("exit", scheme_do_exit, 0, 1, env);
GLOBAL_NONCM_PRIM("log-level?", log_level_p, 2, 2, env);
GLOBAL_NONCM_PRIM("log-max-level", log_max_level, 1, 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-log-receiver", make_log_reader, 2, -1, env);
@ -1081,7 +1081,7 @@ int scheme_log_level_p(Scheme_Logger *logger, int level)
}
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
update_want_level(logger, NULL);
return (logger->want_level >= level);
}
@ -3431,10 +3431,13 @@ static int extract_spec_level(Scheme_Object *level_spec, Scheme_Object *name)
}
}
static int extract_max_spec_level(Scheme_Object *level_spec)
static int extract_max_spec_level(Scheme_Object *level_spec, Scheme_Object *name)
{
int mx = 0, v;
if (name)
return extract_spec_level(level_spec, name);
if (level_spec) {
while (1) {
if (SCHEME_INTP(level_spec)) {
@ -3452,11 +3455,11 @@ static int extract_max_spec_level(Scheme_Object *level_spec)
return mx;
}
void update_want_level(Scheme_Logger *logger)
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;
Scheme_Logger *parent = logger, *orig_logger = logger;
int want_level, level;
while (parent) {
@ -3475,7 +3478,7 @@ void update_want_level(Scheme_Logger *logger)
b = SCHEME_CAR(b);
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
if (lr) {
level = extract_max_spec_level(lr->level);
level = extract_max_spec_level(lr->level, name);
if (level > want_level)
want_level = level;
prev = queue;
@ -3488,18 +3491,80 @@ void update_want_level(Scheme_Logger *logger)
queue = SCHEME_CDR(queue);
}
level = extract_max_spec_level(parent->syslog_level);
level = extract_max_spec_level(parent->syslog_level, name);
if (level > want_level)
want_level = level;
level = extract_max_spec_level(parent->stderr_level);
level = extract_max_spec_level(parent->stderr_level, name);
if (level > want_level)
want_level = level;
stack = SCHEME_CDR(stack);
}
logger->want_level = want_level;
logger->local_timestamp = *logger->timestamp;
if (!name) {
logger->want_level = want_level;
logger->local_timestamp = *logger->timestamp;
} else {
# 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));
logger->want_name_level_cache = b;
}
/* find a slot already matching this name? */
for (i = SCHEME_VEC_SIZE(b); (i -= 3) >= 0; ) {
if (SAME_OBJ(name, SCHEME_VEC_ELS(b)[i]))
break;
}
if (i == 0) abort();
if (i < 0) {
/* find an out-of-date slot? */
for (i = SCHEME_VEC_SIZE(b); (i -= 3) >= 0; ) {
if (SCHEME_INT_VAL(SCHEME_VEC_ELS(b)[i+1]) < *logger->timestamp)
break;
}
if (i < 0) {
/* rotate cache */
i = 3 * (WANT_NAME_LEVEL_CACHE_SIZE - 1);
memmove(&(SCHEME_VEC_ELS(b)[0]),
&(SCHEME_VEC_ELS(b)[3]),
i * sizeof(Scheme_Object *));
}
}
SCHEME_VEC_ELS(b)[i] = name;
SCHEME_VEC_ELS(b)[i+1] = scheme_make_integer(*logger->timestamp);
SCHEME_VEC_ELS(b)[i+2] = scheme_make_integer(want_level);
}
}
static int get_want_level(Scheme_Logger *logger, Scheme_Object *name)
{
if (name && SCHEME_TRUEP(name)) {
while (1) {
if (logger->want_name_level_cache) {
int i;
for (i = SCHEME_VEC_SIZE(logger->want_name_level_cache); (i -= 3) >= 0; ) {
if (SAME_OBJ(name, SCHEME_VEC_ELS(logger->want_name_level_cache)[i])) {
if (SCHEME_INT_VAL(SCHEME_VEC_ELS(logger->want_name_level_cache)[i+1]) == *logger->timestamp) {
return SCHEME_INT_VAL(SCHEME_VEC_ELS(logger->want_name_level_cache)[i+2]);
}
}
}
}
update_want_level(logger, name);
}
} else {
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger, NULL);
return logger->want_level;
}
}
#ifdef USE_WINDOWS_EVENT_LOG
@ -3572,7 +3637,6 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object
configuration of scheme_log_abort(). */
Scheme_Object *queue, *q, *msg = NULL, *b;
Scheme_Log_Reader *lr;
Scheme_Logger *lo;
if (!logger) {
Scheme_Config *config;
@ -3581,7 +3645,7 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object
}
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
update_want_level(logger, NULL);
if (logger->want_level < level)
return;
@ -3874,7 +3938,8 @@ static Scheme_Object *
log_level_p(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
int level;
Scheme_Object *name = scheme_false;
int level, want_level;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_contract("log-level?", "logger?", 0, argc, argv);
@ -3882,25 +3947,34 @@ log_level_p(int argc, Scheme_Object *argv[])
level = extract_level("log-level?", 0, 1, argc, argv);
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
if (argc > 2) {
if (!SCHEME_FALSEP(argv[2]) && !SCHEME_SYMBOLP(argv[2]))
scheme_wrong_contract("log-level?", "(or/c f? #symbol)", 2, argc, argv);
name = argv[2];
}
return ((logger->want_level >= level) ? scheme_true : scheme_false);
want_level = get_want_level(logger, name);
return ((want_level >= level) ? scheme_true : scheme_false);
}
static Scheme_Object *
log_max_level(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
Scheme_Object *name = scheme_false;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_contract("log-max-level", "logger?", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
if (logger->local_timestamp < *logger->timestamp)
update_want_level(logger);
switch (logger->want_level) {
if (argc > 1) {
if (!SCHEME_FALSEP(argv[1]) && !SCHEME_SYMBOLP(argv[1]))
scheme_wrong_contract("log-max-level", "(or/c f? #symbol)", 1, argc, argv);
name = argv[1];
}
switch (get_want_level(logger, name)) {
case 0:
return scheme_false;
case SCHEME_LOG_FATAL:

2
racket/src/racket/src/mzmark_type.inc
View File

@ -3004,6 +3004,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) {
Scheme_Logger *l = (Scheme_Logger *)p;
gcMARK2(l->name, gc);
gcMARK2(l->parent, gc);
gcMARK2(l->want_name_level_cache, gc);
gcMARK2(l->timestamp, gc);
gcMARK2(l->syslog_level, gc);
gcMARK2(l->stderr_level, gc);
@ -3016,6 +3017,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) {
Scheme_Logger *l = (Scheme_Logger *)p;
gcFIXUP2(l->name, gc);
gcFIXUP2(l->parent, gc);
gcFIXUP2(l->want_name_level_cache, gc);
gcFIXUP2(l->timestamp, gc);
gcFIXUP2(l->syslog_level, gc);
gcFIXUP2(l->stderr_level, gc);

1
racket/src/racket/src/mzmarksrc.c
View File

@ -1207,6 +1207,7 @@ mark_logger {
Scheme_Logger *l = (Scheme_Logger *)p;
gcMARK2(l->name, gc);
gcMARK2(l->parent, gc);
gcMARK2(l->want_name_level_cache, gc);
gcMARK2(l->timestamp, gc);
gcMARK2(l->syslog_level, gc);
gcMARK2(l->stderr_level, gc);

1
racket/src/racket/src/schpriv.h
View File

@ -3693,6 +3693,7 @@ struct Scheme_Logger {
Scheme_Object *name;
Scheme_Logger *parent;
int want_level;
Scheme_Object *want_name_level_cache; /* vector */
intptr_t *timestamp, local_timestamp; /* determines when want_level is up-to-date */
Scheme_Object *syslog_level; /* (list* <level-int> <name-sym> ... <level-int>) */
Scheme_Object *stderr_level;