1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 15:00:21 +02:00

tests: Check 'simple-format' with closed current-output-port.

This is a follow-up to e26ab06.

* libguile/print.c (scm_simple_format): Pass 1 to
  SCM_VALIDATE_OPORT_VALUE, for 'destination'.
* test-suite/tests/format.test ("simple-format"): Add test.
This commit is contained in:
Ludovic Courtès 2014-03-20 09:40:42 +01:00
parent 5dcbcfcef8
commit f2c3d29fd2
2 changed files with 17 additions and 1 deletions

View file

@ -1468,7 +1468,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
if (scm_is_eq (destination, SCM_BOOL_T)) if (scm_is_eq (destination, SCM_BOOL_T))
{ {
destination = port = scm_current_output_port (); destination = port = scm_current_output_port ();
SCM_VALIDATE_OPORT_VALUE (0, destination); SCM_VALIDATE_OPORT_VALUE (1, destination);
} }
else if (scm_is_false (destination)) else if (scm_is_false (destination))
{ {

View file

@ -24,6 +24,22 @@
#:use-module (ice-9 format)) #:use-module (ice-9 format))
(with-test-prefix "simple-format"
(pass-if-exception "current-output-port is closed"
exception:wrong-type-arg
;; This used to segfault in Guile <= 2.0.10.
(let ((old (current-output-port))
(new (%make-void-port "w")))
(dynamic-wind
(lambda ()
(set-current-output-port new)
(close-port new))
(lambda ()
(simple-format #t "hello, closed port!")
#t)
(lambda ()
(set-current-output-port old))))))
;;; FORMAT Basic Output ;;; FORMAT Basic Output
(with-test-prefix "format basic output" (with-test-prefix "format basic output"