1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Free Software published under an MIT-like license. See LICENSE ;;;
5 ;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
8 ;;; Based on original work by Robert Brown ;;;
10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12 (in-package "PROTO-TEST")
15 ;;; Comprehensive functionality unit tests
17 (define-test TEST-NAME ())
19 (define-test-suite SUITE-NAME ()
23 (register-test 'SUITE-NAME)
26 (defconst +pwd+ #.(make-pathname
27 :directory (pathname-directory
28 (or *compile-file-truename* *load-truename*))))
30 (defconst +golden-file-name+
31 (merge-pathnames "golden_message.data" +pwd+))
33 (defconst +golden-packed-file-name+
34 (merge-pathnames "golden_packed_message.data" +pwd+))
36 (defparameter *optional-field-info*
37 ;; field name, default value, value set by tests
38 '((optional-int32 0 101) (optional-int64 0 102)
39 (optional-uint32 0 103) (optional-uint64 0 104)
40 (optional-sint32 0 105) (optional-sint64 0 106)
41 (optional-fixed32 0 107) (optional-fixed64 0 108)
42 (optional-sfixed32 0 109) (optional-sfixed64 0 110)
43 (optional-float 0s0 111s0) (optional-double 0d0 112d0)
45 (optional-string "" "115") (optional-bytes "" "116")
46 (optional-nested-enum #.pb:+testalltypes-nestedenum-foo+ #.pb:+testalltypes-nestedenum-baz+)
47 (optional-foreign-enum #.pb:+foreignenum-foreign-foo+ #.pb:+foreignenum-foreign-baz+)
48 (optional-import-enum #.pb:+importenum-import-foo+ #.pb:+importenum-import-baz+)
49 ;; XXXX: C++ test does not verify these fields.
50 (optional-string-piece "" "124") (optional-cord "" "125")
53 (defparameter *default-field-info*
54 ;; field name, default value, value set by tests
55 '((default-int32 41 401) (default-int64 42 402)
56 (default-uint32 43 403) (default-uint64 44 404)
57 (default-sint32 -45 405) (default-sint64 46 406)
58 (default-fixed32 47 407) (default-fixed64 48 408)
59 (default-sfixed32 49 409) (default-sfixed64 -50 410)
60 (default-float 51.5s0 411s0) (default-double 52d3 412d0)
62 (default-string "hello" "415") (default-bytes "world" "416")
63 (default-nested-enum #.pb:+testalltypes-nestedenum-bar+ #.pb:+testalltypes-nestedenum-foo+)
64 (default-foreign-enum #.pb:+foreignenum-foreign-bar+ #.pb:+foreignenum-foreign-foo+)
65 (default-import-enum #.pb:+importenum-import-bar+ #.pb:+importenum-import-foo+)
66 ;; XXXX: C++ test does not verify these fields.
67 (default-string-piece "abc" "424") (default-cord "123" "425")
70 (defparameter *repeated-field-info*
71 ;; field name, default value, value set by tests, modification value
72 '((repeated-int32 201 301 501) (repeated-int64 202 302 502)
73 (repeated-uint32 203 303 503) (repeated-uint64 204 304 504)
74 (repeated-sint32 205 305 505) (repeated-sint64 206 306 506)
75 (repeated-fixed32 207 307 507) (repeated-fixed64 208 308 508)
76 (repeated-sfixed32 209 309 509) (repeated-sfixed64 210 310 510)
77 (repeated-float 211s0 311s0 511s0) (repeated-double 212d0 312d0 512d0)
78 (repeated-bool t nil t)
80 #.(base:string-to-utf8-octets "215")
81 #.(base:string-to-utf8-octets "315")
82 #.(base:string-to-utf8-octets "515"))
84 #.(base:string-to-utf8-octets "216")
85 #.(base:string-to-utf8-octets "316")
86 #.(base:string-to-utf8-octets "516"))
88 #.pb:+testalltypes-nestedenum-bar+
89 #.pb:+testalltypes-nestedenum-baz+
90 #.pb:+testalltypes-nestedenum-foo+)
91 (repeated-foreign-enum
92 #.pb:+foreignenum-foreign-bar+
93 #.pb:+foreignenum-foreign-baz+
94 #.pb:+foreignenum-foreign-foo+)
96 #.pb:+importenum-import-bar+
97 #.pb:+importenum-import-baz+
98 #.pb:+importenum-import-foo+)
99 ;; XXXX: C++ test does not verify these fields.
100 (repeated-string-piece
101 #.(base:string-to-utf8-octets "224")
102 #.(base:string-to-utf8-octets "324")
103 #.(base:string-to-utf8-octets "524"))
105 #.(base:string-to-utf8-octets "225")
106 #.(base:string-to-utf8-octets "325")
107 #.(base:string-to-utf8-octets "525"))
110 (defun field-equal (x y)
111 (cond ((stringp x) (and (stringp y) (string= x y)))
112 ((vectorp x) (equalp x y))
115 (defun field-function (prefix field)
116 (let ((symbol-name (concatenate 'string prefix (symbol-name field)))
117 (package (find-package "PROTOCOL-BUFFER")))
118 (symbol-function (find-symbol symbol-name package))))
120 (defun field-setter (field)
121 (let ((package (find-package "PROTOCOL-BUFFER")))
122 (fdefinition `(setf ,(find-symbol (symbol-name field) package)))))
124 (defun expect-all-fields-set (m)
125 ;; optional and default fields
126 (let ((field-info (append *optional-field-info* *default-field-info*)))
127 (loop for (field . values) in field-info do
128 (let ((has (field-function "HAS-" field))
129 (accessor (field-function "" field))
130 (value (second values)))
131 (assert (funcall has m))
132 (assert (field-equal (funcall accessor m) value)))))
134 (assert (pb:has-optionalgroup m))
135 (assert (pb:has-a (pb:optionalgroup m)))
136 (assert (= (pb:a (pb:optionalgroup m)) 117))
138 (assert (pb:has-optional-nested-message m))
139 (assert (pb:has-bb (pb:optional-nested-message m)))
140 (assert (= (pb:bb (pb:optional-nested-message m)) 118))
142 (assert (pb:has-optional-foreign-message m))
143 (assert (pb:has-c (pb:optional-foreign-message m)))
144 (assert (= (pb:c (pb:optional-foreign-message m)) 119))
146 (assert (pb:has-optional-import-message m))
147 (assert (pb:has-d (pb:optional-import-message m)))
148 (assert (= (pb:d (pb:optional-import-message m)) 120))
151 (let ((field-info *repeated-field-info*))
152 (loop for (field . values) in field-info do
153 (let ((accessor (field-function "" field))
155 (v1 (second values)))
156 (assert (= (length (funcall accessor m)) 2))
157 (assert (field-equal (aref (funcall accessor m) 0) v0))
158 (assert (field-equal (aref (funcall accessor m) 1) v1)))))
159 (let ((v (pb:repeatedgroup m)))
160 (assert (= (length v) 2))
161 (assert (= (pb:a (aref v 0)) 217))
162 (assert (= (pb:a (aref v 1)) 317)))
163 (let ((v (pb:repeated-nested-message m)))
164 (assert (= (length v) 2))
165 (assert (= (pb:bb (aref v 0)) 218))
166 (assert (= (pb:bb (aref v 1)) 318)))
167 (let ((v (pb:repeated-foreign-message m)))
168 (assert (= (length v) 2))
169 (assert (= (pb:c (aref v 0)) 219))
170 (assert (= (pb:c (aref v 1)) 319)))
171 (let ((v (pb:repeated-import-message m)))
172 (assert (= (length v) 2))
173 (assert (= (pb:d (aref v 0)) 220))
174 (assert (= (pb:d (aref v 1)) 320))))
176 (defconst +packed-field-info+
177 '((packed-int32 601 701) (packed-int64 602 702)
178 (packed-uint32 603 703) (packed-uint64 604 704)
179 (packed-sint32 605 705) (packed-sint64 606 706)
180 (packed-fixed32 607 707) (packed-fixed64 608 708)
181 (packed-sfixed32 609 709) (packed-sfixed64 610 710)
182 (packed-float 611s0 711s0) (packed-double 612d0 712d0)
184 (packed-enum #.pb:+foreignenum-foreign-bar+ #.pb:+foreignenum-foreign-baz+)))
186 (defun expect-packed-fields-set (m)
187 (loop for (field . values) in +packed-field-info+ do
188 (let ((accessor (field-function "" field))
190 (v1 (second values)))
191 (assert (= (length (funcall accessor m)) 2))
192 (assert (field-equal (aref (funcall accessor m) 0) v0))
193 (assert (field-equal (aref (funcall accessor m) 1) v1)))))
195 (defun read-message (class-name file-name)
196 (let ((message (make-instance class-name)))
197 (with-open-file (input file-name
198 :direction :input :element-type 'unsigned-byte)
199 (let* ((size (file-length input))
200 (buffer (make-byte-vector size)))
201 (read-sequence buffer input)
202 (pb:merge-from-array message buffer 0 size)))
205 (defun test-parse-from-file ()
206 (let ((message (read-message 'pb:testalltypes +golden-file-name+)))
207 (expect-all-fields-set message)))
209 (defun test-parse-packed-from-file ()
210 (let ((message (read-message 'pb:testpackedtypes +golden-packed-file-name+)))
211 (expect-packed-fields-set message)))
213 (defun set-all-fields (m)
214 ;; optional and default fields
215 (let ((field-info (append *optional-field-info* *default-field-info*)))
216 (loop for (field . values) in field-info do
217 (let ((setter (field-setter field))
218 (value (second values)))
219 (funcall setter value m))))
220 (setf (pb:a (pb:optionalgroup m)) 117)
221 (setf (pb:bb (pb:optional-nested-message m)) 118)
222 (setf (pb:c (pb:optional-foreign-message m)) 119)
223 (setf (pb:d (pb:optional-import-message m)) 120)
226 (let ((field-info *repeated-field-info*))
227 (loop for (field . values) in field-info do
228 (let ((accessor (field-function "" field))
230 (v1 (second values)))
231 (vector-push-extend v0 (funcall accessor m))
232 (vector-push-extend v1 (funcall accessor m)))))
233 (let ((v0 (make-instance 'pb:testalltypes-repeatedgroup))
234 (v1 (make-instance 'pb:testalltypes-repeatedgroup)))
237 (vector-push-extend v0 (pb:repeatedgroup m))
238 (vector-push-extend v1 (pb:repeatedgroup m)))
239 (let ((v0 (make-instance 'pb:testalltypes-nestedmessage))
240 (v1 (make-instance 'pb:testalltypes-nestedmessage)))
241 (setf (pb:bb v0) 218)
242 (setf (pb:bb v1) 318)
243 (vector-push-extend v0 (pb:repeated-nested-message m))
244 (vector-push-extend v1 (pb:repeated-nested-message m)))
245 (let ((v0 (make-instance 'pb:foreignmessage))
246 (v1 (make-instance 'pb:foreignmessage)))
249 (vector-push-extend v0 (pb:repeated-foreign-message m))
250 (vector-push-extend v1 (pb:repeated-foreign-message m)))
251 (let ((v0 (make-instance 'pb:importmessage))
252 (v1 (make-instance 'pb:importmessage)))
255 (vector-push-extend v0 (pb:repeated-import-message m))
256 (vector-push-extend v1 (pb:repeated-import-message m))))
258 (defun test-parse-helpers ()
259 (let ((m1 (make-instance 'pb:testalltypes))
260 (m2 (make-instance 'pb:testalltypes)))
262 (expect-all-fields-set m1)
263 (let* ((size (pb:octet-size m1))
264 (buffer (make-byte-vector size)))
265 (pb:serialize m1 buffer 0 size)
266 (pb:merge-from-array m2 buffer 0 size)
267 (expect-all-fields-set m2))))
269 (defun expect-clear (m)
270 ;; optional and default fields
271 (let ((field-info (append *optional-field-info* *default-field-info*)))
272 (loop for (field . values) in field-info do
273 (let ((has (field-function "HAS-" field))
274 (accessor (field-function "" field))
275 (default-value (first values)))
276 (assert (not (funcall has m)))
277 (assert (field-equal (funcall accessor m) default-value)))))
279 (assert (not (pb:has-optionalgroup m)))
280 (assert (not (pb:has-a (pb:optionalgroup m))))
281 (assert (= (pb:a (pb:optionalgroup m)) 0))
283 (assert (not (pb:has-optional-nested-message m)))
284 (assert (not (pb:has-bb (pb:optional-nested-message m))))
285 (assert (= (pb:bb (pb:optional-nested-message m)) 0))
287 (assert (not (pb:has-optional-foreign-message m)))
288 (assert (not (pb:has-c (pb:optional-foreign-message m))))
289 (assert (= (pb:c (pb:optional-foreign-message m)) 0))
291 (assert (not (pb:has-optional-import-message m)))
292 (assert (not (pb:has-d (pb:optional-import-message m))))
293 (assert (= (pb:d (pb:optional-import-message m)) 0))
296 (let ((field-info *repeated-field-info*))
297 (loop for (field . nil) in field-info do
298 (let ((accessor (field-function "" field)))
299 (assert (zerop (length (funcall accessor m))))))))
301 (defun modify-repeated-fields (m)
302 (let ((field-info *repeated-field-info*))
303 (loop for (field . values) in field-info do
304 (let ((accessor (field-function "" field))
306 (setf (aref (funcall accessor m) 1) v))))
307 (setf (pb:a (aref (pb:repeatedgroup m) 1)) 517)
308 (setf (pb::bb (aref (pb:repeated-nested-message m) 1)) 518)
309 (setf (pb::c (aref (pb:repeated-foreign-message m) 1)) 519)
310 (setf (pb::d (aref (pb:repeated-import-message m) 1)) 520))
312 (defun expect-repeated-fields-modified (m)
313 (let ((field-info *repeated-field-info*))
314 (loop for (field . values) in field-info do
315 (let ((accessor (field-function "" field))
318 (assert (= (length (funcall accessor m)) 2))
319 (assert (field-equal (aref (funcall accessor m) 0) v0))
320 (assert (field-equal (aref (funcall accessor m) 1) v1)))))
321 (let ((v (pb:repeatedgroup m)))
322 (assert (= (length v) 2))
323 (assert (= (pb:a (aref v 0)) 217))
324 (assert (= (pb:a (aref v 1)) 517)))
325 (let ((v (pb:repeated-nested-message m)))
326 (assert (= (length v) 2))
327 (assert (= (pb:bb (aref v 0)) 218))
328 (assert (= (pb:bb (aref v 1)) 518)))
329 (let ((v (pb:repeated-foreign-message m)))
330 (assert (= (length v) 2))
331 (assert (= (pb:c (aref v 0)) 219))
332 (assert (= (pb:c (aref v 1)) 519)))
333 (let ((v (pb:repeated-import-message m)))
334 (assert (= (length v) 2))
335 (assert (= (pb:d (aref v 0)) 220))
336 (assert (= (pb:d (aref v 1)) 520))))
338 (defun test-modify-repeated-fields ()
339 (let ((m (make-instance 'pb:testalltypes)))
342 (expect-all-fields-set m)
343 (modify-repeated-fields m)
344 (expect-repeated-fields-modified m)
348 (defun test-serialize-and-merge ()
349 (let ((m1 (make-instance 'pb:testalltypes))
350 (m2 (make-instance 'pb:testalltypes))
351 (m3 (make-instance 'pb:testalltypes)))
354 (pb:merge-from-message m2 m1)
355 (let* ((size (pb:octet-size m1))
356 (buffer (make-byte-vector size)))
357 (pb:serialize m1 buffer 0 size)
358 (pb:merge-from-array m3 buffer 0 size))
359 (expect-all-fields-set m2)
360 (expect-all-fields-set m3)))
363 (test-parse-from-file)
364 (test-parse-packed-from-file)
366 (test-modify-repeated-fields)
367 (test-serialize-and-merge)