; Test cases for string ports of kind output ; A port has a bifurcated API: ; input API ; output API. ; Some ports support both. ; The input API has write, but not read method. ; Some ports support byte and char operations. ; A string port is-a port. ; !!! write and read methods take or return Scheme objects ; i.e. strings, symbols, atoms, etc. ; A string port is of kind: input or output. ; A string port does not have all the methods of the port API: ; kind output has write method, but not read. ; kind input has read method, but not write. ; A string output port stores its contents in memory (unlike device ports). ; A get-output-string returns contents previously written. ; A string port is practically infinite. ; A string port is like a string. ; A sequence of writes are like a sequence of appends to a string, ; except the things written are objects, not just strings. ; You can only get the entire string. ; A get does not have the side effect of advancing a cursor in the string. ; write-byte is discouraged on an output string-port. ; Complicated by fact that strings are UTF-8 encoded. ; !!! The port object does not own a string object. ; The "string" internally is in a UTF-8 encoded C allocated chunk ; of memory, but not in a Scheme cell for a Scheme string. ; It survives garbage collection. ; Closing a port frees memory to C, but few cells to Scheme. ; Closing a port leaves the symbol defined until it goes out of scope, ; but the symbol no longer is bound to a port object ; i.e. operations on it fail. ; setup ; Some tests use new ports, not the setup one. ; This port is unlimited, should grow (define aStringPort (open-output-string)) ; tests (test! "open-output-string yields a port") (assert `(port? ,aStringPort)) (test! "open-output-string yields a port of kind output") (assert `(output-port? ,aStringPort)) (test! "open-output-string yields a port NOT of kind input") (assert `(not (input-port? ,aStringPort))) (test! "read method fails on an output string-port") (assert-error `(read ,aStringPort) "read: argument 1 must be: input port") (test! "read-byte method fails on an output string-port") (assert-error `(read-byte ,aStringPort) "read-byte: argument 1 must be: input port") (test! "string get from port equals string write to port") ; !!! with escaped double quote (assert `(string=? (let* ((aStringPort (open-output-string))) (write "foo" aStringPort) (get-output-string aStringPort)) "\"foo\"")) (test! "string get from port equals string repr of symbol written to port") ; !!! without escaped double quote (assert `(string=? (let* ((aStringPort (open-output-string))) ; !!! 'foo is-a symbol whose repr is three characters: foo ; write to a port writes the repr (write 'foo aStringPort) (get-output-string aStringPort)) (symbol->string 'foo))) (test! "get-output-string called twice returns the same string") ; Can get the same string twice (assert `(string=? (begin (write "foo" ,aStringPort) (get-output-string ,aStringPort) (get-output-string ,aStringPort)) "\"foo\"")) (test! "port contents survive garbage collection") ; using aStringPort whose contents are "foo" (assert `(string=? (begin (gc) (get-output-string ,aStringPort)) "\"foo\"")) ; tests of the form (open-output-string ) ; Some Schemes have an optional argument a string that is the initial contents? ; Guile does not. Racket does not, but takes a name for the port. MIT does not. ; ; The initial string is now ignored, Gimp v3 ; In v2, the initial string was always overwritten, but used for the contents. ; Only the size of the initial string ed, not the contents. ; Also, see test9.scm, which tests this using a string whose scope is larger ; and so does not get garbage collected. (define aLimitedStringPort (open-output-string "initial")) (test! "initial contents string is ignored") ; get-output-string returns empty string, not the initial contents. (assert `(string=? (get-output-string ,aLimitedStringPort) "")) ; This is a v2 test. ; (test! "writing to output string-port w initial contents may truncate") ; Only 7 chars are written, and a double quote char takes one ;(assert `(string=? ; (begin ; (write "INITIALPLUS" ,aLimitedStringPort) ; (get-output-string ,aLimitedStringPort)) ; "\"INITIA")) ;(test! "port contents survive garbage collection") ; This is v3 test. ; using aStringPort whose contents are "INITIAL" (assert `(string=? (begin (write "INITIAL",aLimitedStringPort) (gc) (get-output-string ,aLimitedStringPort)) "\"INITIAL\"")) ; write bytes ; initial contents "foo" (test! "write-byte on output-string, ASCII char") (assert `(write-byte (integer->byte 72) ,aStringPort)) ; write is effective when byte is an ASCII char, valid UTF-8 encoding ; Note that the yield is a repr of a string followed by a repr of a char. (assert `(string=? (get-output-string ,aStringPort) "\"foo\"H")) ; This test corrupts aStringPort. ; It tests what an author should NOT do: write a byte that is not UTF-8 encoding. (test! "write-byte on output-string, non ASCII char") (assert `(write-byte (integer->byte 172) ,aStringPort)) ; write yields strange results when byte is not a proper UTF-8 encoding. ; Note that the yield is same as before, and doesn't show the written byte. (assert `(string=? (get-output-string ,aStringPort) "\"foo\"H")) ; closing (test! "closing a port") (assert `(close-port ,aStringPort)) (test! "a closed port cannot be get-output-string") (assert-error `(get-output-string ,aStringPort) "get-output-string: argument 1 must be: output port") (test! "a closed port cannot be written") (assert-error `(write 'foo ,aStringPort) "write: argument 2 must be: output port ") ; closing not affect prior gotten contents (test! "closing output port not affect prior gotten contents") ; setup (define aStringPort (open-output-string)) (write "foo" aStringPort) (define contents (get-output-string aStringPort)) (close-port aStringPort) (gc) (assert `(string=? ,contents "\"foo\"")) ; What is read equals the string written. ; Edge case: writing more than 256 characters in two tranches ; where second write crosses end boundary of 256 char buffer. ; issue #9495 (assert '(string=? (let* ((aStringPort (open-output-string))) (write (string->symbol (make-string 250 #\A)) aStringPort) (write (string->symbol (make-string 7 #\B)) aStringPort) (get-output-string aStringPort)) (string-append (make-string 250 #\A) (make-string 7 #\B)))) ; read/write are opposites ; !!! Note in this case lack of escaped quotes on what is read (test! "read's of a get-output-string return what was write'd before") ; setup (define aOutStringPort (open-output-string)) (write "foo" aOutStringPort) (write "bar" aOutStringPort) (define aInStringPort (open-input-string (get-output-string aOutStringPort))) (close-port aOutStringPort) (gc) ; aInStringPort is open having contents "\"foo\"\"bar\"" ; test the original strings can be read consecutively (assert `(string=? (read ,aInStringPort) "foo")) (assert `(string=? (read ,aInStringPort) "bar"))