Fix fasl read fasl string.

Add a new test for the failing case.
This commit is contained in:
Paulo Matos 2018-10-16 11:17:26 +02:00 committed by Matthew Flatt
parent a7ae05a414
commit 6d7ab42b56
2 changed files with 6 additions and 6 deletions

View File

@ -22,6 +22,7 @@
38000000000 38000000000
390000000000000 390000000000000
4000000000000000000 4000000000000000000
15511210043330985984000000
41.0 41.0
4.2 4.2
43/100 43/100
@ -32,7 +33,7 @@
;; The fasl format is meant to be forward-compatible: ;; The fasl format is meant to be forward-compatible:
(define immutables-regression-bstr (define immutables-regression-bstr
#"racket/fasl:\0\200\n\1\34#n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\200\16\bnineteen\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@\n\0\08B\34\6\16\6srcloc\23\1xopqr") #"racket/fasl:\0\200\"\1\34$n\4\3\6\ao\r2\16\5three\23\4four\25\4five\21\3six\"u \3vwx\36yz\35\2{|\16\afifteen%\1\2\200\16\bnineteen\16\asixteen\177%\0\2\202\23\ntwenty-one\204\23\ftwenty-three%\2\2\206\207\210\211#\16\ftwenty-eight\3\213\214\23\00231\b\340\b\200\344\f\b\201\320\204\0\0\b\2010W\5\0\b\201\200\3566\0\b\201\200\300\r\26\b\202\0\374\371\330\b\0\0\0\b\202\0`v\363\263b\1\0\b\202\0\0\220\235\316\332\2027\b\203\25cd4a0619fb0907bc00000\t\0\0\0\0\0\200D@\t\315\314\314\314\314\314\20@\v\231\322\f\232\322\f\t\0\0\0\0\0\200F@\t\0\0\0\0\0\0Y@\n\0\08B\34\6\16\6srcloc\23\1xopqr")
(for ([i (in-list immutables)]) (for ([i (in-list immutables)])
(test i fasl->s-exp (s-exp->fasl i))) (test i fasl->s-exp (s-exp->fasl i)))

View File

@ -328,7 +328,7 @@
;; Faster to work with a byte string: ;; Faster to work with a byte string:
(let ([bstr (read-bytes/exactly len init-i)]) (let ([bstr (read-bytes/exactly len init-i)])
(mcons bstr 0)))) (mcons bstr 0))))
(define (intern v) (if intern? (datum-intern-literal v) v)) (define (intern v) (if intern? (datum-intern-literal v) v))
(let loop () (let loop ()
(define type (read-byte/no-eof i)) (define type (read-byte/no-eof i))
@ -434,7 +434,7 @@
(+ (- type fasl-small-integer-start) fasl-lowest-small-integer)] (+ (- type fasl-small-integer-start) fasl-lowest-small-integer)]
[else [else
(read-error "unrecognized fasl tag" "tag" type)])]))) (read-error "unrecognized fasl tag" "tag" type)])])))
;; ---------------------------------------- ;; ----------------------------------------
;; Integer encoding: ;; Integer encoding:
@ -524,15 +524,14 @@
(integer-bytes->integer (read-bytes/exactly 8 i) #f #f)] (integer-bytes->integer (read-bytes/exactly 8 i) #f #f)]
[(eqv? b 131) [(eqv? b 131)
(define len (read-fasl-integer i)) (define len (read-fasl-integer i))
(define str (read-string len i)) (define str (read-fasl-string i len))
(unless (and (string? str) (= len (string-length str))) (unless (and (string? str) (= len (string-length str)))
(read-error "truncated stream at number")) (read-error "truncated stream at number"))
(string->number str 16)] (string->number str 16)]
[else [else
(read-error "internal error on integer mode")])) (read-error "internal error on integer mode")]))
(define (read-fasl-string i) (define (read-fasl-string i [len (read-fasl-integer i)])
(define len (read-fasl-integer i))
(define bstr (read-bytes/exactly len i)) (define bstr (read-bytes/exactly len i))
(bytes->string/utf-8 bstr)) (bytes->string/utf-8 bstr))