/ template support in unpack

This commit is contained in:
Dan Ballard 2009-08-11 17:44:32 -07:00
parent 497ada9253
commit 75c50ca55a
3 changed files with 31 additions and 10 deletions

View File

@ -10,9 +10,8 @@
on nNvV it turns them to signed integers on nNvV it turns them to signed integers
- added . and @ support to pack - added . and @ support to pack
- added full group support to pack and unpack - added full group support to pack and unpack
- fixed string types to accept numvers and cast them to strings on the fly (ala perl) - fixed string types to accept numbers and cast them to strings on the fly (ala perl)
- added / template to pack - added / template to pack and unpack
- added more test cases to cover all the new additions and bug fixes - added more test cases to cover all the new additions and bug fixes
- Setup a git repository at git.mindstab.net/git/cl-pack - Setup a git repository at git.mindstab.net/git/cl-pack

View File

@ -96,9 +96,6 @@
;;; ************* TODO *************** ;;; ************* TODO ***************
;;;@ Null fill or truncate to absolute position, counted from the start of the innermost ()-group.
;;;. Null fill or truncate to absolute position specified by value.
;;;
;;;! MODIFIER, different uses in context ;;;! MODIFIER, different uses in context
;;; / template ;;; / template
@ -237,7 +234,7 @@
"macro for building string type bodies for case statements in pack()" "macro for building string type bodies for case statements in pack()"
`(progn `(progn
(if (numberp item) (if (numberp item)
(setf item (format nil "~d" item))) (setf item (write-to-string item)))
(handle-string (,repeater ,repeater-star) ,star-body ,count-body ,else-body))) (handle-string (,repeater ,repeater-star) ,star-body ,count-body ,else-body)))
(defmacro unpack-string ((repeater repeater-star) star-body count-body else-body) (defmacro unpack-string ((repeater repeater-star) star-body count-body else-body)
@ -545,7 +542,7 @@
(if (member sequence-type '(#\a #\A #\Z #\b #\B #\h #\H)) (if (member sequence-type '(#\a #\A #\Z #\b #\B #\h #\H))
(let ((item-length (let ((item-length
(if (numberp item) (if (numberp item)
(length (format nil "~d" item)) (length (write-to-string item))
(length item)))) (length item))))
(setf consumed-length (setf consumed-length
(if repeater-star (if repeater-star
@ -746,7 +743,23 @@
(apply #'values (apply #'values
(remove nil (append (remove nil (append
(list
(if (> /-pos 0)
(progn
(let* ((length-item (subseq form 0 /-pos))
(sequence-item (subseq form (1+ /-pos) offset))
(lengths (multiple-value-list (unpack length-item string :consumed 0 :modifiers modifiers)))
(seq-len (if (numberp (first lengths))
(write-to-string (first lengths))
(first lengths)))
(ret (multiple-value-list (unpack (concatenate 'string sequence-item seq-len) (subseq string (second lengths)) :consumed 0 :modifiers modifiers)))
(consumed-len (+ (first (last ret)) (second lengths))))
(cut-str string consumed-len new-str)
(inc-form)
(nbutlast ret)
))
(list
(case (strhead form) (case (strhead form)
(#\n (unpack-mod!-uint 2 :big)) ; unsigned short 16bit big endian (#\n (unpack-mod!-uint 2 :big)) ; unsigned short 16bit big endian
(#\N (unpack-mod!-uint 4 :big)) ; unsigned long 32bit big endian (#\N (unpack-mod!-uint 4 :big)) ; unsigned long 32bit big endian
@ -818,7 +831,7 @@
) )
(otherwise nil) (otherwise nil)
)) )))
;; result of recursion ;; result of recursion

View File

@ -82,6 +82,7 @@
(mod-<>) (mod-<>)
(grouping) (grouping)
(pack-/) (pack-/)
(unpack-/)
)) ))
(deftest test-silent () (deftest test-silent ()
@ -260,3 +261,11 @@
(string= (pack "a/a3" "ABC") "3ABC") ;string pack (string= (pack "a/a3" "ABC") "3ABC") ;string pack
(string= (pack "a/a*" "ABC") "3ABC") ;string pack with * (string= (pack "a/a*" "ABC") "3ABC") ;string pack with *
)) ))
(deftest unpack-/ ()
(check
(equal (multiple-value-list (unpack "a/c" "3AB")) '(65 66))
(equal (multiple-value-list (unpack "n/c" (concatenate 'string (string #\null) (string (code-char 3)) "ABC"))) '(65 66 67))
(equal (multiple-value-list (unpack "a/ac" "2ABC")) '("AB" 67))
))