warnings written to warning port

* libguile/deprecation.c (scm_c_issue_deprecation_warning):
* libguile/load.c (auto_compile_catch_handler):
  (scm_sys_warn_auto_compilation_enabled, scm_primitive_load_path):
* module/ice-9/boot-9.scm (warn, %load-announce, duplicate-handlers)
  (load-in-vicinity):
* module/system/base/message.scm (warning): Write to the warning port.
  (*current-warning-port*): Alias the warning port.

diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index be5fffc..0822707 100644 (file)
--- a/libguile/deprecation.c
+++ b/libguile/deprecation.c
@@ -89,8 +89,8 @@ scm_c_issue_deprecation_warning (const char *msg)
             fprintf (stderr, "%s\n", msg);
           else
             {
-              scm_puts (msg, scm_current_error_port ());
-              scm_newline (scm_current_error_port ());
+              scm_puts (msg, scm_current_warning_port ());
+              scm_newline (scm_current_warning_port ());
             }
         }
     }

diff --git a/libguile/load.c b/libguile/load.c
index 66e3cc4..a400318 100644 (file)
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -738,18 +738,18 @@ auto_compile_catch_handler (void *data, SCM tag, SCM throw_args)
   oport = scm_open_output_string ();
   scm_print_exception (oport, SCM_BOOL_F, tag, throw_args);
 
-  scm_puts (";;; WARNING: compilation of ", scm_current_error_port ());
-  scm_display (source, scm_current_error_port ());
-  scm_puts (" failed:\n", scm_current_error_port ());
+  scm_puts (";;; WARNING: compilation of ", scm_current_warning_port ());
+  scm_display (source, scm_current_warning_port ());
+  scm_puts (" failed:\n", scm_current_warning_port ());
 
   lines = scm_string_split (scm_get_output_string (oport),
                             SCM_MAKE_CHAR ('\n'));
   for (; scm_is_pair (lines); lines = scm_cdr (lines))
     if (scm_c_string_length (scm_car (lines)))
       {
-        scm_puts (";;; ", scm_current_error_port ());
-        scm_display (scm_car (lines), scm_current_error_port ());
-        scm_newline (scm_current_error_port ());
+        scm_puts (";;; ", scm_current_warning_port ());
+        scm_display (scm_car (lines), scm_current_warning_port ());
+        scm_newline (scm_current_warning_port ());
       }
 
   scm_close_port (oport);
@@ -767,7 +767,7 @@ SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabl
     {
       scm_puts (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n"
                 ";;;       or pass the --no-auto-compile argument to disable.\n",
-                scm_current_error_port ());
+                scm_current_warning_port ());
       message_shown = 1;
     }
 
@@ -933,9 +933,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1,
       if (stat_ret == 0 && compiled_is_fresh (full_filename, fallback,
                                               &stat_source, &stat_compiled))
         {
-          scm_puts (";;; found fresh local cache at ", scm_current_error_port ());
-          scm_display (fallback, scm_current_error_port ());
-          scm_newline (scm_current_error_port ());
+          scm_puts (";;; found fresh local cache at ", scm_current_warning_port ());
+          scm_display (fallback, scm_current_warning_port ());
+          scm_newline (scm_current_warning_port ());
           return scm_load_compiled_with_vm (fallback);
         }
     }

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 1d25f63..2659d6c 100644 (file)
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -217,7 +217,7 @@ If there is no handler at all, Guile prints an error and then exits."
 (define current-warning-port current-error-port)
 
 (define (warn . stuff)
-  (with-output-to-port (current-error-port)
+  (with-output-to-port (current-warning-port)
     (lambda ()
       (newline)
       (display ";;; WARNING ")
@@ -1382,7 +1382,7 @@ VALUE."
 
 (define (%load-announce file)
   (if %load-verbosely
-      (with-output-to-port (current-error-port)
+      (with-output-to-port (current-warning-port)
         (lambda ()
           (display ";;; ")
           (display "loading ")
@@ -3393,7 +3393,7 @@ module '(ice-9 q) '(make-q q-length))}."
                  #f))
     
     (define (warn module name int1 val1 int2 val2 var val)
-      (format (current-error-port)
+      (format (current-warning-port)
               "WARNING: ~A: `~A' imported from both ~A and ~A\n"
               (module-name module)
               name
@@ -3415,7 +3415,7 @@ module '(ice-9 q) '(make-q q-length))}."
     (define (warn-override-core module name int1 val1 int2 val2 var val)
       (and (eq? int1 the-scm-module)
            (begin
-             (format (current-error-port)
+             (format (current-warning-port)
                      "WARNING: ~A: imported module ~A overrides core binding `~A'\n"
                      (module-name module)
                      (module-name int2)
@@ -3537,13 +3537,13 @@ module '(ice-9 q) '(make-q q-length))}."
               go-path
               (begin
                 (if gostat
-                    (format (current-error-port)
+                    (format (current-warning-port)
                             ";;; note: source file ~a\n;;;       newer than compiled ~a\n"
                             name go-path))
                 (cond
                  (%load-should-auto-compile
                   (%warn-auto-compilation-enabled)
-                  (format (current-error-port) ";;; compiling ~a\n" name)
+                  (format (current-warning-port) ";;; compiling ~a\n" name)
                   (let ((cfn
                          ((module-ref
                                (resolve-interface '(system base compile))
@@ -3551,15 +3551,15 @@ module '(ice-9 q) '(make-q q-length))}."
                               name
                               #:opts %auto-compilation-options
                               #:env (current-module))))
-                    (format (current-error-port) ";;; compiled ~a\n" cfn)
+                    (format (current-warning-port) ";;; compiled ~a\n" cfn)
                     cfn))
                  (else #f))))))
       (lambda (k . args)
-        (format (current-error-port)
+        (format (current-warning-port)
                 ";;; WARNING: compilation of ~a failed:\n" name)
         (for-each (lambda (s)
                     (if (not (string-null? s))
-                        (format (current-error-port) ";;; ~a\n" s)))
+                        (format (current-warning-port) ";;; ~a\n" s)))
                   (string-split
                    (call-with-output-string
                     (lambda (port) (print-exception port #f k args)))

diff --git a/module/system/base/message.scm b/module/system/base/message.scm
index aed3502..75e14ea 100644 (file)
--- a/module/system/base/message.scm
+++ b/module/system/base/message.scm
@@ -54,11 +54,13 @@
 ;;; Warnings
 ;;;
 
+;; This name existed before %current-warning-port was introduced, but
+;; otherwise it is a deprecated binding.
 (define *current-warning-port*
-  ;; The port where warnings are sent.
-  (make-fluid (current-error-port)))
-
-(fluid-set! *current-warning-port* (current-error-port))
+  ;; Can't play the identifier-syntax deprecation game in Guile 2.0, as
+  ;; other modules might depend on this being a normal binding and not a
+  ;; syntax binding.
+  (parameter-fluid current-warning-port))
 
 (define *current-warning-prefix*
   ;; Prefix string when emitting a warning.
@@ -194,7 +196,7 @@
   "Emit a warning of type TYPE for source location LOCATION (a source
 property alist) using the data in ARGS."
   (let ((wt   (lookup-warning-type type))
-        (port (fluid-ref *current-warning-port*)))
+        (port (current-warning-port)))
     (if (warning-type? wt)
         (apply (warning-type-printer wt)
                port (location-string location)