guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-57-g2c27dd


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-57-g2c27dd5
Date: Mon, 05 Dec 2011 17:13:34 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=2c27dd57c7ec4a8168e2668aed380594a99dda8f

The branch, stable-2.0 has been updated
       via  2c27dd57c7ec4a8168e2668aed380594a99dda8f (commit)
       via  3972de7675bf771b403eaef97f0741280649b5ed (commit)
       via  13dd74c8eae595889df6f570007b5f50b78073ce (commit)
      from  90de5c4c2e4fc177c18f6cdd035dad5d8b6895f9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 2c27dd57c7ec4a8168e2668aed380594a99dda8f
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 5 15:43:18 2011 +0100

    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.

commit 3972de7675bf771b403eaef97f0741280649b5ed
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 28 23:24:43 2011 +0200

    add current-warning-port
    
    * libguile/ports.h:
    * libguile/ports.c (scm_current_warning_port)
      (scm_set_current_warning_port): New functions, wrapping the Scheme
      parameter.
    
    * module/ice-9/boot-9.scm (current-warning-port): New parameter,
      defining a port for warnings.

commit 13dd74c8eae595889df6f570007b5f50b78073ce
Author: Andy Wingo <address@hidden>
Date:   Mon Dec 5 16:37:17 2011 +0100

    setting a parameter returns the previous value
    
    * module/ice-9/boot-9.scm (make-parameter): Setting a parameter by
      invoking it with an argument now returns the previous value.

-----------------------------------------------------------------------

Summary of changes:
 libguile/deprecation.c         |    4 ++--
 libguile/load.c                |   20 ++++++++++----------
 libguile/ports.c               |   24 ++++++++++++++++++++++++
 libguile/ports.h               |    2 ++
 module/ice-9/boot-9.scm        |   37 +++++++++++++++++++++++++++----------
 module/system/base/message.scm |   12 +++++++-----
 6 files changed, 72 insertions(+), 27 deletions(-)

diff --git a/libguile/deprecation.c b/libguile/deprecation.c
index be5fffc..0822707 100644
--- 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
--- 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/libguile/ports.c b/libguile/ports.c
index 6467228..677b278 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -412,6 +412,17 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 
0, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM
+scm_current_warning_port (void)
+{
+  static SCM cwp_var = SCM_BOOL_F;
+
+  if (scm_is_false (cwp_var))
+    cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+  
+  return scm_call_0 (scm_variable_ref (cwp_var));
+}
+
 SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
            (),
            "Return the current-load-port.\n"
@@ -466,6 +477,19 @@ SCM_DEFINE (scm_set_current_error_port, 
"set-current-error-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+
+SCM
+scm_set_current_warning_port (SCM port)
+{
+  static SCM cwp_var = SCM_BOOL_F;
+
+  if (scm_is_false (cwp_var))
+    cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
+  
+  return scm_call_1 (scm_variable_ref (cwp_var), port);
+}
+
+
 void
 scm_dynwind_current_input_port (SCM port)
 #define FUNC_NAME NULL
diff --git a/libguile/ports.h b/libguile/ports.h
index 6a669b6..fcf1424 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -247,10 +247,12 @@ SCM_API SCM scm_drain_input (SCM port);
 SCM_API SCM scm_current_input_port (void);
 SCM_API SCM scm_current_output_port (void);
 SCM_API SCM scm_current_error_port (void);
+SCM_API SCM scm_current_warning_port (void);
 SCM_API SCM scm_current_load_port (void);
 SCM_API SCM scm_set_current_input_port (SCM port);
 SCM_API SCM scm_set_current_output_port (SCM port);
 SCM_API SCM scm_set_current_error_port (SCM port);
+SCM_API SCM scm_set_current_warning_port (SCM port);
 SCM_API void scm_dynwind_current_input_port (SCM port);
 SCM_API void scm_dynwind_current_output_port (SCM port);
 SCM_API void scm_dynwind_current_error_port (SCM port);
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 73d897c..2659d6c 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -213,9 +213,11 @@ If there is no handler at all, Guile prints an error and 
then exits."
 
 (define pk peek)
 
+;; Temporary definition; replaced later.
+(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 ")
@@ -1380,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 ")
@@ -2872,7 +2874,9 @@ module '(ice-9 q) '(make-q q-length))}."
     (make-struct <parameter> 0
                  (case-lambda
                    (() (fluid-ref fluid))
-                   ((x) (fluid-set! fluid (conv x))))
+                   ((x) (let ((prev (fluid-ref fluid)))
+                          (fluid-set! fluid (conv x))
+                          prev)))
                  fluid conv)))
 
 (define (parameter? x)
@@ -2905,6 +2909,19 @@ module '(ice-9 q) '(make-q q-length))}."
                body body* ...)))))))
 
 
+;;;
+;;; Warnings.
+;;;
+
+(define current-warning-port
+  (make-parameter (current-error-port)
+                  (lambda (x)
+                    (if (output-port? x)
+                        x
+                        (error "expected an output port" x)))))
+
+
+
 
 ;;; {Running Repls}
 ;;;
@@ -3376,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
@@ -3398,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)
@@ -3520,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))
@@ -3534,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
--- 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)


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]