mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

scm_i_make_transcoded_port: fix mode for input/output ports

Browse source 
* libguile/r6rs-ports.c (scm_i_make_transcoded_ports): make sure to
  include SCM_RDNG for input/output ports.

Thanks to Göran Weinholt for reporting the problem.

Closes: 41045
This commit is contained in:
Rob Browning 2020-10-04 14:05:29 -05:00
parent f1547e1d58
commit d0d1f68794
2 changed files with 28 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/r6rs-ports.c
View file

@ -1168,7 +1168,7 @@ 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)))
if (scm_is_true (scm_input_port_p (port)))
mode |= SCM_RDNG;
result = make_transcoded_port (port, mode);

26
test-suite/tests/r6rs-ports.test
View file

@ -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=?