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

add log-all-levels and log-level-evt

Browse Source 
These two functions allow the creation of relays that receive events
on logger B where there are interested receivers for logger A.

Based on comments from Tony Garnock-Jones.
This commit is contained in:
Matthew Flatt 2014-10-31 14:36:46 -06:00
parent 38ac6e052c
commit 58eb802468
9 changed files with 818 additions and 686 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -190,6 +190,47 @@ currently returns @racket[#f] for all levels.
@history[#:changed "6.1.1.3" @elem{Added the @racket[name] argument.}]}
@defproc[(log-all-levels [logger logger?])
(list/c (or/c #f 'fatal 'error 'warning 'info 'debug)
(or/c #f symbol?)
... ...)]{
Summarizes the possible results of @racket[log-max-level] on all
possible @tech{interned} symbols. The result list contains a sequence
of symbols and @racket[#f], where the first, third, etc., list element
corresponds to a level, and the second, fourth, etc., list element
indicates a corresponding name. The level is the result that
@racket[log-max-level] would produce for the name, where the level for
the @racket[#f] name (which is always present in the result list)
indicates the result for any @tech{interned}-symbol name that does not
appear in the list.
The result is suitable as a sequence of arguments to
@racket[make-log-receiver] (after a @tech{logger} argument). Combining
the arguments with @racket[logger] creates a new receiver for only
events that already have other receivers.
@history[#:added "6.1.1.4"]}
@defproc[(log-level-evt [logger logger?]) evt?]{
Creates a @tech{synchronizable event} that is @tech{ready for
synchronization} when the result of @racket[log-level?],
@racket[log-max-level], or @racket[log-all-levels] can be different
than before @racket[log-level-evt] was called. The event's
@tech{synchronization result} is the event itself.
The condition reported by the event is a conservative approximation:
the event can become @tech{ready for synchronization} even if the
results of @racket[log-level?], @racket[log-max-level], and
@racket[log-all-levels] are unchanged. Nevertheless, the expectation
is that events become ready infrequently, because they are triggered
byt the creation of a log receiver.
@history[#:added "6.1.1.4"]}
@deftogether[(
@defform*[[(log-fatal string-expr)
(log-fatal format-string-expr v ...)]]

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

@ -88,7 +88,7 @@
; --------------------
(let ()
(parameterize ([current-logger (make-logger)])
(define-logger test)
(test #t logger? test-logger)
(define r (make-log-receiver (current-logger) 'warning 'test))
@ -96,9 +96,10 @@
(log-test-debug "debug")
(test #f sync/timeout 0 r)
(log-test-warning "warning")
(test '(#f #f warning test) log-all-levels test-logger)
(test "test: warning" (lambda (v) (vector-ref v 1)) (sync r)))
(let ()
(parameterize ([current-logger (make-logger)])
(define-logger test)
(define r (make-log-receiver (current-logger) 'info 'test2 'warning))
(test #t log-level? test-logger 'warning)
@ -109,10 +110,11 @@
(test 'info log-max-level test-logger)
(test 'info log-max-level test-logger 'test2)
(test 'warning log-max-level test-logger 'not-test)
(test '(warning #f info test2) log-all-levels test-logger)
;; Retain receiver to avoid GC influence on tests
(test #f sync/timeout 0 r))
(let ()
(parameterize ([current-logger (make-logger)])
(define-logger test)
(define r2 (make-log-receiver (current-logger) 'warning 'test3 'info))
(test #f log-level? test-logger 'info 'test3)
@ -184,8 +186,12 @@
(define l3 (make-logger #f l2 'warning 'test 'info))
(define l32 (make-logger #f l2 'info 'test 'warning))
(define evt (log-level-evt l32))
(test #f sync/timeout 0 evt)
(define r (make-log-receiver l 'debug))
(test #f sync/timeout 0 r)
(test evt sync/timeout 0 evt)
(log-message l 'debug "debug message" #f)
(test #t vector? (sync/timeout 0 r))
@ -211,6 +217,9 @@
(test 'info log-max-level l2)
(test 'info log-max-level l3)
(test '(debug #f) log-all-levels l)
(test '(info #f) log-all-levels l2)
(define r22 (make-log-receiver l2 'debug))
(test 'debug log-max-level l)
(test 'debug log-max-level l2)
@ -221,6 +230,9 @@
(test 'warning log-max-level l32 'not-test)
(test 'info log-max-level l32 'test)
(test '(debug #f) log-all-levels l)
(test '(debug #f) log-all-levels l2)
;; Retain receivers to avoid GC influence on tests
(test #f sync/timeout 0 r)
(test #f sync/timeout 0 r2)

1240
racket/src/racket/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

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

@ -122,6 +122,8 @@ static Scheme_Object *srcloc_to_string(int argc, Scheme_Object **argv);
static Scheme_Object *log_message(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_level_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_max_level(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_all_levels(int argc, Scheme_Object *argv[]);
static Scheme_Object *log_level_evt(int argc, Scheme_Object *argv[]);
static Scheme_Object *make_logger(int argc, Scheme_Object *argv[]);
static Scheme_Object *logger_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *current_logger(int argc, Scheme_Object *argv[]);
@ -723,10 +725,13 @@ void scheme_init_error(Scheme_Env *env)
GLOBAL_PARAMETER("error-print-context-length", error_print_context_length, MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH, env);
GLOBAL_PARAMETER("error-print-source-location", error_print_srcloc, MZCONFIG_ERROR_PRINT_SRCLOC, env);
/* logging */
GLOBAL_NONCM_PRIM("exit", scheme_do_exit, 0, 1, env);
/* logging */
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("log-all-levels", log_all_levels, 1, 1, env);
GLOBAL_NONCM_PRIM("log-level-evt", log_level_evt, 1, 1, env);
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, -1, env);
GLOBAL_NONCM_PRIM("make-log-receiver", make_log_reader, 2, -1, env);
@ -1035,7 +1040,7 @@ void scheme_log(Scheme_Logger *logger, int level, int flags,
intptr_t len;
if (logger) {
if (logger->local_timestamp == *logger->timestamp)
if (logger->local_timestamp == SCHEME_INT_VAL(logger->root_timestamp[0]))
if (logger->want_level < level)
return;
}
@ -1058,7 +1063,7 @@ void scheme_log_w_data(Scheme_Logger *logger, int level, int flags,
intptr_t len;
if (logger) {
if (logger->local_timestamp == *logger->timestamp)
if (logger->local_timestamp == SCHEME_INT_VAL(logger->root_timestamp[0]))
if (logger->want_level < level)
return;
}
@ -1080,7 +1085,7 @@ int scheme_log_level_p(Scheme_Logger *logger, int level)
logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER);
}
if (logger->local_timestamp < *logger->timestamp)
if (logger->local_timestamp < SCHEME_INT_VAL(logger->root_timestamp[0]))
update_want_level(logger, NULL);
return (logger->want_level >= level);
@ -3418,6 +3423,31 @@ static Scheme_Object *default_yield_handler(int argc, Scheme_Object **argv)
/***********************************************************************/
static Scheme_Object *level_number_to_symbol(int level)
{
switch (level) {
case 0:
return scheme_false;
break;
case SCHEME_LOG_FATAL:
return fatal_symbol;
break;
case SCHEME_LOG_ERROR:
return error_symbol;
break;
case SCHEME_LOG_WARNING:
return warning_symbol;
break;
case SCHEME_LOG_INFO:
return info_symbol;
break;
case SCHEME_LOG_DEBUG:
default:
return debug_symbol;
break;
}
}
static int extract_spec_level(Scheme_Object *level_spec, Scheme_Object *name)
{
if (!level_spec) return 0;
@ -3510,7 +3540,7 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
if (!name) {
logger->want_level = want_level;
logger->local_timestamp = *logger->timestamp;
logger->local_timestamp = SCHEME_INT_VAL(logger->root_timestamp[0]);
} else {
# define WANT_NAME_LEVEL_CACHE_SIZE 8
int i;
@ -3530,7 +3560,7 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
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)
if (SCHEME_INT_VAL(SCHEME_VEC_ELS(b)[i+1]) < SCHEME_INT_VAL(logger->root_timestamp[0]))
break;
}
if (i < 0) {
@ -3543,7 +3573,7 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name)
}
SCHEME_VEC_ELS(b)[i] = name;
SCHEME_VEC_ELS(b)[i+1] = scheme_make_integer(*logger->timestamp);
SCHEME_VEC_ELS(b)[i+1] = scheme_make_integer(SCHEME_INT_VAL(logger->root_timestamp[0]));
SCHEME_VEC_ELS(b)[i+2] = scheme_make_integer(want_level);
}
}
@ -3556,7 +3586,7 @@ static int get_want_level(Scheme_Logger *logger, Scheme_Object *name)
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) {
if (SCHEME_INT_VAL(SCHEME_VEC_ELS(logger->want_name_level_cache)[i+1]) == SCHEME_INT_VAL(logger->root_timestamp[0])) {
return SCHEME_INT_VAL(SCHEME_VEC_ELS(logger->want_name_level_cache)[i+2]);
}
}
@ -3565,13 +3595,58 @@ static int get_want_level(Scheme_Logger *logger, Scheme_Object *name)
update_want_level(logger, name);
}
} else {
if (logger->local_timestamp < *logger->timestamp)
if (logger->local_timestamp < SCHEME_INT_VAL(logger->root_timestamp[0]))
update_want_level(logger, NULL);
return logger->want_level;
}
}
Scheme_Object *extract_all_levels(Scheme_Logger *logger)
{
Scheme_Hash_Table *names;
Scheme_Log_Reader *lr;
Scheme_Object *queue, *b, *name, *result = scheme_null, *l;
int level, default_level;
Scheme_Logger *parent = logger;
names = scheme_make_hash_table(SCHEME_hash_ptr);
default_level = get_want_level(logger, scheme_void);
while (parent) {
queue = parent->readers;
while (queue) {
b = SCHEME_CAR(queue);
b = SCHEME_CAR(b);
lr = (Scheme_Log_Reader *)SCHEME_BOX_VAL(b);
if (lr) {
for (l = lr->level; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
l = SCHEME_CDR(l);
name = SCHEME_CAR(l);
if (!SCHEME_SYM_WEIRDP(name) && !scheme_hash_get(names, name)) {
level = get_want_level(logger, name);
scheme_hash_set(names, name, scheme_true);
if (level != default_level) {
result = scheme_make_pair(level_number_to_symbol(level),
scheme_make_pair(name, result));
}
}
SCHEME_USE_FUEL(1);
}
}
queue = SCHEME_CDR(queue);
}
parent = parent->parent;
SCHEME_USE_FUEL(1);
}
result = scheme_make_pair(level_number_to_symbol(default_level),
scheme_make_pair(scheme_false, result));
return result;
}
#ifdef USE_WINDOWS_EVENT_LOG
static int event_procs_ready;
typedef HANDLE (WINAPI *mzRegisterEventSourceProc)(LPCTSTR lpUNCServerName, LPCTSTR lpSourceName);
@ -3582,32 +3657,13 @@ static mzRegisterEventSourceProc mzRegisterEventSource;
static mzReportEventProc mzReportEvent;
#endif
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;
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;
}
v = level_number_to_symbol(level);
SCHEME_VEC_ELS(msg)[0] = v;
if (name && prefix_msg) {
@ -3649,7 +3705,7 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object
logger = (Scheme_Logger *)scheme_get_param(config, MZCONFIG_LOGGER);
}
if (logger->local_timestamp < *logger->timestamp)
if (logger->local_timestamp < SCHEME_INT_VAL(logger->root_timestamp[0]))
update_want_level(logger, NULL);
if (logger->want_level < level)
@ -3811,7 +3867,7 @@ void scheme_log_message(Scheme_Logger *logger, int level, char *buffer, intptr_t
void scheme_log_abort(char *buffer)
{
Scheme_Logger logger;
intptr_t ts;
Scheme_Object *ts[2];
memset(&logger, 0, sizeof(logger));
@ -3819,9 +3875,10 @@ void scheme_log_abort(char *buffer)
logger.parent = NULL;
logger.want_level = SCHEME_LOG_FATAL;
ts = 0;
logger.timestamp = &ts;
logger.local_timestamp = ts;
ts[0] = scheme_make_integer(0);
ts[1] = NULL;
logger.root_timestamp = ts;
logger.local_timestamp = 0;
logger.syslog_level = init_syslog_level;
logger.stderr_level = init_stderr_level;
@ -3984,21 +4041,38 @@ log_max_level(int argc, Scheme_Object *argv[])
name = argv[1];
}
switch (get_want_level(logger, name)) {
case 0:
return scheme_false;
case SCHEME_LOG_FATAL:
return fatal_symbol;
case SCHEME_LOG_ERROR:
return error_symbol;
case SCHEME_LOG_WARNING:
return warning_symbol;
case SCHEME_LOG_INFO:
return info_symbol;
default:
case SCHEME_LOG_DEBUG:
return debug_symbol;
return level_number_to_symbol(get_want_level(logger, name));
}
static Scheme_Object *
log_all_levels(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_contract("log-all-levels", "logger?", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
return extract_all_levels(logger);
}
static Scheme_Object *
log_level_evt(int argc, Scheme_Object *argv[])
{
Scheme_Logger *logger;
Scheme_Object *sema;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_logger_type))
scheme_wrong_contract("log-level-evt", "logger?", 0, argc, argv);
logger = (Scheme_Logger *)argv[0];
sema = logger->root_timestamp[1];
if (!sema) {
sema = scheme_make_sema(0);
logger->root_timestamp[1] = sema;
}
return scheme_make_sema_repost(sema);
}
static Scheme_Object *get_levels_and_names(const char *who, int i, int argc, Scheme_Object **argv,
@ -4077,12 +4151,12 @@ Scheme_Logger *scheme_make_logger(Scheme_Logger *parent, Scheme_Object *name)
logger->so.type = scheme_logger_type;
logger->parent = parent;
if (parent) {
logger->timestamp = parent->timestamp;
logger->root_timestamp = parent->root_timestamp;
} else {
intptr_t *timestamp;
timestamp = MALLOC_ONE_ATOMIC(intptr_t);
*timestamp = 1;
logger->timestamp = timestamp;
Scheme_Object **root_timestamp;
root_timestamp = MALLOC_N(Scheme_Object*, 2);
root_timestamp[0] = scheme_make_integer(1);
logger->root_timestamp = root_timestamp;
}
logger->name = name;
@ -4148,7 +4222,11 @@ make_log_reader(int argc, Scheme_Object *argv[])
sema),
logger->readers);
logger->readers = q;
*logger->timestamp += 1;
logger->root_timestamp[0] = scheme_make_integer(SCHEME_INT_VAL(logger->root_timestamp[0]) + 1);
if (logger->root_timestamp[1]) {
scheme_post_sema_all(logger->root_timestamp[1]);
logger->root_timestamp[1] = NULL;
}
return (Scheme_Object *)lr;
}

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

@ -3005,7 +3005,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) {
gcMARK2(l->name, gc);
gcMARK2(l->parent, gc);
gcMARK2(l->want_name_level_cache, gc);
gcMARK2(l->timestamp, gc);
gcMARK2(l->root_timestamp, gc);
gcMARK2(l->syslog_level, gc);
gcMARK2(l->stderr_level, gc);
gcMARK2(l->propagate_level, gc);
@ -3019,7 +3019,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) {
gcFIXUP2(l->name, gc);
gcFIXUP2(l->parent, gc);
gcFIXUP2(l->want_name_level_cache, gc);
gcFIXUP2(l->timestamp, gc);
gcFIXUP2(l->root_timestamp, gc);
gcFIXUP2(l->syslog_level, gc);
gcFIXUP2(l->stderr_level, gc);
gcFIXUP2(l->propagate_level, gc);

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

@ -1208,7 +1208,7 @@ mark_logger {
gcMARK2(l->name, gc);
gcMARK2(l->parent, gc);
gcMARK2(l->want_name_level_cache, gc);
gcMARK2(l->timestamp, gc);
gcMARK2(l->root_timestamp, gc);
gcMARK2(l->syslog_level, gc);
gcMARK2(l->stderr_level, gc);
gcMARK2(l->propagate_level, gc);

2
racket/src/racket/src/schminc.h
View File

@ -14,7 +14,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1125
#define EXPECTED_PRIM_COUNT 1127
#define EXPECTED_UNSAFE_COUNT 106
#define EXPECTED_FLFXNUM_COUNT 69
#define EXPECTED_EXTFL_COUNT 45

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

@ -3694,7 +3694,8 @@ struct Scheme_Logger {
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 **root_timestamp;
intptr_t 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;
Scheme_Object *propagate_level; /* can be NULL */

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.1.1.3"
#define MZSCHEME_VERSION "6.1.1.4"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 1
#define MZSCHEME_VERSION_Z 1
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_W 4
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)