suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fasl: make sure every write-bytes know where to write (#2373)

Browse Source 
adding tests that fail without this fix
This commit is contained in:
Caner Derici 2018-11-15 16:53:53 -05:00 committed by Sam Tobin-Hochstadt
parent 06101ffb89
commit 331b383103
2 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
pkgs/racket-test-core/tests/racket/fasl.rktl
View File

@ -73,6 +73,13 @@
(test #f eq? #rx#"hello" (fasl->s-exp (s-exp->fasl #rx#"hello") #:datum-intern? #f))
(test #f eq? #px#"hello" (fasl->s-exp (s-exp->fasl #px#"hello") #:datum-intern? #f))
(let* ([r1 #rx"[/\u5C][. ]+ap"]
[r2 #px"[/\u5C][. ]+ap"]
[r3 #px#"[\\][. ]+ap*"])
(test #t equal? r1 (fasl->s-exp (s-exp->fasl r1) #:datum-intern? #f))
(test #t equal? r2 (fasl->s-exp (s-exp->fasl r2) #:datum-intern? #f))
(test #t equal? r3 (fasl->s-exp (s-exp->fasl r3) #:datum-intern? #f)))
(define (check-hash make-hash hash)
(let ([mut (make-hash)]
[immut (hash 'one 2 'three 4)])

17
racket/collects/racket/fasl.rkt
View File

@ -1,13 +1,24 @@
#lang racket/base
(require (for-syntax racket/base)
"private/truncate-path.rkt"
"private/relative-path.rkt")
"private/relative-path.rkt"
(rename-in racket/base
[write-byte r:write-byte]
[write-bytes r:write-bytes]))
(provide s-exp->fasl
fasl->s-exp)
;; ----------------------------------------
;; These wrappers are to make it harder to misuse write-byte(s)
;; (e.g. calling without the port)
(define (write-byte byte out)
(r:write-byte byte out))
(define (write-bytes bstr out [start-pos 0] [end-pos (bytes-length bstr)])
(r:write-bytes bstr out start-pos end-pos))
(define-for-syntax constants (make-hasheq))
(define-syntax (define-constants stx)
@ -288,10 +299,10 @@
(write-fasl-integer (hash-count v) o)
(hash-for-each v (lambda (k v) (loop k) (loop v)) #t)]
[(regexp? v)
(write-byte (if (pregexp? v) fasl-pregexp-type fasl-regexp-type))
(write-byte (if (pregexp? v) fasl-pregexp-type fasl-regexp-type) o)
(write-fasl-string (object-name v) o)]
[(byte-regexp? v)
(write-byte (if (byte-pregexp? v) fasl-byte-pregexp-type fasl-byte-regexp-type))
(write-byte (if (byte-pregexp? v) fasl-byte-pregexp-type fasl-byte-regexp-type) o)
(write-fasl-bytes (object-name v) o)]
[else
(raise-arguments-error 'fasl-write