fix single-argument write-byte and write-char

Repairs a mistake in 8e7792d8

Closes PR 15363
This commit is contained in:
Matthew Flatt 2016-10-04 10:09:48 -06:00
parent c08a2fd57c
commit 9887669ab0
2 changed files with 16 additions and 0 deletions

View File

@ -1849,6 +1849,20 @@
resolve-path
"C://testing-root////testing-dir\\\\testing-file")]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Make sure `write-byte` and `write-char` don't try to test
;; a non-supplied argument:
(parameterize ([current-output-port (open-output-string)])
(let ([s (if (zero? (random 1)) "a" "b")])
(string-append s s) ; causes a clear operation on the runstack for second argument
(write-byte 65)))
(parameterize ([current-output-port (open-output-string)])
(let ([s (if (zero? (random 1)) "a" "b")])
(string-append s s) ; causes a clear operation on the runstack for second argument
(write-char #\A)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

View File

@ -4171,6 +4171,7 @@ write_byte (int argc, GC_CAN_IGNORE Scheme_Object *argv[]) XFORM_ASSERT_NO_CONVE
if (SCHEME_INTP(argv[0])
&& (SCHEME_INT_VAL(argv[0]) >= 0)
&& (SCHEME_INT_VAL(argv[0]) <= 255)
&& (argc > 1)
&& SCHEME_OUTPUT_PORTP(argv[1])) {
char buffer[1];
buffer[0] = SCHEME_INT_VAL(argv[0]);
@ -4215,6 +4216,7 @@ write_char (int argc, GC_CAN_IGNORE Scheme_Object *argv[]) XFORM_ASSERT_NO_CONVE
if (argc
&& SCHEME_CHARP(argv[0])
&& (SCHEME_CHAR_VAL(argv[0]) < 128)
&& (argc > 1)
&& SCHEME_OUTPUT_PORTP(argv[1])) {
char buffer[1];
buffer[0] = SCHEME_CHAR_VAL(argv[0]);