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.

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}

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}

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 <levels> " where " must be one of the following\n"
+                 which " <levels> " where " must be one of the following\n"
                  " <level>s:\n"
                  "   none fatal error warning info debug\n"
                  "or up to one such <level> 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)

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@

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))

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)

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
 

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 <levels>, --warn <levels> : Set stderr logging to <levels>\n"
+	 "  -O <levels>, --stdout <levels> : Set stdout logging to <levels>\n"
 	 "  -L <levels>, --syslog <levels> : Set syslog logging to <levels>\n"
 	 " Meta options:\n"
 	 "  -- : No argument following this switch is used as a switch\n"

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

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();
 

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* <int> <byte-string> .... <int>) */
   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);
 }

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

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:

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* <level-int> <name-sym> ... <level-int>) */
   Scheme_Object *stderr_level;
+  Scheme_Object *stdout_level;
   Scheme_Object *propagate_level; /* can be NULL */
   Scheme_Object *readers; /* list of (cons (make-weak-box <reader>) <sema>) */
 };