You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

277 lines
12 KiB

  1. ;;;; ******************************************************
  2. ;;;; FILE IDENTIFICATION
  3. ;;;;
  4. ;;;; Name: tests.lisp
  5. ;;;; Purpose: Tests for CL-PACK
  6. ;;;; Author: Dan Ballard <http://mindstab.net>
  7. ;;;; Created: May 2009
  8. ;;;; Modified: August 2009
  9. ;;;; License: BSD
  10. ;;;; Description: CL-PACK supplies perl/php/ruby compatible
  11. ;;;; pack() and unpack() functions to allow
  12. ;;;; easy use of binary protocols with the above
  13. ;;;; mentioned languages and C.
  14. ;;;;*******************************************************
  15. (in-package :common-lisp)
  16. (defpackage :cl-pack-test
  17. (:use #:common-lisp #:cl-pack)
  18. (:export #:test #:test-silent))
  19. (in-package :cl-pack-test)
  20. ;;;; ***** Unit Test Framework shamelessly ripped from *****
  21. ;;;; Practical Common Lisp (and slightly modified)
  22. (defmacro with-gensyms ((&rest names) &body body)
  23. `(let ,(loop for n in names collect `(,n (gensym)))
  24. ,@body))
  25. (defvar *test-name* nil)
  26. (defvar *silent* nil)
  27. (defmacro deftest (name parameters &body body)
  28. "Define a test function. Within a test function we can call
  29. other test functions or use 'check' to run individual test
  30. cases."
  31. `(defun ,name ,parameters
  32. (let ((*test-name* (append *test-name* (list ',name))))
  33. ,@body)))
  34. (defmacro check (&body forms)
  35. "Run each expression in 'forms' as a test case."
  36. `(combine-results
  37. ,@(loop for f in forms collect `(report-result ,f ',f))))
  38. (defmacro combine-results (&body forms)
  39. "Combine the results (as booleans) of evaluating 'forms' in order."
  40. (with-gensyms (result pass-count total-count res pas tot)
  41. `(let ((,result t)
  42. (,pass-count 0)
  43. (,total-count 0))
  44. ,@(loop for f in forms collect
  45. `(multiple-value-bind (,res ,pas ,tot) ,f
  46. (incf ,total-count (if ,tot ,tot 1))
  47. (incf ,pass-count (if ,pas ,pas (if ,res 1 0)))
  48. (if (not ,res) (setf ,result nil))))
  49. (if (not *silent*) (format t "~a ~d/~d passed~%" *test-name* ,pass-count ,total-count))
  50. (values ,result ,pass-count ,total-count))))
  51. (defun report-result (result form)
  52. "Report the results of a single test case. Called by 'check'."
  53. (if (not *silent*) (format t "~:[FAIL~;pass~] ... ~a: ~a~%" result *test-name* form))
  54. result)
  55. ;;;; ********************** Unit Tests ****************************
  56. (deftest test ()
  57. (combine-results
  58. (pack-numbers)
  59. (pack-combinations)
  60. (pack-strings)
  61. (unpack-numbers)
  62. (unpack-combinations)
  63. (unpack-strings)
  64. (pack-signed)
  65. (unpack-signed)
  66. (pack-form)
  67. (unpack-form)
  68. (mod-!)
  69. (mod-<>)
  70. (grouping)
  71. (pack-/)
  72. (unpack-/)
  73. ))
  74. (deftest test-silent ()
  75. (let ((*silent* t))
  76. (test)))
  77. (defun gen-null-string (len)
  78. (apply #'concatenate 'string (loop for i from 0 to (1- len) collecting (string #\null))))
  79. (deftest pack-numbers ()
  80. (check
  81. (string= (pack "n" #x4142) "AB")
  82. (string= (pack "v" #x4142) "BA")
  83. (string= (pack "N" #x41424344) "ABCD")
  84. (string= (pack "V" #x41424344) "DCBA")
  85. (string= (pack "g" 15) (concatenate 'string "Ap" (string #\null) (string #\null)))
  86. (string= (pack "e" 15) (concatenate 'string (string #\null) (string #\null) "pA"))
  87. (string= (pack "G" 25) (concatenate 'string "@9" (gen-null-string 6)))
  88. (string= (pack "E" 25) (concatenate 'string (gen-null-string 6) "9@"))
  89. (string= (pack "x") (string #\null))
  90. (string= (pack "w" 193) (coerce `(,(code-char 129) #\A) 'string))
  91. (string= (pack "w" 0) (coerce `(,(code-char 0)) 'string))
  92. ))
  93. (deftest pack-combinations ()
  94. (check
  95. (string= (pack "c2" #x41 #x42 #x43) "AB") ; basic repeater (with extra data dropped)
  96. (string= (pack "c*" #x41 #x42 #x43) "ABC") ; basic * repeater
  97. (string= (pack "c3" #x41 #x42) "AB") ; only use avail data -- ! should ERROR be raised?
  98. (string= (pack "c2N" #x41 #x42 #x43444546) "ABCDEF") ; pick up after repeater
  99. (string= (pack "NX2" #x41424344) "AB") ;delete chars
  100. (string= (pack "c.c" 65 0 66 ) "B") ; truncate
  101. (string= (pack "c.c" 65 2 66) (concatenate 'string "A" (string #\null) "B")) ; null pad
  102. (string= (pack "cc0c" 65 66 67) "AB") ; 0 repeat consumes nothing
  103. (string= (pack "c@0c" 65 66) "AB") ;truncate
  104. (string= (pack "c@2c" 65 66) (concatenate 'string "A" (string #\null) "B")) ; null pad
  105. ))
  106. (deftest pack-strings ()
  107. (check
  108. (string= (pack "a*" "Test String") "Test String") ; * repeater with string data
  109. (string= (pack "a5" "1234") (concatenate 'string "1234" (string #\null))) ; test null of 'a'
  110. (string= (pack "a*" 65) "65") ; pack a string converting a number
  111. (string= (pack "A10" "Test") "Test ") ; numeric repeater with string data and padding
  112. (string= (pack "a*N" "String" #x41424344) "StringABCD") ; pick up after string/*
  113. (string= (pack "A10V" "Test" #x41424344) "Test DCBA") ; pick up after string/#
  114. (string= (pack "c2xa*" #x41 #x42 "Test") (concatenate 'string "AB" (string #\null) "Test")) ; non consuming 'x' plays nicely with others
  115. (string= (pack "B*" "010000010100001001000011") "ABC") ; binary string
  116. (string= (pack "B16" "010000010100001001000011") "AB") ; binary string only consumes what's asked of it
  117. (string= (pack "B*" "010000010100001") "AB") ; AB string short a bit
  118. (string= (pack "b*" "100000101000010") "A!") ; AB string short a bit
  119. (string= (pack "H4" "414243") "AB") ; basic hex string (ignoring extra chars)
  120. (string= (pack "H*" "414") "A@") ; padding right?
  121. (string= (pack "h*" "1424") "AB") ; other byte ordering
  122. (string= (pack "Z*" "dan") (concatenate 'string "dan" (string #\null))) ; null padded string *
  123. (string= (pack "Z5" "dan") (concatenate 'string "dan" (string #\null) (string #\null))) ; padding of Z
  124. (string= (pack "Z3" "dan") (concatenate 'string "da" (string #\null))) ; proper ending in NULL for under length string
  125. ))
  126. (deftest unpack-numbers ()
  127. (check
  128. (= (unpack "N" "ABCD") #x41424344)
  129. (= (unpack "V" "DCBA") #x41424344)
  130. (= (unpack "n" "AB") #x4142)
  131. (= (unpack "v" "BA") #x4142)
  132. (= (unpack "g" (concatenate 'string "Ap" (string #\null) (string #\null))) 15)
  133. (= (unpack "e" (concatenate 'string (string #\null) (string #\null) "pA")) 15)
  134. (= (unpack "G" (concatenate 'string "@9" (gen-null-string 6))) 25)
  135. (= (unpack "E" (concatenate 'string (gen-null-string 6) "9@")) 25)
  136. (= (unpack "w" (coerce `(,(code-char 129) #\A) 'string)) 193)
  137. (= (unpack "w" (coerce `(,(code-char 0)) 'string)) 0)
  138. ))
  139. (deftest unpack-combinations ()
  140. (check
  141. (equal (multiple-value-list (unpack "c2" "ABC")) '(#x41 #x42)) ; basic repeater (with extra data dropped)
  142. (equal (multiple-value-list (unpack "c*" "ABC")) '(#x41 #x42 #x43)) ; basic * repeater
  143. (equal (multiple-value-list (unpack "c3" "AB")) '(#x41 #x42)) ; only use avail data -- ! should ERROR be raised?
  144. (equal (multiple-value-list (unpack "c2N" "ABCDEF")) '(#x41 #x42 #x43444546)) ; pick up after repeater
  145. (equal (multiple-value-list (unpack "aa0aa" "ABCD")) '("A" "B" "C")) ; 0 means it skips
  146. ; https://github.com/dballard/cl-pack/issues/4
  147. ; test that unpack 0 consume 0
  148. (equal (multiple-value-list (unpack "a0" "abc" :consumed 0)) '(0))
  149. ))
  150. (deftest unpack-strings ()
  151. (check
  152. (string= (unpack "a*" "Test String") "Test String") ; * repeater with string data
  153. (string= (unpack "a5" (concatenate 'string "1234" (string #\null))) (concatenate 'string "1234" (string #\null))) ; test null of 'a'
  154. (string= (unpack "A10" "Test ") "Test"); numeric repeater with string data and padding
  155. (equal (multiple-value-list (unpack "A*N" "String ABCD ")) '("String ABCD")) ; it doesn't pick up after string/*
  156. (equal (multiple-value-list (unpack "A10V" "Test DCBA")) '("Test" #x41424344)) ; pick up after string/#
  157. (equal (multiple-value-list (unpack "c2xa*" (concatenate 'string "AB" (string #\null) "Test"))) '(#x41 #x42 "Test")) ; non consuming 'x' plays nicely with others
  158. (string= (unpack "B*" "ABC") "010000010100001001000011") ; binary string
  159. (string= (unpack "B15" "ABC") "010000010100001") ; binary string only consumes what's asked of it
  160. (string= (unpack "b*" "AB") "1000001001000010") ; other ordering
  161. (string= (unpack "B9" "A") "01000001") ; Not enough data
  162. (string= (unpack "H3" "AB") "414") ; basic hex string (ignoring extra chars)
  163. (string= (unpack "H*" "A@") "4140") ; padding right?
  164. (string= (unpack "h*" "AB") "1424") ; other byte ordering
  165. (string= (unpack "H3" "A") "41") ; not enough data
  166. (string= (unpack "Z*" (concatenate 'string "dan" (string #\null))) (concatenate 'string "dan" (string #\null))) ; null padded string *
  167. ))
  168. ;; Apparently in perl land 1 byte and 2 byte values overflow and wrap arround
  169. ;; but 4 byte values don't. This is inconsistent and hard to match perfectly.
  170. ;; So cl-pack prevents all overflow and underflow pegging numbers at their
  171. ;; highest or lowest possible value as per perl's 4 byte behaviour
  172. (deftest pack-signed ()
  173. (check
  174. (string= (unpack "B*" (pack "c" 255)) "11111111")
  175. (string= (unpack "B*" (pack "c" 256)) "11111111")
  176. (string= (unpack "B*" (pack "c" -128)) "10000000")
  177. (string= (unpack "B*" (pack "c" -129)) "10000000")))
  178. (deftest unpack-signed ()
  179. (check
  180. (= (unpack "c" (pack "c" -1)) -1)
  181. (= (unpack "c" (pack "c" -129)) -128)
  182. (= (unpack "c" (pack "c" 127)) 127)
  183. (= (unpack "c" (pack "c" 128)) -128)))
  184. ;;; Test that weird things in form are still handled ok
  185. (deftest pack-form ()
  186. (check
  187. (string= (pack "Kc" #x41 #x42) "A"))) ; unknown character
  188. (deftest unpack-form ()
  189. (check
  190. (= (unpack "Kc" "AB") #x41))) ; unknown character
  191. (deftest mod-! ()
  192. (check
  193. (= (unpack "n!" (pack "n" -1)) -1) ; n! is signed
  194. ))
  195. ;; Test both < > mod features and that they play nice with repeaters
  196. (deftest mod-<> ()
  197. (check
  198. (string= (pack "l>" #x41424344 #x45464748) "ABCD")
  199. (string= (pack "l<*" #x41424344 #x45464748) "DCBAHGFE")
  200. (string= (pack "s<" #x4142) "BA") ; check s
  201. (string= (pack "s>" #x4142) "AB") ; check s
  202. (= (unpack "l<" (pack "V" #x41424344)) #x41424344)
  203. (equal (multiple-value-list (unpack "l>2" (pack "N*" #x41424344 #x45464748))) '(#x41424344 #x45464748))
  204. (= (unpack "s<" "AB") #x4241) ;test s
  205. (= (unpack "s>" "AB") #x4142) ; test s
  206. ))
  207. (deftest grouping ()
  208. (check
  209. (string= (pack "(ccx(cx)2)2" #x41 #x42 #x43 #x44 #x45 #x46 #x47 #x48)
  210. (concatenate 'string "AB" (string #\null) "C" (string #\null) "D" (string #\null) "EF" (string #\null) "G" (string #\null) "H" (string #\null))) ; Complex nested grouping with non consuming elements
  211. (string= (pack "(ccx(cx)2)2" #x41 #x42 #x43 #x44 #x45 #x46 #x47)
  212. (concatenate 'string "AB" (string #\null) "C" (string #\null) "D" (string #\null) "EF" (string #\null) "G" (string #\null))) ; same as above except missing a data item
  213. (equal (multiple-value-list (unpack "(cc(c)2)2" "ABCDEFGH"))
  214. '((65 66 (67) (68)) (69 70 (71) (72)))) ;unpack complex nested group
  215. (equal (multiple-value-list (unpack "(ccx(cx)2)2" "ABCDEFGHIJKLMNOP"))
  216. '((65 66 (68) (70)) (72 73 (75) (77)))) ;unpack complex nested group with skips
  217. (equal (multiple-value-list (unpack "(ccx(cx)2)2" "ABCDEFGH"))
  218. '((65 66 (68) (70)) (72))) ;unpack complex nested group with skips missing elements
  219. (string= (pack "(s(ss>s)<s)>" #x4142 #x4344 #x4546 #x4748 #x494a) "ABDCEFHGIJ") ; modifiers work over whole groups, and locality of modifier precidence
  220. (equal (multiple-value-list (unpack "(s(ss>s)<s)>" "ABCDEFGHIJ"))
  221. '((#x4142 (#x4443 #x4546 #x4847) #x494a)))
  222. ))
  223. (deftest pack-/ ()
  224. (check
  225. (string= (pack "a/c3" 65 66) "2AB") ; basic pack (missing an element, into a string type
  226. (string= (pack "n/c*" 65 66 67) (concatenate 'string (string #\null) (string (code-char 3)) "ABC")) ;basic pack into a number with a *
  227. (string= (pack "a/a3" "ABC") "3ABC") ;string pack
  228. (string= (pack "a/a*" "ABC") "3ABC") ;string pack with *
  229. ))
  230. (deftest unpack-/ ()
  231. (check
  232. (equal (multiple-value-list (unpack "a/c" "3AB")) '(65 66))
  233. (equal (multiple-value-list (unpack "n/c" (concatenate 'string (string #\null) (string (code-char 3)) "ABC"))) '(65 66 67))
  234. (equal (multiple-value-list (unpack "a/ac" "2ABC")) '("AB" 67))
  235. ))