From 8e68493603f1a20c8e1e3e93b6f1b777cf4aaa67 Mon Sep 17 00:00:00 2001 From: Dan Ballard Date: Tue, 10 Apr 2018 16:52:15 -0700 Subject: [PATCH] fixed https://github.com/dballard/cl-pack/issues/4 ; version bump to 1.0 --- README.md | 4 +-- cl-pack.asd | 2 +- cl-pack.lisp | 95 ++++++++++++++++++++++++++-------------------------- tests.lisp | 7 ++-- 4 files changed, 55 insertions(+), 53 deletions(-) diff --git a/README.md b/README.md index a5235ec..7a647a2 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ cl-pack [www.cliki.net/cl-pack](http://www.cliki.net/cl-pack) -cl-pack supplies Perl/PHP/Ruby/Python compatible `pack()` and `unpack()` functions to allow easy use of (binary format) protocols and files with the above mentioned languages and C. cl-pack was released by Dan Ballard under the BSD-3-Clause license. +cl-pack supplies Perl/PHP/Ruby/Python compatible `pack()` and `unpack()` functions to allow easy use of (binary format) protocols and files with the above mentioned languages and C. cl-pack was released by Dan Ballard under the BSD-3-Clause license. The purpose of cl-pack is to take native Lisp data like numbers, floats, and strings and encode it in a safe binary format in string that can then be written to a file or exchanged with another program while unpack can extract data from binary formats and protocols. @@ -30,6 +30,6 @@ cl-pack is available in [QuickLisp](https://www.quicklisp.org/beta/) Nearly every feature except a few esoteric ones are supported, check the documentation inside cl-pack.lisp if in doubt and if a feature you need isn't currently supported feel free to contact me and I'll see if I can add it. -**Note** I think the 0.2 release is about as feature complete as I feel I need to get at the moment so I'm pushing it out. If there are not major complaints, then in a bit it will be re-released as 1.0, and if there are complaints, well more code and another pre-1.0 release :smile: +**Note** I think the this release is about as feature complete as I feel I need to get at the moment so I'm pushing it out. **Cavets** cl-pack was developed on an x86 running Ubuntu with SBCL. It should be endian safe where required and conform to host CPU endianness where required but I haven't been able to test on anything but x86. I would hope that it would work with most Lisps out there. Please feel free to get a hold of me if you have issues that need fixing. diff --git a/cl-pack.asd b/cl-pack.asd index e4cbd76..464f2d7 100644 --- a/cl-pack.asd +++ b/cl-pack.asd @@ -21,7 +21,7 @@ (defsystem #:cl-pack :name "cl-pack" :author "Dan Ballard " - :version "0.2" + :version "1.0" :licence "BSD-3-Clause" :description "Perl compatible binary pack() and unpack() library" :depends-on (:ieee-floats) diff --git a/cl-pack.lisp b/cl-pack.lisp index e17d1d7..fcf7f8f 100644 --- a/cl-pack.lisp +++ b/cl-pack.lisp @@ -380,7 +380,7 @@ (let ((offset 1) (inner-length 0) (repeater-star nil) - (repeater 0) + (repeater nil) (mod-! nil) (mod-> nil) (mod-< nil) @@ -403,14 +403,14 @@ (multiple-value-bind (repeater-count repeater-chars) (if (>= (length str) 1) (parse-integer str :junk-allowed t) - (values 0 0)) - (if (eql repeater-count nil) + (values nil 0)) + (if (and (>= (length str) 1) (eql repeater-count nil)) ;; no repeater #, check for other modifiers ( * ! < > ) (case (char str 0) (#\! (progn (setf mod-! t) (incf offset))) (#\> (progn (setf mod-> t) (incf offset))) (#\< (progn (setf mod-< t) (incf offset))) - (#\* (progn (setf repeater-star t)(incf offset))) + (#\* (progn (setf repeater-star t) (incf offset))) (#\/ (progn (setf /-pos offset) ;; a/N... we need offset to point to after N... @@ -418,11 +418,9 @@ (incf offset 2) )) ) - - (progn ; repeater-count == # - (if (> repeater-count 0) (setf repeater repeater-count)) + (if repeater-count (setf repeater repeater-count)) (incf offset repeater-chars)) ))) @@ -430,7 +428,7 @@ (let ((new-form form)) (inc-form) - (if (or repeater-star (> repeater 1)) + (if (or repeater-star (and repeater (> repeater 1))) (setf new-form (concatenate 'string (subseq form 0 (if (> inner-length 0) (+ 2 inner-length) 1)) (if mod-! "!" "") @@ -441,7 +439,8 @@ (write-to-string (1- repeater))) (subseq form offset)))) - (progn ,@body)))))) + (progn + ,@body)))))) (defmacro gen-modifiers-list () @@ -478,7 +477,6 @@ (second rest) "") - ;;; BODY ;; Extra optional keyed parameters ;; :result result is the result so far of the pack operation @@ -504,15 +502,13 @@ (setf rest (rest (rest rest))))) (otherwise (setf end? t)))) - - ;; Instead of passing a series of arguments, you can call it with a destructable list of arguments (let ((dlist-arg-style nil)) - (if (and (>= 1 (length rest)) (listp (first rest))) - (progn + (progn (setf dlist-arg-style t) - (setf rest (first rest)))) + (setf rest (first rest)) + )) ;; second end test (redundant a little, can we merge? (if (and (or (eql nil rest) (equal '(nil) rest)) (and (not (eql (strhead form) #\x)) (not (eql (strhead form) #\X)))) @@ -522,15 +518,23 @@ ;; set up of required endian functions (let ((bytes-to-string-fn #'bytes-to-string-rev) ; LITTLE ENDIAN (item (first rest)) - (new-rest (rest rest))) ; default rest for numbers + (new-result nil) + (new-rest rest)) + #+big-endian(setf bytes-to-string-fn #'bytes-to-string) ; BIG ENDIAN (if mod-> (setf bytes-to-string-fn #'bytes-to-string)) (if mod-< (setf bytes-to-string-fn #'bytes-to-string-rev)) + + (if (or (not repeater) (> repeater 0)) + (progn + (if (not repeater) (setf repeater 0)) + (setf new-rest (rest rest)) ;consume here - default rest for numbers + ;; pack case satement - (let ((new-result + (setf new-result ;; FORM of: sequence length / sequence items (if (> /-pos 0) @@ -556,7 +560,6 @@ (inc-form) (concatenate 'string (pack (subseq form 0 /-pos) consumed-length) ret))) - ;; ALL other FORMS (case (strhead form) (#\n ;Unsigned Short 16bit Big Endian AB=AB @@ -585,7 +588,6 @@ ;; crash :( ;; (string (code-char item ))) - ((#\s #\S) ;signed/unsigned short 16bit (pack-int 2 :native)) @@ -660,9 +662,9 @@ (inc-form) (setf new-rest rest) "" - )) + )) - ((#\. #\@) + ((#\. #\@) ;; . consume a numerical arg - null fill or truncate to that position ;; @ null fill or truncate to repeater specified position (let ((position item)) ; . @@ -681,29 +683,25 @@ (pack (subseq form 1 (1+ inner-length)) :modifiers (gen-modifiers-list) rest))) (setf new-rest rest) ; for dlist-style carry on ret)) - - - + (otherwise (progn (setf new-rest rest) ; didn't do anything, don't consume anything - ""))))) - ) ;; let () - - ;(format t "~a~%" new-result) + "")))) + ) ;; (setf new-result) ;; if using a descructable arg list - (if dlist-arg-style - (progn - (if (not (equal rest new-rest)) ; consumed an arg - (progn - ;; so remove the arg from the arg list - (setf (car rest) (second rest)) - (setf (cdr rest) (rest (rest rest))))) - ;; regardless, continue using the dlist style - (setf new-rest (list rest)))) + (if dlist-arg-style + (progn + (if (not (equal rest new-rest)) ; consumed an arg + (progn + ;; so remove the arg from the arg list + (setf (car rest) (second rest)) + (setf (cdr rest) (rest (rest rest))))) + ;; regardless, continue using the dlist style + (setf new-rest (list rest)))))) - ;; Recursion for the rest of pack - (apply #'pack (append (list new-form :result (concatenate 'string result new-result) :modifiers modifiers) new-rest))))))))) + ;; Recursion for the rest of pack + (apply #'pack (append (list new-form :result (concatenate 'string result new-result) :modifiers modifiers) new-rest)))))))) ;; macro for unpack. ;; cuts out and returns part of a string to be used for processing while setting @@ -718,7 +716,7 @@ ;;; form: a string of characters corresonding to decodings ;;; string: a string of binary data to be decoded ;;; consumed: optional key parameter. If nil (default) nothing happens -;;; if an integer, ever byte consumed increments consumed +;;; if an integer, every byte consumed increments consumed ;;; and it is the last value return in the values list ;;; returns: the decoded data in specified format (def-form-parser unpack (string &key (consumed nil) (modifiers nil)) @@ -742,13 +740,16 @@ (if mod-< (setf string-to-bytes-fn #'string-to-bytes-rev)) - ;; pack case statement and recursive call to unpack + ;; unpack case statement and recursive call to unpack ;; note: not tail optiomized :fix ? (apply #'values - (remove nil (append + (remove nil (append - - (if (> /-pos 0) + (if (or (not repeater) (> repeater 0)) + (progn + (if (not repeater) (setf repeater 0)) + + (if (> /-pos 0) (progn (let* ((length-item (subseq form 0 /-pos)) (sequence-item (subseq form (1+ /-pos) offset)) @@ -802,8 +803,7 @@ (if (char= #\A (strhead form)) (coerce '(#\null #\space) 'string) ""))) - - + (unpack-string (repeater repeater-star) (string-trim special-chars (cut-str string (length string) new-str)) (string-trim special-chars (cut-str string (min repeater (length string)) new-str)) @@ -835,8 +835,7 @@ ) (otherwise nil) - ))) - + ))))) ;; result of recursion (multiple-value-list (unpack new-form new-str :consumed consumed :modifiers modifiers))) :from-end t :count 1)))) diff --git a/tests.lisp b/tests.lisp index 6dfd2b2..12c187b 100644 --- a/tests.lisp +++ b/tests.lisp @@ -164,6 +164,10 @@ (equal (multiple-value-list (unpack "c*" "ABC")) '(#x41 #x42 #x43)) ; basic * repeater (equal (multiple-value-list (unpack "c3" "AB")) '(#x41 #x42)) ; only use avail data -- ! should ERROR be raised? (equal (multiple-value-list (unpack "c2N" "ABCDEF")) '(#x41 #x42 #x43444546)) ; pick up after repeater + (equal (multiple-value-list (unpack "aa0aa" "ABCD")) '("A" "B" "C")) ; 0 means it skips + ; https://github.com/dballard/cl-pack/issues/4 + ; test that unpack 0 consume 0 + (equal (multiple-value-list (unpack "a0" "abc" :consumed 0)) '(0)) )) (deftest unpack-strings () @@ -269,5 +273,4 @@ (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)) - - )) \ No newline at end of file + ))