From e4296f5c1e43482855f3cbd58a664b56430785bd Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 28 Feb 2018 06:52:55 -0700 Subject: [PATCH] add stdout logging in the same style as stderr logging Use stdout log reporting instead of stderr log reporting for status reporting during the build, so that the status report is not misinterpreted as an error. --- .../scribblings/reference/logging.scrbl | 11 ++++- .../scribblings/reference/startup.scrbl | 8 +++ racket/src/cs/main.sps | 21 ++++++-- racket/src/gracket/Makefile.in | 4 +- racket/src/io/logger/main.rkt | 3 +- racket/src/io/logger/receiver.rkt | 16 ++++-- racket/src/racket/Makefile.in | 2 +- racket/src/racket/cmdline.inc | 20 +++++++- racket/src/racket/gc2/Makefile.in | 2 +- racket/src/racket/include/scheme.h | 2 + racket/src/racket/src/error.c | 49 +++++++++++++++++-- racket/src/racket/src/mzmark_type.inc | 2 + racket/src/racket/src/mzmarksrc.c | 1 + racket/src/racket/src/schpriv.h | 1 + 14 files changed, 122 insertions(+), 20 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/logging.scrbl b/pkgs/racket-doc/scribblings/reference/logging.scrbl index 48b949a5b5..62559a019a 100644 --- a/pkgs/racket-doc/scribblings/reference/logging.scrbl +++ b/pkgs/racket-doc/scribblings/reference/logging.scrbl @@ -55,6 +55,14 @@ through environment variables: The default is @racket["error"].} + @item{If the @indexed-envvar{PLTSTDOUT} environment variable is + defined and is not overridden by a command-line flag, it + determines the level of the @tech{log receiver} that propagates + events to the original output port. The possible values are the + same as for @envvar{PLTSTDERR}. + + The default is @racket["none"].} + @item{If the @indexed-envvar{PLTSYSLOG} environment variable is defined and is not overridden by a command-line flag, it determines the level of the @tech{log receiver} that propagates @@ -78,7 +86,8 @@ would produce a run-time error if evaluated. of @envvar{PLTSTDERR} and @envvar{PLTSYSLOG} was very strict. Leading and trailing whitespace was forbidden, and anything other than exactly one space character separating two specifications was - rejected.}] + rejected.} + #:changed "6.90.0.17" @elem{Added @envvar{PLTSTDOUT}.}] @; ---------------------------------------- @section{Creating Loggers} diff --git a/pkgs/racket-doc/scribblings/reference/startup.scrbl b/pkgs/racket-doc/scribblings/reference/startup.scrbl index 67ed1ae730..dfb3adf6f5 100644 --- a/pkgs/racket-doc/scribblings/reference/startup.scrbl +++ b/pkgs/racket-doc/scribblings/reference/startup.scrbl @@ -347,6 +347,12 @@ flags: are the same as for the @envvar{PLTSTDERR} environment variable. See @secref["logging"] for more information.} + @item{@FlagFirst{O} @nonterm{levels} or @DFlagFirst{stdout} + @nonterm{levels} : Sets the logging level for writing events to + the original output port. The possible @nonterm{level} values + are the same as for the @envvar{PLTSTDOUT} environment + variable. See @secref["logging"] for more information.} + @item{@FlagFirst{L} @nonterm{levels} or @DFlagFirst{syslog} @nonterm{levels} : Sets the logging level for writing events to the system log. The possible @nonterm{level} values @@ -439,6 +445,8 @@ of the collapsed set. Extra arguments following the last option are available from the @indexed-racket[current-command-line-arguments] parameter. +@history[#:changed "6.90.0.17" @elem{Added @Flag{O}/@DFlag{stdout}.}] + @; ---------------------------------------------------------------------- @section[#:tag "configure-runtime"]{Language Run-Time Configuration} diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps index 77daac3621..5aadb205eb 100644 --- a/racket/src/cs/main.sps +++ b/racket/src/cs/main.sps @@ -77,10 +77,10 @@ (define rx:logging-spec (pregexp "^[\\s]*(none|fatal|error|warning|info|debug)(?:@([^\\s @]+))?(.*)$")) (define rx:all-whitespace (pregexp "^[\\s]*$")) - (define (parse-logging-spec str where exit-on-fail?) + (define (parse-logging-spec which str where exit-on-fail?) (define (fail) (let ([msg (string-append - "stderr " where " must be one of the following\n" + which " " where " must be one of the following\n" " s:\n" " none fatal error warning info debug\n" "or up to one such in whitespace-separated sequence of\n" @@ -161,6 +161,7 @@ (define repl-init? #t) (define version? #f) (define stderr-logging-arg #f) + (define stdout-logging-arg #f) (define runtime-for-init? #t) (define exit-value 0) (define host-collects-dir init-collects-dir) @@ -309,7 +310,11 @@ (loop (cdr args))] [("-W" "--stderr") (let-values ([(spec rest-args) (next-arg "stderr level" arg within-arg args)]) - (set! stderr-logging-arg (parse-logging-spec spec (format "after ~a switch" (or within-arg arg)) #t)) + (set! stderr-logging-arg (parse-logging-spec "stderr" spec (format "after ~a switch" (or within-arg arg)) #t)) + (loop rest-args))] + [("-O" "--stdout") + (let-values ([(spec rest-args) (next-arg "stdout level" arg within-arg args)]) + (set! stdout-logging-arg (parse-logging-spec "stdout" spec (format "after ~a switch" (or within-arg arg)) #t)) (loop rest-args))] [("-N" "--name") (let-values ([(name rest-args) (next-arg "name" arg within-arg args)]) @@ -431,6 +436,13 @@ (parse-logging-spec spec "in PLTSTDERR environment variable" #f) '(error))))) + (define stdout-logging + (or stdout-logging-arg + (let ([spec (getenv "PLTSTDOUT")]) + (if spec + (parse-logging-spec spec "in PLTSTDOUT environment variable" #f) + '())))) + (when (getenv "PLT_STATS_ON_BREAK") (keyboard-interrupt-handler (let ([orig (keyboard-interrupt-handler)]) @@ -446,6 +458,9 @@ (when (and stderr-logging (not (null? stderr-logging))) (apply add-stderr-log-receiver! (|#%app| current-logger) stderr-logging)) + (when (and stdout-logging + (not (null? stdout-logging))) + (apply add-stdout-log-receiver! (|#%app| current-logger) stdout-logging)) (cond [(eq? init-collects-dir 'disable) (|#%app| use-collection-link-paths #f) diff --git a/racket/src/gracket/Makefile.in b/racket/src/gracket/Makefile.in index a77884663b..44f82f6e1e 100644 --- a/racket/src/gracket/Makefile.in +++ b/racket/src/gracket/Makefile.in @@ -89,7 +89,7 @@ LINKRESULT_wx_xt = gracket@CGC@ LINKRESULT_wx_mac = GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@ LINKRESULT = $(LINKRESULT_@WXVARIANT@) -BOOT_SETUP = @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled # Incremented each time the binaries change: DOWNLOAD_BIN_VERSION = 1 @@ -128,7 +128,7 @@ GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@: $(MZFW) $(MRAPPSKEL) grmain.@LTO@ /usr/bin/install_name_tool -change "Racket.framework/Versions/$(FWVERSION)/Racket" "@executable_path/../../../../racket/Racket.framework/Versions/$(FWVERSION)/Racket" GRacket@CGC@.app/Contents/MacOS/GRacket@CGC@ $(MRAPPSKEL): $(srcdir)/../mac/osx_appl.rkt $(srcdir)/../racket/src/schvers.h $(srcdir)/../mac/icon/GRacket.icns - env BUILDBASE=.. @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) -l- setup $(BOOT_SETUP) $(MRAPPSKEL) mrappskel.d $(srcdir)/../mac/osx_appl.rkt $(srcdir)/.. "@CGC@" + env BUILDBASE=.. @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) $(SETUP_BOOT) $(MRAPPSKEL) mrappskel.d $(srcdir)/../mac/osx_appl.rkt $(srcdir)/.. "@CGC@" @INCLUDEDEP@ mrappskel.d ee-app: gracket grmain_ee.@LTO@ diff --git a/racket/src/io/logger/main.rkt b/racket/src/io/logger/main.rkt index 2ae0c4d053..cc1756ad94 100644 --- a/racket/src/io/logger/main.rkt +++ b/racket/src/io/logger/main.rkt @@ -17,7 +17,8 @@ log-message ; ok to call in host-Scheme interrupt handler log-receiver? make-log-receiver - add-stderr-log-receiver!) + add-stderr-log-receiver! + add-stdout-log-receiver!) (define root-logger (create-logger #:topic #f #:parent #f #:propagate-filters 'none)) diff --git a/racket/src/io/logger/receiver.rkt b/racket/src/io/logger/receiver.rkt index c33675cb0d..c75e2704d5 100644 --- a/racket/src/io/logger/receiver.rkt +++ b/racket/src/io/logger/receiver.rkt @@ -10,6 +10,7 @@ (provide (struct-out log-receiver) make-log-receiver add-stderr-log-receiver! + add-stdout-log-receiver! log-receiver-send!) (struct log-receiver (filters)) @@ -72,12 +73,12 @@ ;; ---------------------------------------- -(struct stderr-log-receiver log-receiver () +(struct stdio-log-receiver log-receiver (which) #:property prop:receiver-send (lambda (lr msg) ;; called in atomic mode and possibly in host interrupt handler - (define fd (rktio_std_fd rktio RKTIO_STDERR)) + (define fd (rktio_std_fd rktio (stdio-log-receiver-which lr))) (define bstr (bytes-append (string->bytes/utf-8 (vector-ref msg 1)) #"\n")) (define len (bytes-length bstr)) (let loop ([i 0]) @@ -88,13 +89,20 @@ (loop i))))) (rktio_forget rktio fd))) -(define/who (add-stderr-log-receiver! logger . args) +(define (add-stdio-log-receiver! who logger args parse-who which) (check who logger? logger) - (define lr (stderr-log-receiver (parse-filters 'make-stderr-log-receiver args #:default-level 'none))) + (define lr (stdio-log-receiver (parse-filters parse-who args #:default-level 'none) + which)) (atomically (add-log-receiver! logger lr) (set-logger-permanent-receivers! logger (cons lr (logger-permanent-receivers logger))))) +(define/who (add-stderr-log-receiver! logger . args) + (add-stdio-log-receiver! who logger args 'make-stderr-log-receiver RKTIO_STDERR)) + +(define/who (add-stdout-log-receiver! logger . args) + (add-stdio-log-receiver! who logger args 'make-stdio-log-receiver RKTIO_STDOUT)) + ;; ---------------------------------------- (define (add-log-receiver! logger lr) diff --git a/racket/src/racket/Makefile.in b/racket/src/racket/Makefile.in index e2b68d5690..266283e81d 100644 --- a/racket/src/racket/Makefile.in +++ b/racket/src/racket/Makefile.in @@ -49,7 +49,7 @@ RACKET = racket RUN_THIS_RACKET_CGC = ./racket@CGC@ RUN_THIS_RACKET_MMM = ./racket@MMM@ -SETUP_BOOT = -W "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../setup-go.rkt ../compiled MZSRC = $(srcdir)/src diff --git a/racket/src/racket/cmdline.inc b/racket/src/racket/cmdline.inc index 4fe14ae4b0..094b3ca78b 100644 --- a/racket/src/racket/cmdline.inc +++ b/racket/src/racket/cmdline.inc @@ -729,7 +729,7 @@ static int run_from_cmd_line(int argc, char *_argv[], int no_compiled = 0; int init_ns = 0, no_init_ns = 0; int cross_compile = 0; - Scheme_Object *syslog_level = NULL, *stderr_level = NULL; + Scheme_Object *syslog_level = NULL, *stderr_level = NULL, *stdout_level = NULL; FinishArgs *fa; FinishArgsAtoms *fa_a; @@ -1113,6 +1113,14 @@ static int run_from_cmd_line(int argc, char *_argv[], argv++; was_config_flag = 1; break; + case 'O': + stdout_level = get_arg_log_level(prog, real_switch, "stdout", argc, argv); + if (!stdout_level) + goto show_need_help; + --argc; + argv++; + was_config_flag = 1; + break; case 'L': syslog_level = get_arg_log_level(prog, real_switch, "syslog", argc, argv); if (!syslog_level) @@ -1189,6 +1197,13 @@ static int run_from_cmd_line(int argc, char *_argv[], stderr_level = get_log_level(prog, NULL, "PLTSTDERR", "stderr", s); } } + if (!stdout_level) { + char *s; + s = getenv("PLTSTDOUT"); + if (s) { + stdout_level = get_log_level(prog, NULL, "PLTSTDOUT", "stdout", s); + } + } if (getenv("PLTDISABLEGC")) { scheme_enable_garbage_collection(0); } @@ -1227,7 +1242,7 @@ static int run_from_cmd_line(int argc, char *_argv[], } } - scheme_set_logging_spec(syslog_level, stderr_level); + scheme_set_logging2_spec(syslog_level, stderr_level, stdout_level); collects_path = adjust_collects_path(collects_path, &skip_coll_dirs); scheme_set_collects_path(collects_path); @@ -1407,6 +1422,7 @@ static int run_from_cmd_line(int argc, char *_argv[], " -d, --no-delay: Disable on-demand loading of syntax and code\n" " -b, --binary : Read stdin and write stdout/stderr in binary mode\n" " -W , --warn : Set stderr logging to \n" + " -O , --stdout : Set stdout logging to \n" " -L , --syslog : Set syslog logging to \n" " Meta options:\n" " -- : No argument following this switch is used as a switch\n" diff --git a/racket/src/racket/gc2/Makefile.in b/racket/src/racket/gc2/Makefile.in index 5d4c18a7a8..654b315972 100644 --- a/racket/src/racket/gc2/Makefile.in +++ b/racket/src/racket/gc2/Makefile.in @@ -43,7 +43,7 @@ DEF_C_DIRS = $(DEF_COLLECTS_DIR) $(DEF_CONFIG_DIR) # typically redirects to RUN_THIS_RACKET_CGC: RUN_THIS_RACKET_CGC = ../racket@CGC@ -SETUP_BOOT = -W "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled +SETUP_BOOT = -O "info@compiler/cm error" -l- setup @BOOT_MODE@ $(srcdir)/../../setup-go.rkt ../../compiled XFORM_SETUP = @RUN_RACKET_CGC@ $(SELF_RACKET_FLAGS) $(SETUP_BOOT) --tag ++out $(srcdir)/xform-mod.rkt --depends XFORM_NOPRECOMP = $(XFORM_SETUP) --cpp "$(CPP) $(ALL_CPPFLAGS)" @XFORMFLAGS@ -o ++out XSRCDIR = xsrc diff --git a/racket/src/racket/include/scheme.h b/racket/src/racket/include/scheme.h index 6cc7c07896..aee08f2ab6 100644 --- a/racket/src/racket/include/scheme.h +++ b/racket/src/racket/include/scheme.h @@ -1848,6 +1848,8 @@ MZ_EXTERN void scheme_set_ignore_link_paths(int); MZ_EXTERN void scheme_set_cross_compile_mode(int); MZ_EXTERN void scheme_set_logging(int syslog_level, int stderr_level); MZ_EXTERN void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level); +MZ_EXTERN void scheme_set_logging2(int syslog_level, int stderr_level, int stdout_level); +MZ_EXTERN void scheme_set_logging2_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level, Scheme_Object *stdout_level); MZ_EXTERN int scheme_get_allow_set_undefined(); diff --git a/racket/src/racket/src/error.c b/racket/src/racket/src/error.c index e6aeb71913..c0014ec39e 100644 --- a/racket/src/racket/src/error.c +++ b/racket/src/racket/src/error.c @@ -54,6 +54,7 @@ void scheme_set_console_output(scheme_console_output_t p) { scheme_console_outpu SHARED_OK static Scheme_Object *init_syslog_level = scheme_make_integer(INIT_SYSLOG_LEVEL); SHARED_OK static Scheme_Object *init_stderr_level = scheme_make_integer(SCHEME_LOG_ERROR); +SHARED_OK static Scheme_Object *init_stdout_level = scheme_make_integer(0); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_main_logger); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_gc_logger); THREAD_LOCAL_DECL(static Scheme_Logger *scheme_future_logger); @@ -146,15 +147,23 @@ static Scheme_Object *check_arity_property_value_ok(int argc, Scheme_Object *arg static char *make_provided_list(Scheme_Object *o, int count, intptr_t *lenout); static char *init_buf(intptr_t *len, intptr_t *blen); -void scheme_set_logging(int syslog_level, int stderr_level) + +void scheme_set_logging2(int syslog_level, int stderr_level, int stdout_level) { if (syslog_level > -1) init_syslog_level = scheme_make_integer(syslog_level); if (stderr_level > -1) init_stderr_level = scheme_make_integer(stderr_level); + if (stdout_level > -1) + init_stdout_level = scheme_make_integer(stdout_level); } -void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level) +void scheme_set_logging(int syslog_level, int stderr_level) +{ + scheme_set_logging2(syslog_level, stderr_level, -1); +} + +void scheme_set_logging2_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level, Scheme_Object *stdout_level) { /* A spec is (list* .... ) */ if (syslog_level) { @@ -165,6 +174,15 @@ void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_ REGISTER_SO(init_stderr_level); init_stderr_level = stderr_level; } + if (stdout_level) { + REGISTER_SO(init_stdout_level); + init_stdout_level = stdout_level; + } +} + +void scheme_set_logging_spec(Scheme_Object *syslog_level, Scheme_Object *stderr_level) +{ + scheme_set_logging2_spec(syslog_level, stderr_level, NULL); } void scheme_init_logging_once(void) @@ -173,8 +191,12 @@ void scheme_init_logging_once(void) int j; Scheme_Object *l, *s; - for (j = 0; j < 2; j++) { - l = (j ? init_stderr_level : init_syslog_level); + for (j = 0; j < 3; j++) { + switch (j) { + case 0: l = init_syslog_level; break; + case 1: l = init_stderr_level; break; + default: l = init_stdout_level; break; + } if (l) { while (!SCHEME_INTP(l)) { l = SCHEME_CDR(l); @@ -885,6 +907,7 @@ void scheme_init_logger() scheme_main_logger = scheme_make_logger(NULL, NULL); scheme_main_logger->syslog_level = init_syslog_level; scheme_main_logger->stderr_level = init_stderr_level; + scheme_main_logger->stdout_level = init_stdout_level; REGISTER_SO(scheme_gc_logger); scheme_gc_logger = scheme_make_logger(scheme_main_logger, scheme_intern_symbol("GC")); @@ -3513,6 +3536,9 @@ void update_want_level(Scheme_Logger *logger, Scheme_Object *name) if (level > want_level) want_level = level; level = extract_max_spec_level(parent->stderr_level, name); + if (level > want_level) + want_level = level; + level = extract_max_spec_level(parent->stdout_level, name); if (level > want_level) want_level = level; @@ -3736,7 +3762,19 @@ void scheme_log_name_pfx_message(Scheme_Logger *logger, int level, Scheme_Object fwrite(buffer, len, 1, stderr); fwrite("\n", 1, 1, stderr); } - + + if (extract_spec_level(logger->stdout_level, name) >= level) { + if (name) { + intptr_t slen; + slen = SCHEME_SYM_LEN(name); + fwrite(SCHEME_SYM_VAL(name), slen, 1, stdout); + fwrite(": ", 2, 1, stdout); + } + fwrite(buffer, len, 1, stdout); + fwrite("\n", 1, 1, stdout); + fflush(stdout); + } + queue = logger->readers; while (queue) { b = SCHEME_CAR(queue); @@ -3797,6 +3835,7 @@ void scheme_log_abort(char *buffer) logger.local_timestamp = 0; logger.syslog_level = init_syslog_level; logger.stderr_level = init_stderr_level; + logger.stdout_level = init_stdout_level; scheme_log_message(&logger, SCHEME_LOG_FATAL, buffer, strlen(buffer), scheme_false); } diff --git a/racket/src/racket/src/mzmark_type.inc b/racket/src/racket/src/mzmark_type.inc index 588f653d2a..e3fcd1e1df 100644 --- a/racket/src/racket/src/mzmark_type.inc +++ b/racket/src/racket/src/mzmark_type.inc @@ -3740,6 +3740,7 @@ static int mark_logger_MARK(void *p, struct NewGC *gc) { gcMARK2(l->root_timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->stdout_level, gc); gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS @@ -3760,6 +3761,7 @@ static int mark_logger_FIXUP(void *p, struct NewGC *gc) { gcFIXUP2(l->root_timestamp, gc); gcFIXUP2(l->syslog_level, gc); gcFIXUP2(l->stderr_level, gc); + gcFIXUP2(l->stdout_level, gc); gcFIXUP2(l->propagate_level, gc); gcFIXUP2(l->readers, gc); # ifdef GC_NO_SIZE_NEEDED_FROM_PROCS diff --git a/racket/src/racket/src/mzmarksrc.c b/racket/src/racket/src/mzmarksrc.c index 04b00f5f0c..6173372504 100644 --- a/racket/src/racket/src/mzmarksrc.c +++ b/racket/src/racket/src/mzmarksrc.c @@ -1052,6 +1052,7 @@ mark_logger { gcMARK2(l->root_timestamp, gc); gcMARK2(l->syslog_level, gc); gcMARK2(l->stderr_level, gc); + gcMARK2(l->stdout_level, gc); gcMARK2(l->propagate_level, gc); gcMARK2(l->readers, gc); size: diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index a470b8447f..3cb721d2b8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -3422,6 +3422,7 @@ struct Scheme_Logger { intptr_t local_timestamp; /* determines when want_level is up-to-date */ Scheme_Object *syslog_level; /* (list* ... ) */ Scheme_Object *stderr_level; + Scheme_Object *stdout_level; Scheme_Object *propagate_level; /* can be NULL */ Scheme_Object *readers; /* list of (cons (make-weak-box ) ) */ };