[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-166-ga5cbbaa

[Mark H Weaver]

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=a5cbbaa66a2491453db0edff9b0cb592a98f61bf

The branch, stable-2.0 has been updated
       via  a5cbbaa66a2491453db0edff9b0cb592a98f61bf (commit)
       via  e6c8e6047ed2e772cc4e1fb5ad4d389e5c616feb (commit)
       via  d0d8c872afcc0e3384389171ceb32dc26df8c8a6 (commit)
      from  6f4cc6a31eaf9a55730e85a096846caaf5a940fc (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 a5cbbaa66a2491453db0edff9b0cb592a98f61bf
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 21 16:21:36 2014 -0500

    Fix nested block comment example in manual.
    
    Reported by Chris K. Jester-Young <address@hidden>.
    
    * doc/ref/api-evaluation.texi (Block Comments): Fix example.

commit e6c8e6047ed2e772cc4e1fb5ad4d389e5c616feb
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 21 16:06:40 2014 -0500

    REPL Server: Don't establish a SIGINT handler.
    
    * module/system/repl/server.scm (call-with-sigint): Remove.
      (accept-new-client): Don't wrap 'call-with-sigint' around call to
      'accept'.

commit d0d8c872afcc0e3384389171ceb32dc26df8c8a6
Author: Mark H Weaver <address@hidden>
Date:   Tue Jan 21 15:50:58 2014 -0500

    Write out HTTP Basic auth headers correctly.
    
    Fixes <http://bugs.gnu.org/14370>.
    Reported by Atom X Zane <address@hidden>.
    
    * module/web/http.scm (write-credentials): Handle the Basic auth scheme
      correctly.
    
    * test-suite/tests/web-http.test (pass-if-round-trip): Use
      'pass-if-equal' for better error reporting.
      ("request headers"): Add tests.
    
    * THANKS: Add "Atom X Zane" to bug fix section.

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

Summary of changes:
 THANKS                         |    1 +
 doc/ref/api-evaluation.texi    |    2 +-
 module/system/repl/server.scm  |   19 +------------------
 module/web/http.scm            |    8 ++++----
 test-suite/tests/web-http.test |   19 +++++++++++--------
 5 files changed, 18 insertions(+), 31 deletions(-)

diff --git a/THANKS b/THANKS
index f16376b..ddb11c1 100644
--- a/THANKS
+++ b/THANKS
@@ -192,6 +192,7 @@ For fixes or providing information which led to a fix:
            Andy Wingo
           Keith Wright
         William Xu
+         Atom X Zane
 
 
 ;; Local Variables:
diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 4a5b3d1..7d67d9a 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -238,7 +238,7 @@ comments as specified by R6RS and
 @url{http://srfi.schemers.org/srfi-30/srfi-30.html, SRFI-30}:
 
 @lisp
-(+  #| this is a #| nested |# block comment |# 2)
+(+ 1 #| this is a #| nested |# block comment |# 2)
 @result{} 3
 @end lisp
 
diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm
index ec90677..2df7564 100644
--- a/module/system/repl/server.scm
+++ b/module/system/repl/server.scm
@@ -67,27 +67,10 @@
     (bind sock AF_UNIX path)
     sock))
 
-(define call-with-sigint
-  (if (not (provided? 'posix))
-      (lambda (thunk) (thunk))
-      (lambda (thunk)
-        (let ((handler #f))
-          (dynamic-wind
-            (lambda ()
-              (set! handler
-                    (sigaction SIGINT (lambda (sig) (throw 'interrupt)))))
-            thunk
-            (lambda ()
-              (if handler
-                  ;; restore Scheme handler, SIG_IGN or SIG_DFL.
-                  (sigaction SIGINT (car handler) (cdr handler))
-                  ;; restore original C handler.
-                  (sigaction SIGINT #f))))))))
-
 (define* (run-server #:optional (server-socket (make-tcp-server-socket)))
   (define (accept-new-client)
     (catch #t
-      (lambda () (call-with-sigint (lambda () (accept server-socket))))
+      (lambda () (accept server-socket))
       (lambda (k . args)
         (cond
          ((port-closed? server-socket)
diff --git a/module/web/http.scm b/module/web/http.scm
index d22c70c..aa75142 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -918,10 +918,10 @@ as an ordered alist."
 
 (define (write-credentials val port)
   (display (car val) port)
-  (if (pair? (cdr val))
-      (begin
-        (display #\space port)
-        (write-key-value-list (cdr val) port))))
+  (display #\space port)
+  (case (car val)
+    ((basic) (display (cdr val) port))
+    (else (write-key-value-list (cdr val) port))))
 
 ;; challenges = 1#challenge
 ;; challenge = auth-scheme 1*SP 1#auth-param
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index aa607af..45cce02 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -49,14 +49,14 @@
 (define-syntax pass-if-round-trip
   (syntax-rules ()
     ((_ str)
-     (pass-if (format #f "~s round trip" str)
-       (equal? (call-with-output-string
-                (lambda (port)
-                  (call-with-values
-                      (lambda () (read-header (open-input-string str)))
-                    (lambda (sym val)
-                      (write-header sym val port)))))
-               str)))))
+     (pass-if-equal (format #f "~s round trip" str)
+         str
+       (call-with-output-string
+        (lambda (port)
+          (call-with-values
+              (lambda () (read-header (open-input-string str)))
+            (lambda (sym val)
+              (write-header sym val port)))))))))
 
 (define-syntax pass-if-any-error
   (syntax-rules ()
@@ -292,6 +292,9 @@
   (pass-if-parse authorization "Digest foooo" '(digest foooo))
   (pass-if-parse authorization "Digest foo=bar,baz=qux"
                  '(digest (foo . "bar") (baz . "qux")))
+  (pass-if-round-trip "Authorization: basic foooo\r\n")
+  (pass-if-round-trip "Authorization: digest foooo\r\n")
+  (pass-if-round-trip "Authorization: digest foo=bar, baz=qux\r\n")
   (pass-if-parse expect "100-continue, foo" '((100-continue) (foo)))
   (pass-if-parse from "address@hidden" "address@hidden")
   (pass-if-parse host "qux" '("qux" . #f))


hooks/post-receive
-- 
GNU Guile