Merge branch 'strport' of github.com:mflatt/ChezScheme
original commit: 4ae71d2bac241154aad565a6006454fb394fc9fb
This commit is contained in:
commit
98381f0206
2
LOG
2
LOG
|
@ -1417,3 +1417,5 @@
|
|||
5_2.ms
|
||||
- added support for Microsoft Visual Studio 2019 on Windows
|
||||
BUILDING, c/vs.bat, wininstall/locate-vcredist.bat
|
||||
- fixed open-string-input-port on immutable strings
|
||||
cpnanopass.ss, io.ms, release_notes.stex
|
||||
|
|
59
mats/io.ms
59
mats/io.ms
|
@ -105,17 +105,21 @@
|
|||
(let ([c (get-u8 p)])
|
||||
(cons (integer->char c) (f)))))))))
|
||||
"a b c d e")
|
||||
(equal? (call-with-port
|
||||
(open-file-input-port "testfile.ss")
|
||||
(lambda (p)
|
||||
(list->string
|
||||
(let f ()
|
||||
(let ([c (lookahead-u8 p)])
|
||||
(if (eof-object? c)
|
||||
'()
|
||||
(let ([c (get-u8 p)])
|
||||
(cons (integer->char c) (f)))))))))
|
||||
"a b c d e")
|
||||
(andmap (lambda (p)
|
||||
(equal? (call-with-port
|
||||
p
|
||||
(lambda (p)
|
||||
(list->string
|
||||
(let f ()
|
||||
(let ([c (lookahead-u8 p)])
|
||||
(if (eof-object? c)
|
||||
'()
|
||||
(let ([c (get-u8 p)])
|
||||
(cons (integer->char c) (f)))))))))
|
||||
"a b c d e"))
|
||||
(list (open-file-input-port "testfile.ss")
|
||||
(open-bytevector-input-port '#vu8(97 32 98 32 99 32 100 32 101))
|
||||
(open-bytevector-input-port (bytevector->immutable-bytevector '#vu8(97 32 98 32 99 32 100 32 101)))))
|
||||
; test various errors related to input ports
|
||||
(begin (set! ip (open-file-input-port "testfile.ss"))
|
||||
(and (port? ip) (input-port? ip)))
|
||||
|
@ -1292,21 +1296,24 @@
|
|||
(define $bop (let-values ([(op get) (open-bytevector-output-port)]) (set-binary-port-output-buffer! op #vu8(1 2 3 4 5)) op))
|
||||
#t)
|
||||
; textual input
|
||||
(equal?
|
||||
(let ([ip (open-string-input-port "hello")])
|
||||
(let ([buffer0 (textual-port-input-buffer ip)]
|
||||
[index0 (textual-port-input-index ip)]
|
||||
[size0 (textual-port-input-size ip)]
|
||||
[count0 (textual-port-input-count ip)])
|
||||
(read-char ip)
|
||||
(list
|
||||
(list buffer0 index0 size0 count0)
|
||||
(list
|
||||
(textual-port-input-buffer ip)
|
||||
(textual-port-input-index ip)
|
||||
(textual-port-input-size ip)
|
||||
(textual-port-input-count ip)))))
|
||||
'(("hello" 0 5 5) ("hello" 1 5 4)))
|
||||
(andmap (lambda (str)
|
||||
(equal?
|
||||
(let ([ip (open-string-input-port str)])
|
||||
(let ([buffer0 (textual-port-input-buffer ip)]
|
||||
[index0 (textual-port-input-index ip)]
|
||||
[size0 (textual-port-input-size ip)]
|
||||
[count0 (textual-port-input-count ip)])
|
||||
(read-char ip)
|
||||
(list
|
||||
(list buffer0 index0 size0 count0)
|
||||
(list
|
||||
(textual-port-input-buffer ip)
|
||||
(textual-port-input-index ip)
|
||||
(textual-port-input-size ip)
|
||||
(textual-port-input-count ip)))))
|
||||
'(("hello" 0 5 5) ("hello" 1 5 4))))
|
||||
(list "hello"
|
||||
(string->immutable-string "hello")))
|
||||
(equal?
|
||||
(let ([ip (open-string-input-port "hello")])
|
||||
(let ([buffer0 (textual-port-input-buffer ip)]
|
||||
|
|
|
@ -1749,6 +1749,12 @@ in fasl files does not generally make sense.
|
|||
%-----------------------------------------------------------------------------
|
||||
\section{Bug Fixes}\label{section:bugfixes}
|
||||
|
||||
\subsection{String ports form immutable strings (9.5.4)}
|
||||
|
||||
A bug that miscalculated the buffer size for
|
||||
\scheme{open-string-input-port} given an immutable string has been
|
||||
fixed.
|
||||
|
||||
\subsection{Multiplying $-2^{30}$ with itself on 64-bit platforms (9.5.3)}
|
||||
|
||||
A bug that produced the wrong sign when multiplying $-2^{30}$ with
|
||||
|
|
|
@ -8058,9 +8058,9 @@
|
|||
(build-dirty-store e-p ibuffer-disp e-b))
|
||||
,(bind #t ([e-length (if (eq? port-type 'textual)
|
||||
(translate
|
||||
(%inline logxor
|
||||
(%inline logand
|
||||
,(%mref ,e-b ,(constant string-type-disp))
|
||||
,(%constant type-string))
|
||||
(immediate ,(fx- (expt 2 (constant string-length-offset)))))
|
||||
(constant string-length-offset)
|
||||
(constant string-char-offset))
|
||||
(%inline srl
|
||||
|
|
Loading…
Reference in New Issue
Block a user