logging: allow name in `log-message', report it in a log-receiver evt
The synchronization result of a log receiver is now a vector of four values, instead of three, where the last one reports the name. Also, an optional argument to `make-logger' provides a notification callback for each event sent to the logger. These changes enable more control over loggers and events. Suppose that you have processes A and B, and you want all log events of A to be visible to B, but not vice-versa. Furthermore, you want the log events to appear at B in the right order: if A logs an event before B, then A's event should arrive at a log receiver's before B's. Now that a log receiver gets the name associated with the original event, and now that the name can be re-sent in a `log-receiver', it's possible to give A and B separate loggers and send all of the events from A's logger to B's logger. Furthermore, you can use the notification callback so that when an event is logged in B, you can make sure that all available events from from A's logger have been transferred to B's logger.
This commit is contained in:
Matthew Flatt
parent
a39004241e
commit
f2d870859a
|
|
@ -16,13 +16,14 @@ levels, in decreasing order of importance, are @racket['fatal],
|
|||
|
||||
To help organize logged events, @tech{loggers} can be named and
|
||||
hierarchical. Every event reported to a logger is also propagated to
|
||||
its parent (if any), but the event message is prefixed with the name
|
||||
(if any) of the logger to which is was originally reported. A logger
|
||||
is not required to have a parent or name.
|
||||
its parent (if any), but the event message is prefixed with a name (if
|
||||
any) that is typically the name of the logger to which is was
|
||||
originally reported. A logger is not required to have a parent or
|
||||
name.
|
||||
|
||||
On start-up, Racket creates an initial logger that is used to
|
||||
record events from the core run-time system. For example, an
|
||||
@racket['info] event is reported for each garbage collection (see
|
||||
@racket['debug] event is reported for each garbage collection (see
|
||||
@secref["gc-model"]). For this initial logger, two log receivers are
|
||||
also created: one that writes events to the process's original error
|
||||
output port, and one that writes events to the system log. The level
|
||||
|
|
@ -44,12 +45,12 @@ through environment variables:
|
|||
initial @nonterm{level}, the value can contain space-separated
|
||||
specifications of the form
|
||||
@nonterm{level}@litchar["@"]@nonterm{name}, which prints events
|
||||
from loggers whose name match @nonterm{name} only at the given
|
||||
whose names match @nonterm{name} only at the given
|
||||
@nonterm{level} or higher (where a @nonterm{name} contains any
|
||||
character other than a space or @litchar["@"]). For example,
|
||||
the value @racket["error debug@GC"] prints all events at the
|
||||
@racket['error] level and higher, but prints events for a
|
||||
logger named @racket['GC] at the @racket['debug] level and
|
||||
@racket['error] level and higher, but prints events
|
||||
named @racket['GC] at the @racket['debug] level and
|
||||
higher (which includes all levels).
|
||||
|
||||
The default is @racket["error"].}
|
||||
|
|
@ -83,10 +84,18 @@ otherwise.}
|
|||
|
||||
|
||||
@defproc[(make-logger [name (or/c symbol? #f) #f]
|
||||
[parent (or/c logger? #f) #f])
|
||||
[parent (or/c logger? #f) #f]
|
||||
[notify-callback (vector? . -> . any/c)])
|
||||
logger?]{
|
||||
|
||||
Creates a new logger with an optional name and parent.}
|
||||
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
|
||||
@racket[log-level?]. The event is not propagated to any @tech{log
|
||||
receivers} until @racket[notify-callback] returns.}
|
||||
|
||||
|
||||
@defproc[(logger-name [logger logger?]) (or/c symbol? #f)]{
|
||||
|
|
@ -117,6 +126,7 @@ created when @racket[define-logger] is evaluated.}
|
|||
|
||||
@defproc[(log-message [logger logger?]
|
||||
[level (or/c 'fatal 'error 'warning 'info 'debug)]
|
||||
[name (or/c symbol? #f) (object-name logger)]
|
||||
[message string?]
|
||||
[data any/c])
|
||||
void?]{
|
||||
|
|
@ -126,9 +136,10 @@ information to any @tech{log receivers} attached to @racket[logger] or
|
|||
its ancestors that are interested in events at @racket[level] or
|
||||
higher.
|
||||
|
||||
If @racket[logger] has a name, then @racket[message] is prefixed with
|
||||
the logger's name followed by @racket[": "] before it is sent to
|
||||
receivers.}
|
||||
@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.}
|
||||
|
||||
|
||||
@defproc[(log-level? [logger logger?]
|
||||
|
|
@ -225,21 +236,23 @@ otherwise.}
|
|||
Creates a @tech{log receiver} to receive events of importance
|
||||
@racket[level] and higher as reported to @racket[logger] and its
|
||||
descendants, as long as either @racket[name] is @racket[#f] or the
|
||||
reporting logger's name matches @racket[name].
|
||||
event's name matches @racket[name].
|
||||
|
||||
A @tech{log receiver} is a @tech{synchronizable event}. It becomes
|
||||
@tech{ready for synchronization} when a logging event is
|
||||
received, so use @racket[sync] to receive an logged event. The
|
||||
@tech{log receiver}'s @tech{synchronization result} is a vector containing
|
||||
three values: the level of the event as a symbol, an immutable string
|
||||
for the event message, and an arbitrary value that was supplied as the
|
||||
last argument to @racket[log-message] when the event was logged.
|
||||
@tech{log receiver}'s @tech{synchronization result} is an immutable vector containing
|
||||
four values: the level of the event as a symbol, an immutable string
|
||||
for the event message, an arbitrary value that was supplied as the
|
||||
last argument to @racket[log-message] when the event was logged, and a
|
||||
symbol or @racket[#f] for the event name (where a symbol is usually
|
||||
the name of the original logger for the event).
|
||||
|
||||
Multiple pairs of @racket[level] and @racket[name] can be provided to
|
||||
indicate different specific @racket[level]s for different
|
||||
@racket[name]s (where @racket[name] defaults to @racket[#f] only for
|
||||
the last given @racket[level]). A @racket[level] for a @racket[#f]
|
||||
@racket[name] applies only to loggers whose names do not match any other
|
||||
@racket[name] applies only to events whose names do not match any other
|
||||
provided @racket[name]. If the same @racket[name] is provided multiple
|
||||
times, the @racket[level] provided with the last instance in the
|
||||
argument list takes precedence.}
|
||||
|
|
|
|||
|
|
@ -142,8 +142,8 @@ is not controlled by the current inspector, the
|
|||
Returns a value for the name of @racket[v] if @racket[v] has a name,
|
||||
@racket[#f] otherwise. The argument @racket[v] can be any value, but
|
||||
only (some) procedures, @tech{structures}, @tech{structure types},
|
||||
@tech{structure type properties}, @tech{regexp values}, and
|
||||
@tech{ports} have names. See also @secref["infernames"].
|
||||
@tech{structure type properties}, @tech{regexp values},
|
||||
@tech{ports}, and @tech{loggers} have names. See also @secref["infernames"].
|
||||
|
||||
The name (if any) of a procedure is always a symbol. The
|
||||
@racket[procedure-rename] function creates a procedure with a specific
|
||||
|
|
@ -165,5 +165,7 @@ same inputs.
|
|||
|
||||
The name of a port can be any value, but many tools use a path or
|
||||
string name as the port's for (to report source locations, for
|
||||
example).}
|
||||
example).
|
||||
|
||||
The name of a @tech{logger} is either a symbol or @racket[#f].}
|
||||
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
(test #f logger-name (make-logger))
|
||||
|
||||
(arity-test make-logger 0 2)
|
||||
(arity-test make-logger 0 3)
|
||||
|
||||
; --------------------
|
||||
|
||||
|
|
@ -26,7 +26,13 @@
|
|||
(log-message l level "message" 'data)
|
||||
(for-each (lambda (lr)
|
||||
(test (and on?
|
||||
(vector level (format "~a: message" (logger-name l)) 'data))
|
||||
(vector level (format "~a: message" (logger-name l)) 'data (logger-name l)))
|
||||
sync/timeout 0 lr))
|
||||
lrs)
|
||||
(log-message l level 'name "message" 'data)
|
||||
(for-each (lambda (lr)
|
||||
(test (and on?
|
||||
(vector level "name: message" 'data 'name))
|
||||
sync/timeout 0 lr))
|
||||
lrs))])
|
||||
(test #t logger? l)
|
||||
|
|
@ -90,7 +96,7 @@
|
|||
|
||||
(let ()
|
||||
(define root (make-logger))
|
||||
(define sub1 (make-logger 'sub1 root))
|
||||
(define sub1 (make-logger 'sub1 root #f))
|
||||
(define sub2 (make-logger 'sub2 root))
|
||||
(define sub3 (make-logger 'sub3 root))
|
||||
(define sub4 (make-logger 'sub4 root))
|
||||
|
|
@ -129,6 +135,43 @@
|
|||
(log-message sub4 'fatal "message" 'data)
|
||||
(test #f get))
|
||||
|
||||
; --------------------
|
||||
;; notification callback:
|
||||
|
||||
(let ()
|
||||
(define rt #f)
|
||||
(define s1 #f)
|
||||
(define root (make-logger #f #f (lambda (m) (set! rt m))))
|
||||
(define sub1 (make-logger #f root (lambda (m) (set! s1 m))))
|
||||
;; no receivers:
|
||||
(log-message sub1 'debug "message" 'data)
|
||||
(test #f values rt)
|
||||
(test #f values s1)
|
||||
(define r (make-log-receiver root 'error))
|
||||
;; still no receivers for 'debug:
|
||||
(log-message root 'debug "message" 'data)
|
||||
(test #f values rt)
|
||||
(test #f values s1)
|
||||
;; receivers for 'error:
|
||||
(log-message sub1 'error "message" 'data)
|
||||
(test rt vector 'error "message" 'data #f)
|
||||
(test s1 vector 'error "message" 'data #f)
|
||||
(set! rt #f)
|
||||
(set! s1 #f)
|
||||
(log-message root 'fatal 'name "message2" 'data2)
|
||||
(test rt vector 'fatal "name: message2" 'data2 'name)
|
||||
(test #f values s1)
|
||||
(define sub2 (make-logger 'sub2 root (lambda (m) (abort-current-continuation
|
||||
(default-continuation-prompt-tag)
|
||||
void))))
|
||||
(test 'aborted
|
||||
call-with-continuation-prompt
|
||||
(lambda () (log-message sub2 'fatal 'name "message2" 'data2))
|
||||
(default-continuation-prompt-tag)
|
||||
(lambda (v) 'aborted))
|
||||
|
||||
(void))
|
||||
|
||||
; --------------------
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -2108,7 +2108,8 @@
|
|||
[logger-name (-> -Logger (-opt Sym))]
|
||||
[current-logger (-Param -Logger -Logger)]
|
||||
|
||||
[log-message (-> -Logger -Log-Level -String Univ -Void)]
|
||||
[log-message (Un (-> -Logger -Log-Level -String Univ -Void)
|
||||
(-> -Logger -Log-Level (Un (-val #f) -Symbol) -String Univ -Void))]
|
||||
[log-level? (-> -Logger -Log-Level B)]
|
||||
|
||||
[log-receiver? (make-pred-ty -Log-Receiver)]
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(define level/c (or/c 'fatal 'error 'warning 'info 'debug))
|
||||
(define log-spec/c (listof (or/c symbol? #f)))
|
||||
(define log-message/c (vector/c level/c string? any/c))
|
||||
(define log-message/c (vector/c level/c string? any/c (or/c symbol? #f)))
|
||||
|
||||
;; helper used below
|
||||
(define (receiver-thread receiver stop-chan intercept)
|
||||
|
|
|
|||
|
|
@ -35,7 +35,8 @@ Returns whatever @racket[proc] returns.
|
|||
[interceptor (-> (vector/c
|
||||
(or/c 'fatal 'error 'warning 'info 'debug)
|
||||
string?
|
||||
any/c)
|
||||
any/c
|
||||
(or/c symbol? #f))
|
||||
any)]
|
||||
[proc (-> any)]
|
||||
[log-spec (or/c 'fatal 'error 'warning 'info 'debug symbol? #f)] ...)
|
||||
|
|
@ -72,7 +73,8 @@ A lower-level interface to logging is also available.
|
|||
@defproc[(stop-recording [listener listener?])
|
||||
(listof (vector/c (or/c 'fatal 'error 'warning 'info 'debug)
|
||||
string?
|
||||
any/c))]]]{
|
||||
any/c
|
||||
(or/c symbol? #f)))]]]{
|
||||
|
||||
@racket[start-recording] starts recording log messages matching the given
|
||||
@racket[log-spec]. Messages will be recorded until stopped by passing the
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
Version 5.3.1.11
|
||||
Changed log-message to support a name argument
|
||||
Changed the synchronization result of a log receiver to include an
|
||||
event name
|
||||
|
||||
Version 5.3.1.10
|
||||
Added phantom byte strings
|
||||
Added 'word mode to system-type
|
||||
|
|
|
|||
|
|
@ -690,10 +690,10 @@ 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, 2, env);
|
||||
GLOBAL_NONCM_PRIM("log-max-level", log_max_level, 1, 1, env);
|
||||
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, 2, 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, 4, env);
|
||||
GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 5, 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);
|
||||
|
|
@ -3397,13 +3397,66 @@ static mzRegisterEventSourceProc mzRegisterEventSource;
|
|||
static mzReportEventProc mzReportEvent;
|
||||
#endif
|
||||
|
||||
void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t len, Scheme_Object *data)
|
||||
|
||||
|
||||
static Scheme_Object *make_log_message(int level, Scheme_Object *name,
|
||||
char *buffer, intptr_t len, Scheme_Object *data) {
|
||||
Scheme_Object *msg;
|
||||
Scheme_Object *v;
|
||||
|
||||
msg = scheme_make_vector(4, NULL);
|
||||
switch (level) {
|
||||
case SCHEME_LOG_FATAL:
|
||||
v = fatal_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_ERROR:
|
||||
v = error_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_WARNING:
|
||||
v = warning_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_INFO:
|
||||
v = info_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_DEBUG:
|
||||
default:
|
||||
v = debug_symbol;
|
||||
break;
|
||||
}
|
||||
SCHEME_VEC_ELS(msg)[0] = v;
|
||||
|
||||
if (name) {
|
||||
/* Add logger name prefix: */
|
||||
intptr_t slen;
|
||||
char *cp;
|
||||
slen = SCHEME_SYM_LEN(name);
|
||||
cp = scheme_malloc_atomic(slen + 2 + len + 1);
|
||||
memcpy(cp, SCHEME_SYM_VAL(name), slen);
|
||||
memcpy(cp + slen, ": ", 2);
|
||||
memcpy(cp + slen + 2, buffer, len + 1);
|
||||
len += slen + 2;
|
||||
buffer = cp;
|
||||
}
|
||||
|
||||
v = scheme_make_sized_utf8_string(buffer, len);
|
||||
SCHEME_SET_CHAR_STRING_IMMUTABLE(v);
|
||||
SCHEME_VEC_ELS(msg)[1] = v;
|
||||
SCHEME_VEC_ELS(msg)[2] = (data ? data : scheme_false);
|
||||
SCHEME_VEC_ELS(msg)[3] = (name ? name : scheme_false);
|
||||
|
||||
SCHEME_SET_VECTOR_IMMUTABLE(msg);
|
||||
|
||||
return msg;
|
||||
}
|
||||
|
||||
void scheme_log_name_message(Scheme_Logger *logger, int level, Scheme_Object *name,
|
||||
char *buffer, intptr_t len, Scheme_Object *data)
|
||||
{
|
||||
/* This function must avoid GC allocation when called with the
|
||||
configuration of scheme_log_abort(). */
|
||||
Scheme_Logger *orig_logger;
|
||||
Scheme_Object *queue, *q, *msg = NULL, *b;
|
||||
Scheme_Log_Reader *lr;
|
||||
Scheme_Logger *lo;
|
||||
|
||||
if (!logger) {
|
||||
Scheme_Config *config;
|
||||
|
|
@ -3417,10 +3470,26 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
if (logger->want_level < level)
|
||||
return;
|
||||
|
||||
orig_logger = logger;
|
||||
if (!name)
|
||||
name = logger->name;
|
||||
|
||||
/* run notification callbacks: */
|
||||
for (lo = logger; lo; lo = lo->parent) {
|
||||
if (lo->callback) {
|
||||
Scheme_Object *a[1];
|
||||
if (!msg)
|
||||
msg = make_log_message(level, name, buffer, len, data);
|
||||
|
||||
a[0] = msg;
|
||||
scheme_apply_multi(lo->callback, 1, a);
|
||||
}
|
||||
}
|
||||
|
||||
if (SCHEME_FALSEP(name))
|
||||
name = NULL;
|
||||
|
||||
while (logger) {
|
||||
if (extract_spec_level(logger->syslog_level, orig_logger->name) >= level) {
|
||||
if (extract_spec_level(logger->syslog_level, name) >= level) {
|
||||
#ifdef USE_C_SYSLOG
|
||||
int pri;
|
||||
switch (level) {
|
||||
|
|
@ -3441,8 +3510,8 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
pri = LOG_DEBUG;
|
||||
break;
|
||||
}
|
||||
if (orig_logger->name)
|
||||
syslog(pri, "%s: %s", SCHEME_SYM_VAL(orig_logger->name), buffer);
|
||||
if (name)
|
||||
syslog(pri, "%s: %s", SCHEME_SYM_VAL(name), buffer);
|
||||
else
|
||||
syslog(pri, "%s", buffer);
|
||||
#endif
|
||||
|
|
@ -3491,12 +3560,12 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
sev = 0;
|
||||
break;
|
||||
}
|
||||
if (orig_logger->name) {
|
||||
if (name) {
|
||||
char *naya;
|
||||
intptr_t slen;
|
||||
slen = SCHEME_SYM_LEN(orig_logger->name);
|
||||
slen = SCHEME_SYM_LEN(name);
|
||||
naya = (char *)scheme_malloc_atomic(slen + 2 + len + 1);
|
||||
memcpy(naya, SCHEME_SYM_VAL(orig_logger->name), slen);
|
||||
memcpy(naya, SCHEME_SYM_VAL(name), slen);
|
||||
memcpy(naya + slen, ": ", 2);
|
||||
memcpy(naya + slen + 2, buffer, len);
|
||||
naya[slen + 2 + len] = 0;
|
||||
|
|
@ -3512,11 +3581,11 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
}
|
||||
#endif
|
||||
}
|
||||
if (extract_spec_level(logger->stderr_level, orig_logger->name) >= level) {
|
||||
if (orig_logger->name) {
|
||||
if (extract_spec_level(logger->stderr_level, name) >= level) {
|
||||
if (name) {
|
||||
intptr_t slen;
|
||||
slen = SCHEME_SYM_LEN(orig_logger->name);
|
||||
fwrite(SCHEME_SYM_VAL(orig_logger->name), slen, 1, stderr);
|
||||
slen = SCHEME_SYM_LEN(name);
|
||||
fwrite(SCHEME_SYM_VAL(name), slen, 1, stderr);
|
||||
fwrite(": ", 2, 1, stderr);
|
||||
}
|
||||
fwrite(buffer, len, 1, stderr);
|
||||
|
|
@ -3529,48 +3598,9 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
b = SCHEME_CAR(b);
|
||||
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
|
||||
if (lr) {
|
||||
if (extract_spec_level(lr->level, orig_logger->name) >= level) {
|
||||
if (!msg) {
|
||||
Scheme_Object *v;
|
||||
msg = scheme_make_vector(3, NULL);
|
||||
switch (level) {
|
||||
case SCHEME_LOG_FATAL:
|
||||
v = fatal_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_ERROR:
|
||||
v = error_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_WARNING:
|
||||
v = warning_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_INFO:
|
||||
v = info_symbol;
|
||||
break;
|
||||
case SCHEME_LOG_DEBUG:
|
||||
default:
|
||||
v = debug_symbol;
|
||||
break;
|
||||
}
|
||||
SCHEME_VEC_ELS(msg)[0] = v;
|
||||
|
||||
if (orig_logger->name) {
|
||||
/* Add logger name prefix: */
|
||||
intptr_t slen;
|
||||
char *cp;
|
||||
slen = SCHEME_SYM_LEN(orig_logger->name);
|
||||
cp = scheme_malloc_atomic(slen + 2 + len + 1);
|
||||
memcpy(cp, SCHEME_SYM_VAL(orig_logger->name), slen);
|
||||
memcpy(cp + slen, ": ", 2);
|
||||
memcpy(cp + slen + 2, buffer, len + 1);
|
||||
len += slen + 2;
|
||||
buffer = cp;
|
||||
}
|
||||
|
||||
v = scheme_make_sized_utf8_string(buffer, len);
|
||||
SCHEME_SET_CHAR_STRING_IMMUTABLE(v);
|
||||
SCHEME_VEC_ELS(msg)[1] = v;
|
||||
SCHEME_VEC_ELS(msg)[2] = (data ? data : scheme_false);
|
||||
}
|
||||
if (extract_spec_level(lr->level, name) >= level) {
|
||||
if (!msg)
|
||||
msg = make_log_message(level, name, buffer, len, data);
|
||||
|
||||
/* enqueue */
|
||||
q = scheme_make_raw_pair(msg, NULL);
|
||||
|
|
@ -3589,6 +3619,11 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
|
|||
}
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
|
||||
void scheme_log_abort(char *buffer)
|
||||
{
|
||||
Scheme_Logger logger;
|
||||
|
|
@ -3692,7 +3727,8 @@ log_message(int argc, Scheme_Object *argv[])
|
|||
{
|
||||
Scheme_Logger *logger;
|
||||
Scheme_Object *bytes;
|
||||
int level;
|
||||
Scheme_Object *name;
|
||||
int level, pos;
|
||||
|
||||
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
|
||||
scheme_wrong_contract("log-message", "logger?", 0, argc, argv);
|
||||
|
|
@ -3700,12 +3736,19 @@ log_message(int argc, Scheme_Object *argv[])
|
|||
|
||||
level = extract_level("log-message", 0, 1, argc, argv);
|
||||
|
||||
bytes = argv[2];
|
||||
pos = 2;
|
||||
if (SCHEME_SYMBOLP(argv[pos]) || SCHEME_FALSEP(argv[pos]))
|
||||
name = argv[pos++];
|
||||
else
|
||||
name = NULL;
|
||||
|
||||
bytes = argv[pos];
|
||||
if (!SCHEME_CHAR_STRINGP(bytes))
|
||||
scheme_wrong_contract("log-message", "string?", 2, argc, argv);
|
||||
scheme_wrong_contract("log-message", "string?", pos, argc, argv);
|
||||
bytes = scheme_char_string_to_byte_string(bytes);
|
||||
pos++;
|
||||
|
||||
scheme_log_message(logger, level, SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[3]);
|
||||
scheme_log_name_message(logger, level, name, SCHEME_BYTE_STR_VAL(bytes), SCHEME_BYTE_STRLEN_VAL(bytes), argv[pos]);
|
||||
|
||||
return scheme_void;
|
||||
}
|
||||
|
|
@ -3760,7 +3803,7 @@ log_max_level(int argc, Scheme_Object *argv[])
|
|||
static Scheme_Object *
|
||||
make_logger(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Logger *parent;
|
||||
Scheme_Logger *parent, *logger;
|
||||
|
||||
if (argc) {
|
||||
if (!SCHEME_FALSEP(argv[0]) && !SCHEME_SYMBOLP(argv[0]))
|
||||
|
|
@ -3774,15 +3817,23 @@ make_logger(int argc, Scheme_Object *argv[])
|
|||
scheme_wrong_contract("make-logger", "(or/c logger? #f)", 1, argc, argv);
|
||||
parent = (Scheme_Logger *)argv[1];
|
||||
}
|
||||
|
||||
if (argc > 2)
|
||||
(void)scheme_check_proc_arity2("make-logger", 1, 2, argc, argv, 1);
|
||||
} else
|
||||
parent = NULL;
|
||||
} else
|
||||
parent = NULL;
|
||||
|
||||
return (Scheme_Object *)scheme_make_logger(parent,
|
||||
(argc
|
||||
? (SCHEME_FALSEP(argv[0]) ? NULL : argv[0])
|
||||
: NULL));
|
||||
logger = scheme_make_logger(parent,
|
||||
(argc
|
||||
? (SCHEME_FALSEP(argv[0]) ? NULL : argv[0])
|
||||
: NULL));
|
||||
|
||||
if ((argc > 2) && SCHEME_TRUEP(argv[2]))
|
||||
logger->callback = argv[2];
|
||||
|
||||
return (Scheme_Object *)logger;
|
||||
}
|
||||
|
||||
Scheme_Logger *scheme_make_logger(Scheme_Logger *parent, Scheme_Object *name)
|
||||
|
|
|
|||
|
|
@ -2771,6 +2771,10 @@ Scheme_Object *scheme_object_name(Scheme_Object *a)
|
|||
if (t->name) {
|
||||
return t->name;
|
||||
}
|
||||
} else if (SAME_TYPE(SCHEME_TYPE(a), scheme_logger_type)) {
|
||||
Scheme_Logger *logger = (Scheme_Logger *)a;
|
||||
if (logger->name)
|
||||
return logger->name;
|
||||
}
|
||||
|
||||
return scheme_false;
|
||||
|
|
|
|||
|
|
@ -2918,6 +2918,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->callback, gc);
|
||||
gcMARK2(l->timestamp, gc);
|
||||
gcMARK2(l->syslog_level, gc);
|
||||
gcMARK2(l->stderr_level, gc);
|
||||
|
|
@ -2930,6 +2931,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->callback, gc);
|
||||
gcFIXUP2(l->timestamp, gc);
|
||||
gcFIXUP2(l->syslog_level, gc);
|
||||
gcFIXUP2(l->stderr_level, gc);
|
||||
|
|
|
|||
|
|
@ -1174,6 +1174,7 @@ mark_logger {
|
|||
Scheme_Logger *l = (Scheme_Logger *)p;
|
||||
gcMARK2(l->name, gc);
|
||||
gcMARK2(l->parent, gc);
|
||||
gcMARK2(l->callback, gc);
|
||||
gcMARK2(l->timestamp, gc);
|
||||
gcMARK2(l->syslog_level, gc);
|
||||
gcMARK2(l->stderr_level, gc);
|
||||
|
|
|
|||
|
|
@ -222,6 +222,7 @@ 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_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);
|
||||
|
|
|
|||
|
|
@ -161,6 +161,7 @@ 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_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);
|
||||
|
|
|
|||
|
|
@ -3510,6 +3510,7 @@ struct Scheme_Logger {
|
|||
Scheme_Object *name;
|
||||
Scheme_Logger *parent;
|
||||
int want_level;
|
||||
Scheme_Object *callback;
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "5.3.1.10"
|
||||
#define MZSCHEME_VERSION "5.3.1.11"
|
||||
|
||||
#define MZSCHEME_VERSION_X 5
|
||||
#define MZSCHEME_VERSION_Y 3
|
||||
#define MZSCHEME_VERSION_Z 1
|
||||
#define MZSCHEME_VERSION_W 10
|
||||
#define MZSCHEME_VERSION_W 11
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user