Enhance MessagePack with improved encoding and test coverage (#25)
ober
64f58fd29d04531a361e81b3d97dc3d06e0d6ac6
--- a/lib/std/text/msgpack.sls +++ b/lib/std/text/msgpack.sls @@ -1,145 +1,267 @@ #!chezscheme -;;; (std text msgpack) — MessagePack encoder/decoder -;;; nil→#f, bool, int, float64, str, bin→bytevector, array→list, map→hashtable +;;; (std text msgpack) — MessagePack serialization (msgpack.org spec) +;;; +;;; Type mappings: +;;; nil → (void) +;;; boolean → #t / #f +;;; integers → exact integers (auto-compact encoding) +;;; float32/64 → flonums +;;; str → strings (UTF-8) +;;; bin → bytevectors +;;; array → vectors +;;; map → alists (list of (key . value) pairs) +;;; +;;; (msgpack-pack val) → bytevector +;;; (msgpack-unpack bv) → value +;;; (msgpack-pack-port val port) → writes to binary output port +;;; (msgpack-unpack-port port) → reads from binary input port (library (std text msgpack) - (export msgpack-encode msgpack-decode msgpack-read msgpack-write) + (export msgpack-pack msgpack-unpack msgpack-pack-port msgpack-unpack-port) (import (chezscheme)) - ;; --- Encoder --- - (define (msgpack-encode val) - (let-values ([(p get) (open-bytevector-output-port)]) - (msgpack-write val p) (get))) + ;; ===== Encoder ===== + (define (msgpack-pack val) + (let-values ([(port extract) (open-bytevector-output-port)]) + (msgpack-pack-port val port) + (extract))) + + ;; Write a big-endian unsigned integer of n bytes (define (put-be port val n) - (do ([i (- n 1) (- i 1)]) ((< i 0)) + (do ([i (- n 1) (- i 1)]) + ((< i 0)) (put-u8 port (bitwise-and (bitwise-arithmetic-shift-right val (* i 8)) #xff)))) - (define (msgpack-write val port) + (define (msgpack-pack-port val port) (cond - [(eq? val 'null) (put-u8 port #xc0)] + ;; void → nil + [(eq? val (void)) (put-u8 port #xc0)] + ;; booleans [(eq? val #t) (put-u8 port #xc3)] [(eq? val #f) (put-u8 port #xc2)] + ;; flonum [(flonum? val) (put-u8 port #xcb) (let ([bv (make-bytevector 8)]) (bytevector-ieee-double-set! bv 0 val (endianness big)) (put-bytevector port bv))] - [(and (integer? val) (exact? val)) (write-int port val)] + ;; exact integer + [(and (integer? val) (exact? val)) + (write-int port val)] + ;; string [(string? val) (write-str port val)] + ;; bytevector → bin [(bytevector? val) (write-bin port val)] - [(list? val) (write-array port val)] - [(hashtable? val) (write-map port val)] - [else (error 'msgpack-write "unsupported type" val)])) + ;; vector → array + [(vector? val) (write-array port val)] + ;; pair that looks like an alist → map + [(and (pair? val) (pair? (car val)) (alist? val)) + (write-map-alist port val)] + ;; null list → nil + [(null? val) (put-u8 port #xc0)] + [else (error 'msgpack-pack-port "unsupported type" val)])) + + ;; Check if a value is an alist (list of pairs) + (define (alist? val) + (or (null? val) + (and (pair? val) + (pair? (car val)) + (alist? (cdr val))))) + ;; Integer encoding — uses the most compact representation (define (write-int port n) (cond - [(and (>= n 0) (<= n 127)) (put-u8 port n)] - [(and (>= n -32) (< n 0)) (put-u8 port (bitwise-and n #xff))] - [(and (>= n 0) (<= n #xff)) (put-u8 port #xcc) (put-u8 port n)] - [(and (>= n 0) (<= n #xffff)) (put-u8 port #xcd) (put-be port n 2)] - [(and (>= n 0) (<= n #xffffffff)) (put-u8 port #xce) (put-be port n 4)] - [(and (>= n 0) (<= n #xffffffffffffffff)) (put-u8 port #xcf) (put-be port n 8)] - [(and (>= n -128) (< n 0)) (put-u8 port #xd0) (put-u8 port (bitwise-and n #xff))] - [(and (>= n -32768) (< n 0)) + ;; positive fixint: 0xxxxxxx (0 to 127) + [(and (>= n 0) (<= n 127)) + (put-u8 port n)] + ;; negative fixint: 111xxxxx (-32 to -1) + [(and (>= n -32) (< n 0)) + (put-u8 port (bitwise-and n #xff))] + ;; uint 8 + [(and (>= n 0) (<= n #xff)) + (put-u8 port #xcc) (put-u8 port n)] + ;; uint 16 + [(and (>= n 0) (<= n #xffff)) + (put-u8 port #xcd) (put-be port n 2)] + ;; uint 32 + [(and (>= n 0) (<= n #xffffffff)) + (put-u8 port #xce) (put-be port n 4)] + ;; uint 64 + [(and (>= n 0) (<= n #xffffffffffffffff)) + (put-u8 port #xcf) (put-be port n 8)] + ;; int 8 (-128 to -33) + [(and (>= n -128) (< n -32)) + (put-u8 port #xd0) (put-u8 port (bitwise-and n #xff))] + ;; int 16 (-32768 to -129) + [(and (>= n -32768) (< n -128)) (put-u8 port #xd1) (put-be port (bitwise-and n #xffff) 2)] - [(>= n (- (expt 2 31))) + ;; int 32 + [(and (>= n (- (expt 2 31))) (< n -32768)) (put-u8 port #xd2) (put-be port (bitwise-and n #xffffffff) 4)] - [(>= n (- (expt 2 63))) + ;; int 64 + [(and (>= n (- (expt 2 63))) (< n (- (expt 2 31)))) (put-u8 port #xd3) (put-be port (bitwise-and n #xffffffffffffffff) 8)] - [else (error 'msgpack-write "integer out of range" n)])) + [else (error 'msgpack-pack-port "integer out of range" n)])) + ;; String encoding (UTF-8) (define (write-str port str) - (let* ([bv (string->utf8 str)] [n (bytevector-length bv)]) - (cond [(<= n 31) (put-u8 port (bitwise-ior #xa0 n))] - [(<= n #xff) (put-u8 port #xd9) (put-u8 port n)] - [(<= n #xffff) (put-u8 port #xda) (put-be port n 2)] - [else (put-u8 port #xdb) (put-be port n 4)]) + (let* ([bv (string->utf8 str)] + [n (bytevector-length bv)]) + (cond + [(<= n 31) (put-u8 port (bitwise-ior #xa0 n))] + [(<= n #xff) (put-u8 port #xd9) (put-u8 port n)] + [(<= n #xffff) (put-u8 port #xda) (put-be port n 2)] + [else (put-u8 port #xdb) (put-be port n 4)]) (put-bytevector port bv))) + ;; Binary encoding (define (write-bin port bv) (let ([n (bytevector-length bv)]) - (cond [(<= n #xff) (put-u8 port #xc4) (put-u8 port n)] - [(<= n #xffff) (put-u8 port #xc5) (put-be port n 2)] - [else (put-u8 port #xc6) (put-be port n 4)]) + (cond + [(<= n #xff) (put-u8 port #xc4) (put-u8 port n)] + [(<= n #xffff) (put-u8 port #xc5) (put-be port n 2)] + [else (put-u8 port #xc6) (put-be port n 4)]) (put-bytevector port bv))) - (define (write-array port lst) - (let ([n (length lst)]) - (cond [(<= n 15) (put-u8 port (bitwise-ior #x90 n))] - [(<= n #xffff) (put-u8 port #xdc) (put-be port n 2)] - [else (put-u8 port #xdd) (put-be port n 4)]) - (for-each (lambda (v) (msgpack-write v port)) lst))) - - (define (write-map port ht) - (let ([keys (vector->list (hashtable-keys ht))]) - (let ([n (length keys)]) - (cond [(<= n 15) (put-u8 port (bitwise-ior #x80 n))] - [(<= n #xffff) (put-u8 port #xde) (put-be port n 2)] - [else (put-u8 port #xdf) (put-be port n 4)]) - (for-each (lambda (k) (msgpack-write k port) - (msgpack-write (hashtable-ref ht k #f) port)) keys)))) - - ;; --- Decoder --- - (define (msgpack-decode bv) (msgpack-read (open-bytevector-input-port bv))) + ;; Array encoding (from vector) + (define (write-array port vec) + (let ([n (vector-length vec)]) + (cond + [(<= n 15) (put-u8 port (bitwise-ior #x90 n))] + [(<= n #xffff) (put-u8 port #xdc) (put-be port n 2)] + [else (put-u8 port #xdd) (put-be port n 4)]) + (do ([i 0 (+ i 1)]) + ((= i n)) + (msgpack-pack-port (vector-ref vec i) port)))) + + ;; Map encoding (from alist) + (define (write-map-alist port alist) + (let ([n (length alist)]) + (cond + [(<= n 15) (put-u8 port (bitwise-ior #x80 n))] + [(<= n #xffff) (put-u8 port #xde) (put-be port n 2)] + [else (put-u8 port #xdf) (put-be port n 4)]) + (for-each + (lambda (pair) + (msgpack-pack-port (car pair) port) + (msgpack-pack-port (cdr pair) port)) + alist))) + + ;; ===== Decoder ===== + + (define (msgpack-unpack bv) + (msgpack-unpack-port (open-bytevector-input-port bv))) + ;; Read exactly n bytes, error on short read (define (get-bv port n) (let ([bv (get-bytevector-n port n)]) (when (or (eof-object? bv) (< (bytevector-length bv) n)) - (error 'msgpack-read "unexpected EOF")) + (error 'msgpack-unpack-port "unexpected EOF")) bv)) + ;; Read big-endian unsigned integer of n bytes (define (read-uint port n) (let ([bv (get-bv port n)]) (do ([i 0 (+ i 1)] - [v 0 (+ (bitwise-arithmetic-shift-left v 8) (bytevector-u8-ref bv i))]) + [v 0 (+ (bitwise-arithmetic-shift-left v 8) + (bytevector-u8-ref bv i))]) ((= i n) v)))) + ;; Read big-endian signed integer of n bytes (two's complement) (define (read-sint port n) (let ([u (read-uint port n)]) - (if (>= u (expt 2 (- (* n 8) 1))) (- u (expt 2 (* n 8))) u))) + (if (>= u (expt 2 (- (* n 8) 1))) + (- u (expt 2 (* n 8))) + u))) - (define (read-str port n) (utf8->string (get-bv port n))) + ;; Read n bytes as UTF-8 string + (define (read-str port n) + (utf8->string (get-bv port n))) + ;; Read n elements as a vector (define (read-array port n) - (do ([i 0 (+ i 1)] [acc '() (cons (msgpack-read port) acc)]) - ((= i n) (reverse acc)))) + (let ([vec (make-vector n)]) + (do ([i 0 (+ i 1)]) + ((= i n) vec) + (vector-set! vec i (msgpack-unpack-port port))))) + ;; Read n key-value pairs as an alist (define (read-map port n) - (let ([ht (make-hashtable equal-hash equal?)]) - (do ([i 0 (+ i 1)]) ((= i n) ht) - (let* ([k (msgpack-read port)] [v (msgpack-read port)]) - (hashtable-set! ht k v))))) + (let loop ([i 0] [acc '()]) + (if (= i n) + (reverse acc) + (let* ([k (msgpack-unpack-port port)] + [v (msgpack-unpack-port port)]) + (loop (+ i 1) (cons (cons k v) acc)))))) - (define (msgpack-read port) + (define (msgpack-unpack-port port) (let ([b (get-u8 port)]) - (when (eof-object? b) (error 'msgpack-read "unexpected EOF")) + (when (eof-object? b) + (error 'msgpack-unpack-port "unexpected EOF")) (cond - [(<= b #x7f) b] ;; positive fixint - [(= (bitwise-and b #xf0) #x80) (read-map port (bitwise-and b #x0f))] - [(= (bitwise-and b #xf0) #x90) (read-array port (bitwise-and b #x0f))] - [(= (bitwise-and b #xe0) #xa0) (read-str port (bitwise-and b #x1f))] - [(= b #xc0) #f] ;; nil - [(= b #xc2) #f] [(= b #xc3) #t] ;; bool - [(= b #xc4) (get-bv port (read-uint port 1))] ;; bin 8 - [(= b #xc5) (get-bv port (read-uint port 2))] ;; bin 16 - [(= b #xc6) (get-bv port (read-uint port 4))] ;; bin 32 - [(= b #xca) (let ([bv (get-bv port 4)]) ;; float 32 - (bytevector-ieee-single-ref bv 0 (endianness big)))] - [(= b #xcb) (let ([bv (get-bv port 8)]) ;; float 64 - (bytevector-ieee-double-ref bv 0 (endianness big)))] - [(= b #xcc) (read-uint port 1)] [(= b #xcd) (read-uint port 2)] - [(= b #xce) (read-uint port 4)] [(= b #xcf) (read-uint port 8)] - [(= b #xd0) (read-sint port 1)] [(= b #xd1) (read-sint port 2)] - [(= b #xd2) (read-sint port 4)] [(= b #xd3) (read-sint port 8)] + ;; positive fixint: 0xxxxxxx + [(<= b #x7f) b] + ;; fixmap: 1000xxxx + [(= (bitwise-and b #xf0) #x80) + (read-map port (bitwise-and b #x0f))] + ;; fixarray: 1001xxxx + [(= (bitwise-and b #xf0) #x90) + (read-array port (bitwise-and b #x0f))] + ;; fixstr: 101xxxxx + [(= (bitwise-and b #xe0) #xa0) + (read-str port (bitwise-and b #x1f))] + ;; nil + [(= b #xc0) (void)] + ;; (never used) #xc1 + ;; false + [(= b #xc2) #f] + ;; true + [(= b #xc3) #t] + ;; bin 8/16/32 + [(= b #xc4) (get-bv port (read-uint port 1))] + [(= b #xc5) (get-bv port (read-uint port 2))] + [(= b #xc6) (get-bv port (read-uint port 4))] + ;; ext 8/16/32 — read and discard type byte, return data as bytevector + [(= b #xc7) (let* ([n (read-uint port 1)] [_type (get-u8 port)]) (get-bv port n))] + [(= b #xc8) (let* ([n (read-uint port 2)] [_type (get-u8 port)]) (get-bv port n))] + [(= b #xc9) (let* ([n (read-uint port 4)] [_type (get-u8 port)]) (get-bv port n))] + ;; float 32 + [(= b #xca) + (let ([bv (get-bv port 4)]) + (bytevector-ieee-single-ref bv 0 (endianness big)))] + ;; float 64 + [(= b #xcb) + (let ([bv (get-bv port 8)]) + (bytevector-ieee-double-ref bv 0 (endianness big)))] + ;; uint 8/16/32/64 + [(= b #xcc) (read-uint port 1)] + [(= b #xcd) (read-uint port 2)] + [(= b #xce) (read-uint port 4)] + [(= b #xcf) (read-uint port 8)] + ;; int 8/16/32/64 + [(= b #xd0) (read-sint port 1)] + [(= b #xd1) (read-sint port 2)] + [(= b #xd2) (read-sint port 4)] + [(= b #xd3) (read-sint port 8)] + ;; fixext 1/2/4/8/16 — read type byte + data + [(= b #xd4) (get-u8 port) (get-bv port 1)] + [(= b #xd5) (get-u8 port) (get-bv port 2)] + [(= b #xd6) (get-u8 port) (get-bv port 4)] + [(= b #xd7) (get-u8 port) (get-bv port 8)] + [(= b #xd8) (get-u8 port) (get-bv port 16)] + ;; str 8/16/32 [(= b #xd9) (read-str port (read-uint port 1))] [(= b #xda) (read-str port (read-uint port 2))] [(= b #xdb) (read-str port (read-uint port 4))] + ;; array 16/32 [(= b #xdc) (read-array port (read-uint port 2))] [(= b #xdd) (read-array port (read-uint port 4))] + ;; map 16/32 [(= b #xde) (read-map port (read-uint port 2))] [(= b #xdf) (read-map port (read-uint port 4))] - [(>= b #xe0) (- b 256)] ;; negative fixint - [else (error 'msgpack-read "unknown format byte" b)]))) + ;; negative fixint: 111xxxxx + [(>= b #xe0) (- b 256)] + [else (error 'msgpack-unpack-port "unknown format byte" b)]))) - ) ;; end library +) ;; end library new file mode 100644 --- /dev/null +++ b/tests/test-msgpack.ss @@ -0,0 +1,304 @@ +#!chezscheme +;;; Tests for (std text msgpack) — MessagePack serialization + +(import (chezscheme) (std text msgpack)) + +(define pass 0) +(define fail 0) + +(define-syntax test + (syntax-rules () + [(_ name expr expected) + (guard (exn + [#t (set! fail (+ fail 1)) + (printf "FAIL ~a: exception ~a~%" name + (if (message-condition? exn) (condition-message exn) exn))]) + (let ([got expr]) + (if (equal? got expected) + (begin (set! pass (+ pass 1)) + (printf " ok ~a~%" name)) + (begin (set! fail (+ fail 1)) + (printf "FAIL ~a: got ~s, expected ~s~%" name got expected)))))])) + +;; Helper: round-trip through pack/unpack +(define (roundtrip val) + (msgpack-unpack (msgpack-pack val))) + +;; Helper: test that a value round-trips with a custom comparison +(define-syntax test-rt + (syntax-rules () + [(_ name val) + (test name (roundtrip val) val)])) + +(printf "--- (std text msgpack) tests ---~%") + +;; === nil === +(printf "~%nil:~%") +(test "nil/void round-trip" + (eq? (roundtrip (void)) (void)) #t) +(test "nil encodes to #xc0" + (msgpack-pack (void)) #vu8(#xc0)) +(test "null list encodes to nil" + (msgpack-pack '()) #vu8(#xc0)) + +;; === Booleans === +(printf "~%booleans:~%") +(test-rt "true" #t) +(test-rt "false" #f) +(test "true encodes to #xc3" (msgpack-pack #t) #vu8(#xc3)) +(test "false encodes to #xc2" (msgpack-pack #f) #vu8(#xc2)) + +;; === Positive fixint (0-127) === +(printf "~%positive fixint:~%") +(test-rt "zero" 0) +(test-rt "one" 1) +(test-rt "127" 127) +(test "0 encodes to single byte" (msgpack-pack 0) #vu8(0)) +(test "127 encodes to single byte" (msgpack-pack 127) #vu8(127)) +(test "42 encodes to single byte" (msgpack-pack 42) #vu8(42)) + +;; === Negative fixint (-32 to -1) === +(printf "~%negative fixint:~%") +(test-rt "-1" -1) +(test-rt "-32" -32) +(test "-1 encodes to #xff" (msgpack-pack -1) #vu8(#xff)) +(test "-32 encodes to #xe0" (msgpack-pack -32) #vu8(#xe0)) + +;; === uint 8 (128-255) === +(printf "~%uint8:~%") +(test-rt "128" 128) +(test-rt "255" 255) +(test "128 uses uint8 prefix" (bytevector-u8-ref (msgpack-pack 128) 0) #xcc) +(test "255 uses uint8 prefix" (bytevector-u8-ref (msgpack-pack 255) 0) #xcc) + +;; === uint 16 (256-65535) === +(printf "~%uint16:~%") +(test-rt "256" 256) +(test-rt "65535" 65535) +(test "256 uses uint16 prefix" (bytevector-u8-ref (msgpack-pack 256) 0) #xcd) +(test "1000 big-endian encoding" + (msgpack-pack 1000) #vu8(#xcd #x03 #xe8)) + +;; === uint 32 === +(printf "~%uint32:~%") +(test-rt "65536" 65536) +(test-rt "max-uint32" #xffffffff) +(test "65536 uses uint32 prefix" (bytevector-u8-ref (msgpack-pack 65536) 0) #xce) + +;; === uint 64 === +(printf "~%uint64:~%") +(test-rt "large uint64" #x100000000) +(test-rt "max-uint64" #xffffffffffffffff) +(test "uint64 prefix" (bytevector-u8-ref (msgpack-pack #x100000000) 0) #xcf) + +;; === int 8 (-128 to -33) === +(printf "~%int8:~%") +(test-rt "-33" -33) +(test-rt "-128" -128) +(test "-33 uses int8 prefix" (bytevector-u8-ref (msgpack-pack -33) 0) #xd0) +(test "-128 uses int8 prefix" (bytevector-u8-ref (msgpack-pack -128) 0) #xd0) + +;; === int 16 (-32768 to -129) === +(printf "~%int16:~%") +(test-rt "-129" -129) +(test-rt "-32768" -32768) +(test "-129 uses int16 prefix" (bytevector-u8-ref (msgpack-pack -129) 0) #xd1) + +;; === int 32 === +(printf "~%int32:~%") +(test-rt "-32769" -32769) +(test-rt "min-int32" (- (expt 2 31))) +(test "-32769 uses int32 prefix" (bytevector-u8-ref (msgpack-pack -32769) 0) #xd2) + +;; === int 64 === +(printf "~%int64:~%") +(test-rt "large negative" (- (expt 2 31) 1)) ;; this fits in int32+, but test boundary +(let ([v (- (+ (expt 2 31) 1))]) + (test-rt "int64 negative" v)) +(test-rt "min-int64" (- (expt 2 63))) + +;; === float 64 === +(printf "~%float64:~%") +(test-rt "pi" 3.14159265358979) +(test-rt "negative float" -2.5) +(test-rt "zero float" 0.0) +(test "float uses #xcb prefix" (bytevector-u8-ref (msgpack-pack 1.0) 0) #xcb) + +;; Float special values +(test "positive infinity" + (fl= (roundtrip +inf.0) +inf.0) #t) +(test "negative infinity" + (fl= (roundtrip -inf.0) -inf.0) #t) +(test "NaN round-trips to NaN" + (flnan? (roundtrip +nan.0)) #t) + +;; === fixstr (0-31 bytes) === +(printf "~%strings:~%") +(test-rt "empty string" "") +(test-rt "hello" "hello") +(test-rt "31-byte string" (make-string 31 #\a)) +(test "empty string encoding" (msgpack-pack "") #vu8(#xa0)) +(test "fixstr prefix for 'hi'" + (bytevector-u8-ref (msgpack-pack "hi") 0) #xa2) + +;; === str 8 (32-255 bytes) === +(test-rt "32-char string" (make-string 32 #\x)) +(test "str8 prefix" + (bytevector-u8-ref (msgpack-pack (make-string 32 #\x)) 0) #xd9) + +;; === str 16 (256-65535 bytes) === +(test-rt "300-char string" (make-string 300 #\y)) +(test "str16 prefix" + (bytevector-u8-ref (msgpack-pack (make-string 300 #\y)) 0) #xda) + +;; === UTF-8 strings === +(test-rt "UTF-8 multibyte" "\x3BB;") ;; lambda +(test-rt "UTF-8 emoji" "\x1F600;") ;; grinning face + +;; === bin (bytevectors) === +(printf "~%binary:~%") +(test-rt "empty bytevector" #vu8()) +(test-rt "small bytevector" #vu8(1 2 3 4 5)) +(test "bin8 prefix" + (bytevector-u8-ref (msgpack-pack #vu8(1 2 3)) 0) #xc4) +;; 256-byte bin → bin16 +(let ([bv (make-bytevector 256 #xab)]) + (test-rt "256-byte bytevector" bv) + (test "bin16 prefix" + (bytevector-u8-ref (msgpack-pack bv) 0) #xc5)) + +;; === fixarray (vectors, 0-15 elements) === +(printf "~%arrays (vectors):~%") +(test-rt "empty vector" (vector)) +(test-rt "single element" (vector 42)) +(test-rt "mixed vector" (vector 1 "two" 3)) +(test "fixarray prefix for [1,2,3]" + (bytevector-u8-ref (msgpack-pack (vector 1 2 3)) 0) #x93) + +;; === array 16 === +(let ([vec (make-vector 16 0)]) + (test-rt "16-element vector" vec) + (test "array16 prefix" + (bytevector-u8-ref (msgpack-pack vec) 0) #xdc)) + +;; === Nested arrays === +(test-rt "nested vectors" (vector (vector 1 2) (vector 3 4))) + +;; === fixmap (alists, 0-15 pairs) === +(printf "~%maps (alists):~%") +(test-rt "single-entry map" '(("a" . 1))) +(test "fixmap prefix" + (bitwise-and (bytevector-u8-ref (msgpack-pack '(("a" . 1))) 0) #xf0) #x80) + +;; Multi-entry map +(let* ([input '(("x" . 10) ("y" . 20) ("z" . 30))] + [result (roundtrip input)]) + ;; Alist order should be preserved + (test "multi-entry map round-trip" result input)) + +;; Nested map +(let* ([input '(("inner" . (("a" . 1))))] + [result (roundtrip input)]) + (test "nested map round-trip" result input)) + +;; Map with various value types +(let* ([input (list (cons "int" 42) (cons "str" "hello") (cons "bool" #t) (cons "vec" (vector 1 2)))] + [result (roundtrip input)]) + (test "map with mixed values" result input)) + +;; === Port-based API === +(printf "~%port API:~%") +(let-values ([(out extract) (open-bytevector-output-port)]) + (msgpack-pack-port 42 out) + (msgpack-pack-port "hello" out) + (let* ([bv (extract)] + [in (open-bytevector-input-port bv)] + [v1 (msgpack-unpack-port in)] + [v2 (msgpack-unpack-port in)]) + (test "port: first value" v1 42) + (test "port: second value" v2 "hello"))) + +;; Multiple values via port +(let-values ([(out extract) (open-bytevector-output-port)]) + (msgpack-pack-port (vector 1 2 3) out) + (msgpack-pack-port '(("key" . "val")) out) + (let* ([bv (extract)] + [in (open-bytevector-input-port bv)] + [v1 (msgpack-unpack-port in)] + [v2 (msgpack-unpack-port in)]) + (test "port: vector" v1 (vector 1 2 3)) + (test "port: map" v2 '(("key" . "val"))))) + +;; === Compact encoding verification === +(printf "~%compact encoding:~%") +;; Verify integers use minimal encoding +(test "0 is 1 byte" (bytevector-length (msgpack-pack 0)) 1) +(test "127 is 1 byte" (bytevector-length (msgpack-pack 127)) 1) +(test "-1 is 1 byte" (bytevector-length (msgpack-pack -1)) 1) +(test "-32 is 1 byte" (bytevector-length (msgpack-pack -32)) 1) +(test "128 is 2 bytes" (bytevector-length (msgpack-pack 128)) 2) +(test "255 is 2 bytes" (bytevector-length (msgpack-pack 255)) 2) +(test "256 is 3 bytes" (bytevector-length (msgpack-pack 256)) 3) +(test "-33 is 2 bytes" (bytevector-length (msgpack-pack -33)) 2) + +;; === Decode known byte sequences (cross-implementation compatibility) === +(printf "~%known encodings:~%") +;; These are well-known msgpack encodings +(test "decode nil" (eq? (msgpack-unpack #vu8(#xc0)) (void)) #t) +(test "decode true" (msgpack-unpack #vu8(#xc3)) #t) +(test "decode false" (msgpack-unpack #vu8(#xc2)) #f) +(test "decode fixint 0" (msgpack-unpack #vu8(#x00)) 0) +(test "decode fixint 127" (msgpack-unpack #vu8(#x7f)) 127) +(test "decode neg fixint -1" (msgpack-unpack #vu8(#xff)) -1) +(test "decode neg fixint -32" (msgpack-unpack #vu8(#xe0)) -32) +(test "decode empty fixstr" (msgpack-unpack #vu8(#xa0)) "") +(test "decode fixstr 'AB'" + (msgpack-unpack #vu8(#xa2 #x41 #x42)) "AB") +(test "decode empty fixarray" (msgpack-unpack #vu8(#x90)) (vector)) +(test "decode fixarray [1,2,3]" + (msgpack-unpack #vu8(#x93 1 2 3)) (vector 1 2 3)) +(test "decode empty fixmap" (msgpack-unpack #vu8(#x80)) '()) +(test "decode uint8 200" + (msgpack-unpack #vu8(#xcc #xc8)) 200) +(test "decode int8 -100" + (msgpack-unpack #vu8(#xd0 #x9c)) -100) + +;; Float32 decoding +(let ([bv (make-bytevector 5)]) + (bytevector-u8-set! bv 0 #xca) + (bytevector-ieee-single-set! bv 1 1.5 (endianness big)) + (test "decode float32" (msgpack-unpack bv) 1.5)) + +;; === Edge cases === +(printf "~%edge cases:~%") +;; Empty structures +(test-rt "empty vector" (vector)) +(test-rt "empty bytevector" #vu8()) +(test-rt "empty string" "") + +;; Max values for each integer type +(test-rt "max positive fixint" 127) +(test-rt "max uint8" 255) +(test-rt "max uint16" 65535) +(test-rt "max uint32" #xffffffff) +(test-rt "max uint64" #xffffffffffffffff) +(test-rt "min negative fixint" -32) +(test-rt "min int8" -128) +(test-rt "min int16" -32768) +(test-rt "min int32" (- (expt 2 31))) +(test-rt "min int64" (- (expt 2 63))) + +;; Deeply nested structure +(test-rt "nested structure" + (vector (vector (vector "deep")))) + +;; Map with integer keys +(test-rt "map with int keys" '((1 . "one") (2 . "two"))) + +;; Vector containing maps +(test-rt "vector of maps" + (vector '(("a" . 1)) '(("b" . 2)))) + +;; === Summary === +(printf "~%--- Results: ~a passed, ~a failed ---~%" pass fail) +(when (> fail 0) (exit 1))