zo-parse debugging and read in zo-exs

original commit: f27fe3d5c9
This commit is contained in:
Blake Johnson 2010-08-17 12:09:05 -06:00 committed by Jay McCarthy
parent 1b3843bd9c
commit 1d54bf17a5
2 changed files with 29 additions and 19 deletions

View File

@ -709,10 +709,11 @@
(let loop ([need-car 0] [proper #f])
(begin-with-definitions
(define ch (cp-getc cp))
(define-values (cpt-start cpt-tag) (let ([x (cpt-table-lookup ch)])
(unless x
(error 'read-compact "unknown code : ~a" ch))
(values (car x) (cdr x))))
(define-values (cpt-start cpt-tag)
(let ([x (cpt-table-lookup ch)])
(unless x
(error 'read-compact "unknown code : ~a" ch))
(values (car x) (cdr x))))
(define v
(case cpt-tag
[(delayed)
@ -1004,8 +1005,12 @@
(define cp (make-cport 0 shared-size port size* rst-start symtab so* (make-vector symtabsize #f) (make-hash) (make-hash)))
(for/list ([i (in-range 1 symtabsize)])
(for ([i (in-range 1 symtabsize)])
(read-sym cp i))
#;(for ([i (in-naturals)]
[v (in-vector (cport-symtab cp))])
(printf "~a: ~s~n~n" i (placeholder-get v)))
(set-cport-pos! cp shared-size)
(make-reader-graph
(read-marshalled 'compilation-top-type cp))))

View File

@ -3,12 +3,28 @@
compiler/zo-marshal
tests/eli-tester)
(define (read-compiled-bytes bs)
(parameterize ([read-accept-compiled #t])
(read (open-input-bytes bs))))
(define (roundtrip ct)
(define bs (zo-marshal ct))
(test bs
(zo-parse (open-input-bytes bs)) => ct))
(test #:failure-prefix (format "~S" ct)
(test bs
(zo-parse (open-input-bytes bs)) => ct
(read-compiled-bytes bs))))
(test
(roundtrip
(compilation-top 0
(prefix 0 empty empty)
(current-directory)))
(roundtrip
(compilation-top 0
(prefix 0 empty empty)
(list (current-directory))))
(local [(define (hash-test make-hash-placeholder)
(roundtrip
(compilation-top 0
@ -19,17 +35,6 @@
(make-reader-graph ht)))))]
(hash-test make-hash-placeholder)
(hash-test make-hasheq-placeholder)
(hash-test make-hasheqv-placeholder))
(roundtrip
(compilation-top 0
(prefix 0 empty empty)
(current-directory)))
(roundtrip
(compilation-top 0
(prefix 0 empty empty)
(list (current-directory)))))
(hash-test make-hasheqv-placeholder)))