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

logger: fix problems with level checking, add option to log-message

Browse Source 
Logged messages could get dropped if a log receiver is specialized
to a name that is provided as an argument to `log-message` instead
of used from the target logger.

Add an option to `log-message` to avoid adding the name to the
start of the message string, which is needed to propagate messages
from one logger to another.
This commit is contained in:
Matthew Flatt 2014-05-26 16:50:48 +01:00
parent da654f09bc
commit e16b6fd06e
11 changed files with 86 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -93,7 +93,7 @@ Creates a new @tech{logger} with an optional name and parent.
If @racket[notify-callback] is provided, then it is called (under a
@tech{continuation barrier}) whenever an event is logged to the result
@tech{logger} or one of its descendants, but only if some @tech{log
receiver} is inteested in the event in the same sense as
receiver} is interested in the event in the same sense as
@racket[log-level?]. The event is not propagated to any @tech{log
receivers} until @racket[notify-callback] returns.}
@ -128,7 +128,8 @@ created when @racket[define-logger] is evaluated.}
[level (or/c 'fatal 'error 'warning 'info 'debug)]
[name (or/c symbol? #f) (object-name logger)]
[message string?]
[data any/c])
[data any/c]
[prefix-message? any/c #t])
void?]{
Reports an event to @racket[logger], which in turn distributes the
@ -137,9 +138,11 @@ its ancestors that are interested in events at @racket[level] or
higher.
@tech{Log receivers} can filter events based on @racket[name]. In
addition, if @racket[name] is not @racket[#f], then @racket[message]
is prefixed with the name followed by @racket[": "] before it is sent
to receivers.}
addition, if @racket[name] and @racket[prefix-message?] are not
@racket[#f], then @racket[message] is prefixed with the name followed
by @racket[": "] before it is sent to receivers.
@history[#:changed "6.0.1.10" @elem{Added the @racket[prefix-message?] argument.}]}
@defproc[(log-level? [logger logger?]

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

@ -34,6 +34,12 @@
(test (and on?
(vector level "name: message" 'data 'name))
sync/timeout 0 lr))
lrs)
(log-message l level 'name "message" 'data #f)
(for-each (lambda (lr)
(test (and on?
(vector level "message" 'data 'name))
sync/timeout 0 lr))
lrs))])
(test #t logger? l)
(test 'test logger-name l)
@ -174,4 +180,12 @@
; --------------------
(let ()
(define l (make-logger))
(define r (make-log-receiver l 'info 'sub))
(log-message l 'info 'sub "hey" #f)
(test '#(info "sub: hey" #f sub) sync/timeout 0 r))
; --------------------
(report-errs)

1
racket/src/racket/include/mzwin.def
View File

@ -110,6 +110,7 @@ EXPORTS
scheme_log_w_data
scheme_log_message
scheme_log_name_message
scheme_log_name_pfx_message
scheme_log_abort
scheme_log_warning
scheme_glib_log_message

1
racket/src/racket/include/mzwin3m.def
View File

@ -110,6 +110,7 @@ EXPORTS
scheme_log_w_data
scheme_log_message
scheme_log_name_message
scheme_log_name_pfx_message
scheme_log_abort
scheme_log_warning
scheme_glib_log_message

1
racket/src/racket/include/racket.exp
View File

@ -108,6 +108,7 @@ scheme_log
scheme_log_w_data
scheme_log_message
scheme_log_name_message
scheme_log_name_pfx_message
scheme_log_abort
scheme_log_warning
scheme_glib_log_message

1
racket/src/racket/include/racket3m.exp
View File

@ -108,6 +108,7 @@ scheme_log
scheme_log_w_data
scheme_log_message
scheme_log_name_message
scheme_log_name_pfx_message
scheme_log_abort
scheme_log_warning
scheme_glib_log_message

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

@ -730,7 +730,7 @@ void scheme_init_error(Scheme_Env *env)
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, 3, env);
GLOBAL_NONCM_PRIM("make-log-receiver", make_log_reader, 2, -1, env);
GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 5, env);
GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 6, env);
GLOBAL_FOLDING_PRIM("logger?", logger_p, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("logger-name", logger_name, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("log-receiver?", log_reader_p, 1, 1, 1, env);
@ -3434,6 +3434,27 @@ static int extract_spec_level(Scheme_Object *level_spec, Scheme_Object *name)
}
}
static int extract_max_spec_level(Scheme_Object *level_spec)
{
int mx = 0, v;
if (level_spec) {
while (1) {
if (SCHEME_INTP(level_spec)) {
v = SCHEME_INT_VAL(level_spec);
if (v > mx) mx = v;
break;
} else {
v = SCHEME_INT_VAL(SCHEME_CAR(level_spec));
if (v > mx) mx = v;
level_spec = SCHEME_CDR(SCHEME_CDR(level_spec));
}
}
}
return mx;
}
void update_want_level(Scheme_Logger *logger)
{
Scheme_Log_Reader *lr;
@ -3457,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_spec_level(lr->level, logger->name);
level = extract_max_spec_level(lr->level);
if (level > want_level)
want_level = level;
prev = queue;
@ -3470,10 +3491,10 @@ void update_want_level(Scheme_Logger *logger)
queue = SCHEME_CDR(queue);
}
level = extract_spec_level(parent->syslog_level, logger->name);
level = extract_max_spec_level(parent->syslog_level);
if (level > want_level)
want_level = level;
level = extract_spec_level(parent->stderr_level, logger->name);
level = extract_max_spec_level(parent->stderr_level);
if (level > want_level)
want_level = level;
@ -3496,7 +3517,7 @@ static mzReportEventProc mzReportEvent;
static Scheme_Object *make_log_message(int level, Scheme_Object *name,
static Scheme_Object *make_log_message(int level, Scheme_Object *name, int prefix_msg,
char *buffer, intptr_t len, Scheme_Object *data) {
Scheme_Object *msg;
Scheme_Object *v;
@ -3522,7 +3543,7 @@ static Scheme_Object *make_log_message(int level, Scheme_Object *name,
}
SCHEME_VEC_ELS(msg)[0] = v;
if (name) {
if (name && prefix_msg) {
/* Add logger name prefix: */
intptr_t slen;
char *cp;
@ -3546,8 +3567,9 @@ static Scheme_Object *make_log_message(int level, Scheme_Object *name,
return msg;
}
void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data)
void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data,
int prefix_msg)
{
/* This function must avoid GC allocation when called with the
configuration of scheme_log_abort(). */
@ -3575,7 +3597,7 @@ void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *na
if (lo->callback) {
Scheme_Object *a[1];
if (!msg)
msg = make_log_message(level, name, buffer, len, data);
msg = make_log_message(level, name, prefix_msg, buffer, len, data);
a[0] = msg;
scheme_apply_multi(lo->callback, 1, a);
@ -3697,7 +3719,7 @@ void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *na
if (lr) {
if (extract_spec_level(lr->level, name) >= level) {
if (!msg)
msg = make_log_message(level, name, buffer, len, data);
msg = make_log_message(level, name, prefix_msg, buffer, len, data);
/* enqueue */
q = scheme_make_raw_pair(msg, NULL);
@ -3716,9 +3738,15 @@ void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *na
}
}
void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data)
{
scheme_log_name_pfx_message(logger, level, name, buffer, len, data, 1);
}
void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data)
{
scheme_log_name_message(logger, level, NULL, buffer, len, data);
scheme_log_name_pfx_message(logger, level, NULL, buffer, len, data, 1);
}
void scheme_log_abort(char *buffer)
@ -3825,7 +3853,7 @@ log_message(int argc, Scheme_Object *argv[])
Scheme_Logger *logger;
Scheme_Object *bytes;
Scheme_Object *name;
int level, pos;
int level, pos, pfx;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_contract("log-message", "logger?", 0, argc, argv);
@ -3845,7 +3873,14 @@ log_message(int argc, Scheme_Object *argv[])
bytes = scheme_char_string_to_byte_string(bytes);
pos++;
scheme_log_name_message(logger, level, name, SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[pos]);
if (argc >= (pos+1))
pfx = SCHEME_TRUEP(argv[pos+1]);
else
pfx = 1;
scheme_log_name_pfx_message(logger, level, name,
SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[pos],
pfx);
return scheme_void;
}

6
racket/src/racket/src/schemef.h
View File

@ -226,7 +226,11 @@ MZ_EXTERN void scheme_log_w_data(Scheme_Logger *logger, int level, int flags,
Scheme_Object *data,
const char *msg, ...);
MZ_EXTERN void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data);
MZ_EXTERN void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *name, char *buffer, intptr_t len, Scheme_Object *data);
MZ_EXTERN void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data);
MZ_EXTERN void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data,
int prefix_message);
MZ_EXTERN void scheme_log_abort(char *buffer);
MZ_EXTERN void scheme_log_warning(char *buffer);
MZ_EXTERN void scheme_glib_log_message(const char *log_domain, int log_level, const char *message, void *user_data);

6
racket/src/racket/src/schemex.h
View File

@ -164,7 +164,11 @@ void (*scheme_log_w_data)(Scheme_Logger *logger, int level, int flags,
Scheme_Object *data,
const char *msg, ...);
void (*scheme_log_message)(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data);
void (*scheme_log_name_message)(Scheme_Logger *logger, int level, Scheme_Object *name, char *buffer, intptr_t len, Scheme_Object *data);
void (*scheme_log_name_message)(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data);
void (*scheme_log_name_pfx_message)(Scheme_Logger *logger, int level, Scheme_Object *name,
char *buffer, intptr_t len, Scheme_Object *data,
int prefix_message);
void (*scheme_log_abort)(char *buffer);
void (*scheme_log_warning)(char *buffer);
void (*scheme_glib_log_message)(const char *log_domain, int log_level, const char *message, void *user_data);

1
racket/src/racket/src/schemex.inc
View File

@ -116,6 +116,7 @@
scheme_extension_table->scheme_log_w_data = scheme_log_w_data;
scheme_extension_table->scheme_log_message = scheme_log_message;
scheme_extension_table->scheme_log_name_message = scheme_log_name_message;
scheme_extension_table->scheme_log_name_pfx_message = scheme_log_name_pfx_message;
scheme_extension_table->scheme_log_abort = scheme_log_abort;
scheme_extension_table->scheme_log_warning = scheme_log_warning;
scheme_extension_table->scheme_glib_log_message = scheme_glib_log_message;

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

@ -116,6 +116,7 @@
#define scheme_log_w_data (scheme_extension_table->scheme_log_w_data)
#define scheme_log_message (scheme_extension_table->scheme_log_message)
#define scheme_log_name_message (scheme_extension_table->scheme_log_name_message)
#define scheme_log_name_pfx_message (scheme_extension_table->scheme_log_name_pfx_message)
#define scheme_log_abort (scheme_extension_table->scheme_log_abort)
#define scheme_log_warning (scheme_extension_table->scheme_log_warning)
#define scheme_glib_log_message (scheme_extension_table->scheme_glib_log_message)