tests/full-tests.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;; Based on original work by Robert Brown                           ;;;
   9 ;;;                                                                  ;;;
  10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11
  12 (in-package "PROTO-TEST")
  13
  14
  15 ;;; Comprehensive functionality unit tests
  16
  17 (define-test TEST-NAME ())
  18
  19 (define-test-suite SUITE-NAME ()
  20   (TEST-NAME)
  21   ...)
  22
  23 (register-test 'SUITE-NAME)
  24
  25
  26 (defconst +pwd+ #.(make-pathname
  27                    :directory (pathname-directory
  28                                (or *compile-file-truename* *load-truename*))))
  29
  30 (defconst +golden-file-name+
  31   (merge-pathnames "golden_message.data" +pwd+))
  32
  33 (defconst +golden-packed-file-name+
  34   (merge-pathnames "golden_packed_message.data" +pwd+))
  35
  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)
  44     (optional-bool nil t)
  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")
  51     ))
  52
  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)
  61     (default-bool t nil)
  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")
  68     ))
  69
  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)
  79     (repeated-string
  80      #.(base:string-to-utf8-octets "215")
  81      #.(base:string-to-utf8-octets "315")
  82      #.(base:string-to-utf8-octets "515"))
  83     (repeated-bytes
  84      #.(base:string-to-utf8-octets "216")
  85      #.(base:string-to-utf8-octets "316")
  86      #.(base:string-to-utf8-octets "516"))
  87     (repeated-nested-enum
  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+)
  95     (repeated-import-enum
  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"))
 104     (repeated-cord
 105      #.(base:string-to-utf8-octets "225")
 106      #.(base:string-to-utf8-octets "325")
 107      #.(base:string-to-utf8-octets "525"))
 108     ))
 109
 110 (defun field-equal (x y)
 111   (cond ((stringp x) (and (stringp y) (string= x y)))
 112         ((vectorp x) (equalp x y))
 113         (t (eql x y))))
 114
 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))))
 119
 120 (defun field-setter (field)
 121   (let ((package (find-package "PROTOCOL-BUFFER")))
 122     (fdefinition `(setf ,(find-symbol (symbol-name field) package)))))
 123
 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)))))
 133
 134   (assert (pb:has-optionalgroup m))
 135   (assert (pb:has-a (pb:optionalgroup m)))
 136   (assert (= (pb:a (pb:optionalgroup m)) 117))
 137
 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))
 141
 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))
 145
 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))
 149
 150   ;; repeated fields
 151   (let ((field-info *repeated-field-info*))
 152     (loop for (field . values) in field-info do
 153           (let ((accessor (field-function "" field))
 154                 (v0 (first values))
 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))))
 175
 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)
 183     (packed-bool t nil)
 184     (packed-enum #.pb:+foreignenum-foreign-bar+ #.pb:+foreignenum-foreign-baz+)))
 185
 186 (defun expect-packed-fields-set (m)
 187   (loop for (field . values) in +packed-field-info+ do
 188         (let ((accessor (field-function "" field))
 189               (v0 (first values))
 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)))))
 194
 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)))
 203     message))
 204
 205 (defun test-parse-from-file ()
 206   (let ((message (read-message 'pb:testalltypes +golden-file-name+)))
 207     (expect-all-fields-set message)))
 208
 209 (defun test-parse-packed-from-file ()
 210   (let ((message (read-message 'pb:testpackedtypes +golden-packed-file-name+)))
 211     (expect-packed-fields-set message)))
 212
 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)
 224
 225   ;; repeated fields
 226   (let ((field-info *repeated-field-info*))
 227     (loop for (field . values) in field-info do
 228           (let ((accessor (field-function "" field))
 229                 (v0 (first values))
 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)))
 235     (setf (pb:a v0) 217)
 236     (setf (pb:a v1) 317)
 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)))
 247     (setf (pb:c v0) 219)
 248     (setf (pb:c v1) 319)
 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)))
 253     (setf (pb:d v0) 220)
 254     (setf (pb:d v1) 320)
 255     (vector-push-extend v0 (pb:repeated-import-message m))
 256     (vector-push-extend v1 (pb:repeated-import-message m))))
 257
 258 (defun test-parse-helpers ()
 259   (let ((m1 (make-instance 'pb:testalltypes))
 260         (m2 (make-instance 'pb:testalltypes)))
 261     (set-all-fields m1)
 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))))
 268
 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)))))
 278
 279   (assert (not (pb:has-optionalgroup m)))
 280   (assert (not (pb:has-a (pb:optionalgroup m))))
 281   (assert (= (pb:a (pb:optionalgroup m)) 0))
 282
 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))
 286
 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))
 290
 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))
 294
 295   ;; repeated fields
 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))))))))
 300
 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))
 305                 (v (third values)))
 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))
 311
 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))
 316                 (v0 (first values))
 317                 (v1 (third values)))
 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))))
 337
 338 (defun test-modify-repeated-fields ()
 339   (let ((m (make-instance 'pb:testalltypes)))
 340     (expect-clear m)
 341     (set-all-fields m)
 342     (expect-all-fields-set m)
 343     (modify-repeated-fields m)
 344     (expect-repeated-fields-modified m)
 345     (pb:clear m)
 346     (expect-clear m)))
 347
 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)))
 352     (set-all-fields m1)
 353     (pb:clear m2)
 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)))
 361
 362 (defun test ()
 363   (test-parse-from-file)
 364   (test-parse-packed-from-file)
 365   (test-parse-helpers)
 366   (test-modify-repeated-fields)
 367   (test-serialize-and-merge)
 368   (print "PASS")
 369   (values))