* bug#55882: [PATCH] bindat: Minor cleanups
@ 2022-06-10 5:27 Richard Hansen
2022-06-10 9:53 ` Lars Ingebrigtsen
0 siblings, 1 reply; 2+ messages in thread
From: Richard Hansen @ 2022-06-10 5:27 UTC (permalink / raw)
To: 55882; +Cc: monnier
[-- Attachment #1.1.1: Type: text/plain, Size: 1444 bytes --]
X-Debbugs-CC: monnier@iro.umontreal.ca
Attached are a few patches to fix some minor issues with bindat and its documentation and tests.
Patch 1:
bindat (strz): Fix documentation for strz with pre-allocated string
* doc/lispref/processes.texi (Bindat Types): Document that a null
terminator is not written if `bindat-pack' is given a pre-allocated
string.
Patch 2:
; bindat-tests (str, strz): Refine tests
str and strz:
* Add tests for packing into a pre-allocated string.
strz:
* Add test cases to probe more boundary conditions.
* Delete comments that no longer apply.
* Add tests to ensure that truncated packed strings are rejected.
* Keep the legacy spec tests in sync with the modern spec tests.
Patch 3:
; bindat (strz): Consistent length type check, take two
Commit 30ec4a7347b2944818c6fc469ae871374ce7caa4 is incorrect -- the
length computation logic uses a simple nilness test, not `numberp'.
The `numberp' case is just an optimization if `len' is a literal
number; it does not affect the behavior.
Revert that commit, add some comments to help future readers avoid the
same mistake, and update the pack logic to use the same optimization
as the length computation for consistency.
Patch 4:
; bindat (bindat--length-group): Fix indentation
[-- Attachment #1.1.2: 0001-bindat-strz-Fix-documentation-for-strz-with-pre-allo.patch --]
[-- Type: text/x-patch, Size: 1920 bytes --]
From 6a57f4b3bb71cc1ea11eaa11b9e4cf14d37a08b7 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Thu, 9 Jun 2022 19:58:56 -0400
Subject: [PATCH 1/4] bindat (strz): Fix documentation for strz with
pre-allocated string
* doc/lispref/processes.texi (Bindat Types): Document that a null
terminator is not written if `bindat-pack' is given a pre-allocated
string.
---
doc/lispref/processes.texi | 13 +++++++++++--
1 file changed, 11 insertions(+), 2 deletions(-)
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 7c37853eca..55fb93ec5a 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3490,12 +3490,21 @@ Bindat Types
@item strz &optional @var{len}
If @var{len} is not provided: Variable-length null-terminated unibyte
string (@pxref{Text Representations}). When packing, the entire input
-string is copied to the packed output followed by a null byte. The
+string is copied to the packed output. The following byte will be
+null (zero) unless a pre-allocated string was provided to
+@code{bindat-pack}, in which case that byte is left unmodified. The
length of the packed output is the length of the input string plus one
-(for the added null byte). The input string must not contain any null
+(for the null terminator). The input string must not contain any null
bytes. When unpacking, the resulting string contains all bytes up to
(but excluding) the null byte.
+@quotation Caution
+If a pre-allocated string is provided to @code{bindat-pack}, the
+packed output will not be properly null-terminated unless the
+pre-allocated string already has a null byte at the appropriate
+location.
+@end quotation
+
If @var{len} is provided: @code{strz} behaves the same as @code{str}
with one difference: When unpacking, the first null byte encountered
in the packed string and all subsequent bytes are excluded from the
--
2.36.1
[-- Attachment #1.1.3: 0002-bindat-tests-str-strz-Refine-tests.patch --]
[-- Type: text/x-patch, Size: 6018 bytes --]
From 39b2975081a1d7687ff87f8790aedfbdee42cd93 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sun, 29 May 2022 17:15:04 -0400
Subject: [PATCH 2/4] ; bindat-tests (str, strz): Refine tests
str and strz:
* Add tests for packing into a pre-allocated string.
strz:
* Add test cases to probe more boundary conditions.
* Delete comments that no longer apply.
* Add tests to ensure that truncated packed strings are rejected.
* Keep the legacy spec tests in sync with the modern spec tests.
---
test/lisp/emacs-lisp/bindat-tests.el | 58 ++++++++++++++++++++++------
1 file changed, 46 insertions(+), 12 deletions(-)
diff --git a/test/lisp/emacs-lisp/bindat-tests.el b/test/lisp/emacs-lisp/bindat-tests.el
index b3850f14f1..4817072752 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -162,12 +162,40 @@ bindat-test--recursive
(bindat-pack bindat-test--LEB128 n))
n)))))))
+(ert-deftest bindat-test--str-strz-prealloc ()
+ (dolist (tc `(((,(bindat-type str 1) "") . "xx")
+ ((,(bindat-type str 2) "") . "xx")
+ ((,(bindat-type str 2) "a") . "ax")
+ ((,(bindat-type str 2) "ab") . "ab")
+ ((,(bindat-type str 2) "abc") . "ab")
+ ((((x str 1)) ((x . ""))) . "xx")
+ ((((x str 2)) ((x . ""))) . "xx")
+ ((((x str 2)) ((x . "a"))) . "ax")
+ ((((x str 2)) ((x . "ab"))) . "ab")
+ ((((x str 2)) ((x . "abc"))) . "ab")
+ ((,(bindat-type strz 1) "") . "xx")
+ ((,(bindat-type strz 2) "") . "xx")
+ ((,(bindat-type strz 2) "a") . "ax")
+ ((,(bindat-type strz 2) "ab") . "ab")
+ ((,(bindat-type strz 2) "abc") . "ab")
+ ((((x strz 1)) ((x . ""))) . "xx")
+ ((((x strz 2)) ((x . ""))) . "xx")
+ ((((x strz 2)) ((x . "a"))) . "ax")
+ ((((x strz 2)) ((x . "ab"))) . "ab")
+ ((((x strz 2)) ((x . "abc"))) . "ab")
+ ((,(bindat-type strz) "") . "xx")
+ ((,(bindat-type strz) "a") . "ax")))
+ (let ((prealloc (make-string 2 ?x)))
+ (apply #'bindat-pack (append (car tc) (list prealloc)))
+ (should (equal prealloc (cdr tc))))))
+
(let ((spec (bindat-type strz 2)))
(ert-deftest bindat-test--strz-fixedlen-len ()
(should (equal (bindat-length spec "") 2))
(should (equal (bindat-length spec "a") 2)))
(ert-deftest bindat-test--strz-fixedlen-len-overflow ()
+ (should (equal (bindat-length spec "ab") 2))
(should (equal (bindat-length spec "abc") 2)))
(ert-deftest bindat-test--strz-fixedlen-pack ()
@@ -177,17 +205,18 @@ bindat-test--recursive
(ert-deftest bindat-test--strz-fixedlen-pack-overflow ()
;; This is not the only valid semantic, but it's the one we've
;; offered historically.
+ (should (equal (bindat-pack spec "ab") "ab"))
(should (equal (bindat-pack spec "abc") "ab")))
(ert-deftest bindat-test--strz-fixedlen-unpack ()
- ;; There are no tests for unpacking "ab" or "ab\0" because those
- ;; packed strings cannot be produced from the spec (packing "ab"
- ;; should produce "a\0", not "ab" or "ab\0").
(should (equal (bindat-unpack spec "\0\0") ""))
(should (equal (bindat-unpack spec "\0X") ""))
(should (equal (bindat-unpack spec "a\0") "a"))
;; Same comment as for b-t-s-f-pack-overflow.
- (should (equal (bindat-unpack spec "ab") "ab"))))
+ (should (equal (bindat-unpack spec "ab") "ab"))
+ ;; Missing null terminator.
+ (should-error (bindat-unpack spec ""))
+ (should-error (bindat-unpack spec "a"))))
(let ((spec (bindat-type strz)))
(ert-deftest bindat-test--strz-varlen-len ()
@@ -199,11 +228,11 @@ bindat-test--recursive
(should (equal (bindat-pack spec "abc") "abc\0")))
(ert-deftest bindat-test--strz-varlen-unpack ()
- ;; There is no test for unpacking a string without a null
- ;; terminator because such packed strings cannot be produced from
- ;; the spec (packing "a" should produce "a\0", not "a").
(should (equal (bindat-unpack spec "\0") ""))
- (should (equal (bindat-unpack spec "abc\0") "abc"))))
+ (should (equal (bindat-unpack spec "abc\0") "abc"))
+ ;; Missing null terminator.
+ (should-error (bindat-unpack spec ""))
+ (should-error (bindat-unpack spec "a"))))
(let ((spec '((x strz 2))))
(ert-deftest bindat-test--strz-legacy-fixedlen-len ()
@@ -211,6 +240,7 @@ bindat-test--recursive
(should (equal (bindat-length spec '((x . "a"))) 2)))
(ert-deftest bindat-test--strz-legacy-fixedlen-len-overflow ()
+ (should (equal (bindat-length spec '((x . "ab"))) 2))
(should (equal (bindat-length spec '((x . "abc"))) 2)))
(ert-deftest bindat-test--strz-legacy-fixedlen-pack ()
@@ -219,13 +249,17 @@ bindat-test--recursive
(ert-deftest bindat-test--strz-legacy-fixedlen-pack-overflow ()
;; Same comment as for b-t-s-f-pack-overflow.
+ (should (equal (bindat-pack spec '((x . "ab"))) "ab"))
(should (equal (bindat-pack spec '((x . "abc"))) "ab")))
(ert-deftest bindat-test--strz-legacy-fixedlen-unpack ()
- ;; There are no tests for unpacking "ab" or "ab\0" because those
- ;; packed strings cannot be produced from the spec (packing "ab"
- ;; should produce "a\0", not "ab" or "ab\0").
(should (equal (bindat-unpack spec "\0\0") '((x . ""))))
- (should (equal (bindat-unpack spec "a\0") '((x . "a"))))))
+ (should (equal (bindat-unpack spec "\0X") '((x . ""))))
+ (should (equal (bindat-unpack spec "a\0") '((x . "a"))))
+ ;; Same comment as for b-t-s-f-pack-overflow.
+ (should (equal (bindat-unpack spec "ab") '((x . "ab"))))
+ ;; Missing null terminator.
+ (should-error (bindat-unpack spec ""))
+ (should-error (bindat-unpack spec "a"))))
;;; bindat-tests.el ends here
--
2.36.1
[-- Attachment #1.1.4: 0003-bindat-strz-Consistent-length-type-check-take-two.patch --]
[-- Type: text/x-patch, Size: 2481 bytes --]
From 466fb0980cd4aa4f26633c0756bb675b378e6968 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Sat, 28 May 2022 23:53:51 -0400
Subject: [PATCH 3/4] ; bindat (strz): Consistent length type check, take two
Commit 30ec4a7347b2944818c6fc469ae871374ce7caa4 is incorrect -- the
length computation logic uses a simple nilness test, not `numberp'.
The `numberp' case is just an optimization if `len' is a literal
number; it does not affect the behavior.
Revert that commit, add some comments to help future readers avoid the
same mistake, and update the pack logic to use the same optimization
as the length computation for consistency.
---
lisp/emacs-lisp/bindat.el | 21 +++++++++++++--------
1 file changed, 13 insertions(+), 8 deletions(-)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0725b677cf..760c86feb4 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -688,18 +688,23 @@ bindat--type
('unpack `(bindat--unpack-strz ,len))
(`(length ,val)
`(cl-incf bindat-idx ,(cond
+ ;; Optimizations if len is a literal number or nil.
((null len) `(1+ (length ,val)))
((numberp len) len)
+ ;; General expression support.
(t `(or ,len (1+ (length ,val)))))))
(`(pack . ,args)
- (macroexp-let2 nil len len
- `(if (numberp ,len)
- ;; Same as non-zero terminated strings since we don't actually add
- ;; the terminating zero anyway (because we rely on the fact that
- ;; `bindat-raw' was presumably initialized with all-zeroes before
- ;; we started).
- (bindat--pack-str ,len . ,args)
- (bindat--pack-strz . ,args))))))
+ ;; When len is specified, behave the same as the str type since we don't
+ ;; actually add the terminating zero anyway (because we rely on the fact
+ ;; that `bindat-raw' was presumably initialized with all-zeroes before we
+ ;; started).
+ (cond ; Same optimizations as 'length above.
+ ((null len) `(bindat--pack-strz . ,args))
+ ((numberp len) `(bindat--pack-str ,len . ,args))
+ (t (macroexp-let2 nil len len
+ `(if ,len
+ (bindat--pack-str ,len . ,args)
+ (bindat--pack-strz . ,args))))))))
(cl-defmethod bindat--type (op (_ (eql 'bits)) len)
(bindat--pcase op
--
2.36.1
[-- Attachment #1.1.5: 0004-bindat-bindat-length-group-Fix-indentation.patch --]
[-- Type: text/x-patch, Size: 5748 bytes --]
From 1aac24735ab19b3b404c982693f4f05195d21ed1 Mon Sep 17 00:00:00 2001
From: Richard Hansen <rhansen@rhansen.org>
Date: Thu, 2 Jun 2022 16:33:16 -0400
Subject: [PATCH 4/4] ; bindat (bindat--length-group): Fix indentation
---
lisp/emacs-lisp/bindat.el | 132 +++++++++++++++++++-------------------
1 file changed, 66 insertions(+), 66 deletions(-)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 760c86feb4..5f3c772983 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -320,72 +320,72 @@ bindat--fixed-length-alist
(defun bindat--length-group (struct spec)
(if (cl-typep spec 'bindat--type)
(funcall (bindat--type-le spec) struct)
- (with-suppressed-warnings ((lexical struct last))
- (defvar struct) (defvar last))
- (let ((struct struct) last)
- (dolist (item spec)
- (let* ((field (car item))
- (type (nth 1 item))
- (len (nth 2 item))
- (vectype (and (eq type 'vec) (nth 3 item)))
- (tail 3))
- (if (and type (consp type) (eq (car type) 'eval))
- (setq type (eval (car (cdr type)) t)))
- (if (and len (consp len) (eq (car len) 'eval))
- (setq len (eval (car (cdr len)) t)))
- (if (memq field '(eval fill align struct union))
- (setq tail 2
- len type
- type field
- field nil))
- (if (and (consp field) (eq (car field) 'eval))
- (setq field (eval (car (cdr field)) t)))
- (if (and (consp len) (not (eq type 'eval)))
- (setq len (apply #'bindat-get-field struct len)))
- (if (not len)
- (setq len 1))
- (while (eq type 'vec)
- (if (consp vectype)
- (setq len (* len (nth 1 vectype))
- type (nth 2 vectype))
- (setq type (or vectype 'u8)
- vectype nil)))
- (pcase type
- ('eval
- (if field
- (setq struct (cons (cons field (eval len t)) struct))
- (eval len t)))
- ('fill
- (setq bindat-idx (+ bindat-idx len)))
- ('align
- (setq bindat-idx (bindat--align bindat-idx len)))
- ('struct
- (bindat--length-group
- (if field (bindat-get-field struct field) struct) (eval len t)))
- ('repeat
- (dotimes (index len)
- (bindat--length-group
- (nth index (bindat-get-field struct field))
- (nthcdr tail item))))
- ('union
- (with-suppressed-warnings ((lexical tag))
- (defvar tag))
- (let ((tag len) (cases (nthcdr tail item)) case cc)
- (while cases
- (setq case (car cases)
- cases (cdr cases)
- cc (car case))
- (if (or (equal cc tag) (equal cc t)
- (and (consp cc) (eval cc t)))
- (progn
- (bindat--length-group struct (cdr case))
- (setq cases nil))))))
- (_
- (if (setq type (assq type bindat--fixed-length-alist))
- (setq len (* len (cdr type))))
- (if field
- (setq last (bindat-get-field struct field)))
- (setq bindat-idx (+ bindat-idx len)))))))))
+ (with-suppressed-warnings ((lexical struct last))
+ (defvar struct) (defvar last))
+ (let ((struct struct) last)
+ (dolist (item spec)
+ (let* ((field (car item))
+ (type (nth 1 item))
+ (len (nth 2 item))
+ (vectype (and (eq type 'vec) (nth 3 item)))
+ (tail 3))
+ (if (and type (consp type) (eq (car type) 'eval))
+ (setq type (eval (car (cdr type)) t)))
+ (if (and len (consp len) (eq (car len) 'eval))
+ (setq len (eval (car (cdr len)) t)))
+ (if (memq field '(eval fill align struct union))
+ (setq tail 2
+ len type
+ type field
+ field nil))
+ (if (and (consp field) (eq (car field) 'eval))
+ (setq field (eval (car (cdr field)) t)))
+ (if (and (consp len) (not (eq type 'eval)))
+ (setq len (apply #'bindat-get-field struct len)))
+ (if (not len)
+ (setq len 1))
+ (while (eq type 'vec)
+ (if (consp vectype)
+ (setq len (* len (nth 1 vectype))
+ type (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil)))
+ (pcase type
+ ('eval
+ (if field
+ (setq struct (cons (cons field (eval len t)) struct))
+ (eval len t)))
+ ('fill
+ (setq bindat-idx (+ bindat-idx len)))
+ ('align
+ (setq bindat-idx (bindat--align bindat-idx len)))
+ ('struct
+ (bindat--length-group
+ (if field (bindat-get-field struct field) struct) (eval len t)))
+ ('repeat
+ (dotimes (index len)
+ (bindat--length-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))))
+ ('union
+ (with-suppressed-warnings ((lexical tag))
+ (defvar tag))
+ (let ((tag len) (cases (nthcdr tail item)) case cc)
+ (while cases
+ (setq case (car cases)
+ cases (cdr cases)
+ cc (car case))
+ (if (or (equal cc tag) (equal cc t)
+ (and (consp cc) (eval cc t)))
+ (progn
+ (bindat--length-group struct (cdr case))
+ (setq cases nil))))))
+ (_
+ (if (setq type (assq type bindat--fixed-length-alist))
+ (setq len (* len (cdr type))))
+ (if field
+ (setq last (bindat-get-field struct field)))
+ (setq bindat-idx (+ bindat-idx len)))))))))
(defun bindat-length (spec struct)
"Calculate `bindat-raw' length for STRUCT according to bindat SPEC."
--
2.36.1
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 833 bytes --]
^ permalink raw reply related [flat|nested] 2+ messages in thread
* bug#55882: [PATCH] bindat: Minor cleanups
2022-06-10 5:27 bug#55882: [PATCH] bindat: Minor cleanups Richard Hansen
@ 2022-06-10 9:53 ` Lars Ingebrigtsen
0 siblings, 0 replies; 2+ messages in thread
From: Lars Ingebrigtsen @ 2022-06-10 9:53 UTC (permalink / raw)
To: Richard Hansen; +Cc: 55882, monnier
Richard Hansen <rhansen@rhansen.org> writes:
> Attached are a few patches to fix some minor issues with bindat and
> its documentation and tests.
Thanks; pushed to Emacs 29.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2022-06-10 9:53 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-06-10 5:27 bug#55882: [PATCH] bindat: Minor cleanups Richard Hansen
2022-06-10 9:53 ` Lars Ingebrigtsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).