From 9dc86af2ebaad2044470da4d1127ab1a699af69e Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sat, 21 May 2016 17:08:58 +1200
Subject: [PATCH 2/3] 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.
---
 library.scm             | 53 ++++++++++++++++++++++++++-----------------------
 tests/library-tests.scm |  8 ++++++--
 2 files changed, 34 insertions(+), 27 deletions(-)

diff --git a/library.scm b/library.scm
index 3a8a4ef..0d997c2 100644
--- a/library.scm
+++ b/library.scm
@@ -2684,28 +2684,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)))
@@ -4773,13 +4776,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 1fd82f0..aaa9097 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -556,8 +556,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)))
-- 
2.8.1