mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
scm_i_make_transcoded_port: fix mode for input/output ports
* 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:
parent
f1547e1d58
commit
d0d1f68794
2 changed files with 28 additions and 2 deletions
|
@ -1168,8 +1168,8 @@ SCM_DEFINE (scm_i_make_transcoded_port,
|
||||||
|
|
||||||
if (scm_is_true (scm_output_port_p (port)))
|
if (scm_is_true (scm_output_port_p (port)))
|
||||||
mode |= SCM_WRTNG;
|
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;
|
mode |= SCM_RDNG;
|
||||||
|
|
||||||
result = make_transcoded_port (port, mode);
|
result = make_transcoded_port (port, mode);
|
||||||
|
|
||||||
|
|
|
@ -919,6 +919,32 @@ not `set-port-position!'"
|
||||||
|
|
||||||
(with-test-prefix "8.2.6 Input and output ports"
|
(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]"
|
(pass-if "transcoded-port [output]"
|
||||||
(let ((s "Hello\nÄÖÜ"))
|
(let ((s "Hello\nÄÖÜ"))
|
||||||
(bytevector=?
|
(bytevector=?
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue