~ chicken-core (chicken-5) 7c14fd6df17c3b7a6f4d2639c5218cce0246e5d9

commit 7c14fd6df17c3b7a6f4d2639c5218cce0246e5d9
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Sat May 21 17:08:58 2016 +1200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sun May 22 13:21:59 2016 +0200

    Make special-cased parameters return the new value
    
    This ensures the correct value of a parameter is used within the body of
    a `parameterize` form. Previously, the original value would be returned
    from the conversion step and used as the new value within the form's
    body, making the parameterization a noop.
    
    Supplements the previous commit's fix for #1285.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/library.scm b/library.scm
index 10b43b0e..a32ee8cb 100644
--- a/library.scm
+++ b/library.scm
@@ -1903,28 +1903,31 @@ EOF
       (##core#inline "C_i_check_port" x 0 #t) ) )
 
 (define (current-input-port . args)
-  (when (pair? args)
-    (let ((p (car args)))
-      (##sys#check-port p 'current-input-port)
-      (let-optionals (cdr args) ((convert? #t) (set? #t))
-	(when set? (set! ##sys#standard-input p))) ) )
-  ##sys#standard-input)
+  (if (null? args)
+      ##sys#standard-input
+      (let ((p (car args)))
+	(##sys#check-port p 'current-input-port)
+	(let-optionals (cdr args) ((convert? #t) (set? #t))
+	  (when set? (set! ##sys#standard-input p)))
+	p)))
 
 (define (current-output-port . args)
-  (when (pair? args)
-    (let ((p (car args)))
-      (##sys#check-port p 'current-output-port)
-      (let-optionals (cdr args) ((convert? #t) (set? #t))
-	(when set? (set! ##sys#standard-output p))) ) )
-  ##sys#standard-output)
+  (if (null? args)
+      ##sys#standard-output
+      (let ((p (car args)))
+	(##sys#check-port p 'current-output-port)
+	(let-optionals (cdr args) ((convert? #t) (set? #t))
+	  (when set? (set! ##sys#standard-output p)))
+	p)))
 
 (define (current-error-port . args)
-  (when (pair? args)
-    (let ((p (car args)))
-      (##sys#check-port p 'current-error-port)
-      (let-optionals (cdr args) ((convert? #t) (set? #t))
-	(when set? (set! ##sys#standard-error p))) ) )
-  ##sys#standard-error)
+  (if (null? args)
+      ##sys#standard-error
+      (let ((p (car args)))
+	(##sys#check-port p 'current-error-port)
+	(let-optionals (cdr args) ((convert? #t) (set? #t))
+	  (when set? (set! ##sys#standard-error p)))
+	p)))
 
 (define (##sys#tty-port? port)
   (and (not (zero? (##sys#peek-unsigned-integer port 0)))
@@ -4099,13 +4102,13 @@ EOF
       (lambda () (set! ##sys#current-exception-handler oldh)) ) ) )
 
 (define (current-exception-handler . args)
-  (when (pair? args)
-    (let ((proc (car args)))
-      (##sys#check-closure proc 'current-exception-handler)
-      (let-optionals (cdr args) ((convert? #t) (set? #t))
-	(when set?
-	  (set! ##sys#current-exception-handler proc))) ) )
-  ##sys#current-exception-handler)
+  (if (null? args)
+      ##sys#current-exception-handler
+      (let ((proc (car args)))
+	(##sys#check-closure proc 'current-exception-handler)
+	(let-optionals (cdr args) ((convert? #t) (set? #t))
+	  (when set? (set! ##sys#current-exception-handler proc)))
+	proc)))
 
 (define (make-property-condition kind . props)
   (##sys#make-structure
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 13f539dd..eb9506ad 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -543,8 +543,12 @@ A
 	(parameterize ((current-output-port out)
 		       (current-error-port out)
 		       (current-input-port in)
-		       (current-exception-handler void))
-	  (void))))))
+		       (current-exception-handler list))
+	  (display "bar")
+	  (display "!" (current-error-port))
+	  (assert (equal? (read) 'foo))
+	  (assert (equal? (get-output-string out) "bar!"))
+	  (assert (equal? (signal 'baz) '(baz))))))))
   (assert (equal? original-input (current-input-port)))
   (assert (equal? original-output (current-output-port)))
   (assert (equal? original-error (current-error-port)))