diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 445ae5464..49ca05325 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -1168,8 +1168,8 @@ SCM_DEFINE (scm_i_make_transcoded_port, if (scm_is_true (scm_output_port_p (port))) mode |= SCM_WRTNG; - else if (scm_is_true (scm_input_port_p (port))) - mode |= SCM_RDNG; + if (scm_is_true (scm_input_port_p (port))) + mode |= SCM_RDNG; result = make_transcoded_port (port, mode); diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index 5b46cccd2..4d1981df2 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -919,6 +919,32 @@ not `set-port-position!'" (with-test-prefix "8.2.6 Input and output ports" + (define (check-transcoded-port-mode make-port pred) + (let ((p (make-port "/dev/null" (file-options no-fail)))) + (dynamic-wind + (lambda () #t) + (lambda () + (set! p (transcoded-port p (native-transcoder))) + (pred p)) + (lambda () (close-port p))))) + + (pass-if "transcoded-port preserves input mode" + (check-transcoded-port-mode open-file-input-port + (lambda (p) + (and (input-port? p) + (not (output-port? p)))))) + + (pass-if "transcoded-port preserves output mode" + (check-transcoded-port-mode open-file-output-port + (lambda (p) + (and (not (input-port? p)) + (output-port? p))))) + + (pass-if "transcoded-port preserves input/output mode" + (check-transcoded-port-mode open-file-input/output-port + (lambda (p) + (and (input-port? p) (output-port? p))))) + (pass-if "transcoded-port [output]" (let ((s "Hello\nÄÖÜ")) (bytevector=?