diff options
Diffstat (limited to 'test/lisp/emacs-lisp/bindat-tests.el')
| -rw-r--r-- | test/lisp/emacs-lisp/bindat-tests.el | 133 |
1 files changed, 87 insertions, 46 deletions
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el index 72883fc2ec7..911a5f0c7b1 100644 --- a/test/lisp/emacs-lisp/bindat-tests.el +++ b/test/lisp/emacs-lisp/bindat-tests.el @@ -1,4 +1,4 @@ -;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t; coding: utf-8; -*- +;;; bindat-tests.el --- tests for bindat.el -*- lexical-binding: t -*- ;; Copyright (C) 2019-2021 Free Software Foundation, Inc. @@ -23,47 +23,50 @@ (require 'bindat) (require 'cl-lib) -(defvar header-bindat-spec - (bindat-spec +(bindat-defmacro ip () "An IPv4 address" '(vec 4 byte)) + +(defconst header-bindat-spec + (bindat-type (dest-ip ip) (src-ip ip) - (dest-port u16) - (src-port u16))) + (dest-port uint 16) + (src-port uint 16))) -(defvar data-bindat-spec - (bindat-spec +(defconst data-bindat-spec + (bindat-type (type u8) (opcode u8) - (length u16r) ;; little endian order + (length uintr 16) ;; little endian order (id strz 8) - (data vec (length)) - (align 4))) + (data vec length) + (_ align 4))) + -(defvar packet-bindat-spec - (bindat-spec - (header struct header-bindat-spec) +(defconst packet-bindat-spec + (bindat-type + (header type header-bindat-spec) (items u8) - (fill 3) - (item repeat (items) - (struct data-bindat-spec)))) + (_ fill 3) + (item repeat items + (_ type data-bindat-spec)))) -(defvar struct-bindat +(defconst struct-bindat '((header (dest-ip . [192 168 1 100]) (src-ip . [192 168 1 101]) (dest-port . 284) (src-port . 5408)) (items . 2) - (item ((data . [1 2 3 4 5]) - (id . "ABCDEF") - (length . 5) + (item ((type . 2) (opcode . 3) - (type . 2)) - ((data . [6 7 8 9 10 11 12]) - (id . "BCDEFG") - (length . 7) + (length . 5) + (id . "ABCDEF") + (data . [1 2 3 4 5])) + ((type . 1) (opcode . 4) - (type . 1))))) + (length . 7) + (id . "BCDEFG") + (data . [6 7 8 9 10 11 12]))))) (ert-deftest bindat-test-pack () (should (equal @@ -77,27 +80,7 @@ (should (equal (bindat-unpack packet-bindat-spec (bindat-pack packet-bindat-spec struct-bindat)) - '((item - ((data . - [1 2 3 4 5]) - (id . "ABCDEF") - (length . 5) - (opcode . 3) - (type . 2)) - ((data . - [6 7 8 9 10 11 12]) - (id . "BCDEFG") - (length . 7) - (opcode . 4) - (type . 1))) - (items . 2) - (header - (src-port . 5408) - (dest-port . 284) - (src-ip . - [192 168 1 101]) - (dest-ip . - [192 168 1 100])))))) + struct-bindat))) (ert-deftest bindat-test-pack/multibyte-string-fails () (should-error (bindat-pack nil nil "รถ"))) @@ -121,4 +104,62 @@ (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1")) (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1"))) +(defconst bindat-test--int-websocket-type + (bindat-type + :pack-var value + (n1 u8 + :pack-val (if (< value 126) value (if (< value 65536) 126 127))) + (n2 uint (pcase n1 (127 64) (126 16) (_ 0)) + :pack-val value) + :unpack-val (if (< n1 126) n1 n2))) + +(ert-deftest bindat-test--pack-val () + ;; This is intended to test the :(un)pack-val feature that offers + ;; control over the unpacked representation of the data. + (dolist (n '(0 42 125 126 127 128 150 255 5000 65535 65536 8769786876)) + (should + (equal (bindat-unpack bindat-test--int-websocket-type + (bindat-pack bindat-test--int-websocket-type n)) + n)))) + +(ert-deftest bindat-test--sint () + (dotimes (kind 32) + (let ((bitlen (* 8 (/ kind 2))) + (r (zerop (% kind 2)))) + (dotimes (_ 100) + (let* ((n (random (ash 1 bitlen))) + (i (- n (ash 1 (1- bitlen))))) + (should (equal (bindat-unpack + (bindat-type sint bitlen r) + (bindat-pack (bindat-type sint bitlen r) i)) + i)) + (when (>= i 0) + (should (equal (bindat-pack + (bindat-type if r (uintr bitlen) (uint bitlen)) i) + (bindat-pack (bindat-type sint bitlen r) i))) + (should (equal (bindat-unpack + (bindat-type if r (uintr bitlen) (uint bitlen)) + (bindat-pack (bindat-type sint bitlen r) i)) + i)))))))) + +(defconst bindat-test--LEB128 + (bindat-type + letrec ((loop + (struct :pack-var n + (head u8 + :pack-val (+ (logand n 127) (if (> n 127) 128 0))) + (tail if (< head 128) (unit 0) loop + :pack-val (ash n -7)) + :unpack-val (+ (logand head 127) (ash tail 7))))) + loop)) + +(ert-deftest bindat-test--recursive () + (dotimes (n 10) + (let ((max (ash 1 (* n 10)))) + (dotimes (_ 10) + (let ((n (random max))) + (should (equal (bindat-unpack bindat-test--LEB128 + (bindat-pack bindat-test--LEB128 n)) + n))))))) + ;;; bindat-tests.el ends here |