tests/lisp-reference-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: Ben Wagner                                      ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-TEST")
  12
  13 (define-test cross-package-reference-test ()
  14   (flet ((find-by-name (name proto-objects)
  15            (find name proto-objects :key #'proto-name :test #'string=)))
  16     (let* ((schema (find-schema :package_test1))
  17            (message-with-cross-package-reference
  18             (find-by-name "MessageWithCrossPackageReference" (proto-messages schema)))
  19            (baz (find-by-name "baz" (proto-fields message-with-cross-package-reference)))
  20            (bonk (find-by-name "bonk" (proto-fields message-with-cross-package-reference)))
  21            (bam (find-by-name "bam" (proto-fields message-with-cross-package-reference)))
  22            (bing (find-by-name "bing" (proto-fields message-with-cross-package-reference)))
  23            (message-with-cross-package-extension
  24             (find-by-name "MessageWithCrossPackageExtension" (proto-messages schema)))
  25            (boo (find-by-name "boo" (proto-fields message-with-cross-package-extension)))
  26            (service-with-cross-package-input-output
  27             (find-by-name "ServiceWithCrossPackageInputOutput" (proto-services schema)))
  28            (bloop (find-by-name "Bloop" (proto-methods service-with-cross-package-input-output)))
  29            (beep (find-by-name "Beep" (proto-methods service-with-cross-package-input-output)))
  30            (message-in-other-package-extend
  31             (find-by-name "MessageInOtherPackage"
  32                           (proto-messages message-with-cross-package-extension)))
  33            (baa (find-by-name "baa" (proto-extended-fields message-in-other-package-extend))))
  34       (assert-equal 'protobuf-package-unittest2::message-in-other-package
  35                     (proto-class baz))
  36       (assert-equal 'protobuf-package-unittest2::enum-in-other-package
  37                     (proto-class bonk))
  38       (assert-equal 'protobuf-package-unittest1::message-defined-in-both-packages
  39                     (proto-class bam))
  40       (assert-equal 'protobuf-package-unittest2::message-defined-in-both-packages
  41                     (proto-class bing))
  42       (assert-equal 'protobuf-package-unittest2::message-in-other-package
  43                     (proto-class boo))
  44       (assert-equal 'protobuf-package-unittest2::message-in-other-package
  45                     (proto-input-type bloop))
  46       (assert-equal 'protobuf-package-unittest1::message-with-cross-package-reference
  47                     (proto-output-type bloop))
  48       (assert-equal 'protobuf-package-unittest1::message-with-cross-package-reference
  49                     (proto-input-type beep))
  50       (assert-equal 'protobuf-package-unittest2::message-in-other-package
  51                     (proto-output-type beep))
  52       (assert-equal 'protobuf-package-unittest1::baa
  53                     (proto-value baa))))
  54
  55   (let* ((orig1 (make-instance 'protobuf-package-unittest1::message-with-cross-package-reference
  56                   :baz (make-instance 'protobuf-package-unittest2::message-in-other-package
  57                          :foo 123)
  58                   :bonk :bar
  59                   :bam (make-instance 'protobuf-package-unittest1::message-defined-in-both-packages
  60                          :boom "bomb")
  61                   :bing (make-instance 'protobuf-package-unittest2::message-defined-in-both-packages
  62                           :bang "gun")))
  63          (orig2 (let ((extended-obj (make-instance 'protobuf-package-unittest2::message-in-other-package
  64                                       :foo 123)))
  65                   (setf (protobuf-package-unittest1::baa extended-obj) 456)
  66                   (make-instance 'protobuf-package-unittest1::message-with-cross-package-extension
  67                     :boo extended-obj)))
  68          (bytes1 (serialize-object-to-bytes orig1
  69                                             'protobuf-package-unittest1::message-with-cross-package-reference))
  70          (bytes2 (serialize-object-to-bytes orig2
  71                                             'protobuf-package-unittest1::message-with-cross-package-extension))
  72          (new1 (deserialize-object 'protobuf-package-unittest1::message-with-cross-package-reference
  73                                    bytes1))
  74          (new2 (deserialize-object 'protobuf-package-unittest1::message-with-cross-package-extension
  75                                    bytes2)))
  76     (assert-true (typep (protobuf-package-unittest1::baz new1)
  77                         'protobuf-package-unittest2::message-in-other-package))
  78     (assert-equal 123
  79                   (protobuf-package-unittest2::foo (protobuf-package-unittest1::baz new1)))
  80     (assert-equal :bar
  81                   (protobuf-package-unittest1::bonk new1))
  82     (assert-equal "bomb"
  83                   (protobuf-package-unittest1::boom (protobuf-package-unittest1::bam new1)))
  84     (assert-equal "gun"
  85                   (protobuf-package-unittest2::bang (protobuf-package-unittest1::bing new1)))
  86     (assert-true (typep (protobuf-package-unittest1::boo new2)
  87                         'protobuf-package-unittest2::message-in-other-package))
  88     (assert-equal 123
  89                   (protobuf-package-unittest2::foo (protobuf-package-unittest1::boo new2)))
  90     (assert-equal 456
  91                   (protobuf-package-unittest1::baa (protobuf-package-unittest1::boo new2)))))
  92
  93 (define-test forward-reference-test ()
  94   (flet ((find-by-name (name proto-objects)
  95            (find name proto-objects :key #'proto-name :test #'string=)))
  96     (let* ((schema (find-schema :forward_reference))
  97            (message-with-forward-reference
  98             (find-by-name "MessageWithForwardReference" (proto-messages schema)))
  99            (foo (find-by-name "foo" (proto-fields message-with-forward-reference)))
 100            (bar (find-by-name "bar" (proto-fields message-with-forward-reference)))
 101            (service-with-forward-reference
 102             (find-by-name "ServiceWithForwardReference" (proto-services schema)))
 103            (bloop (find-by-name "Bloop" (proto-methods service-with-forward-reference)))
 104            (beep (find-by-name "Beep" (proto-methods service-with-forward-reference))))
 105       (assert-equal 'protobuf-forward-reference-unittest::msg-w-overridden-lisp-class
 106                     (proto-class foo))
 107       (assert-equal 'protobuf-forward-reference-unittest::ENUM-W-OVERRIDDEN-LISP-CLASS
 108                     (proto-class bar))
 109       (assert-equal 'protobuf-forward-reference-unittest::MSG-W-OVERRIDDEN-LISP-CLASS
 110                     (proto-input-type bloop))
 111       (assert-equal 'protobuf-forward-reference-unittest::MESSAGE-WITH-FORWARD-REFERENCE
 112                     (proto-output-type bloop))
 113       (assert-equal 'protobuf-forward-reference-unittest::MESSAGE-WITH-FORWARD-REFERENCE
 114                     (proto-input-type beep))
 115       (assert-equal 'protobuf-forward-reference-unittest::MSG-W-OVERRIDDEN-LISP-CLASS
 116                     (proto-output-type beep))))
 117   (let* ((orig (make-instance 'protobuf-forward-reference-unittest::message-with-forward-reference
 118                  :foo (make-instance 'protobuf-forward-reference-unittest::msg-w-overridden-lisp-class
 119                         :baz 123)
 120                  :bar :baa))
 121          (bytes (serialize-object-to-bytes orig
 122                                            'protobuf-forward-reference-unittest::message-with-forward-reference))
 123          (new (deserialize-object 'protobuf-forward-reference-unittest::message-with-forward-reference
 124                                    bytes)))
 125     (assert-true (typep (protobuf-forward-reference-unittest::foo new)
 126                         'protobuf-forward-reference-unittest::msg-w-overridden-lisp-class))
 127     (assert-equal 123
 128                   (protobuf-forward-reference-unittest::baz (protobuf-forward-reference-unittest::foo new)))
 129     (assert-equal :baa
 130                   (protobuf-forward-reference-unittest::bar new))))
 131
 132 (defparameter *test-proto-preamble*
 133   "syntax = \"proto2\";
 134
 135 package proto_test;
 136
 137 message DefinedMessage {
 138   optional string foo = 1;
 139 }
 140
 141 ")
 142
 143
 144 (define-test undefined-types-test ()
 145   (labels ((parse-schema-containing (string)
 146              (with-input-from-string (s (concatenate 'string *test-proto-preamble* string))
 147                (parse-schema-from-stream s
 148                                          ;; Parsing from a string doesn't produce a name, so supply
 149                                          ;; it
 150                                          :name "proto_test"
 151                                          :class 'dummy
 152                                          :conc-name nil)))
 153            (parse-message-with-field-type (type)
 154              (parse-schema-containing (format nil "message MessageWithUndefinedFieldType {~%~
 155                                                    ~&  optional ~A bar = 1;~%~
 156                                                    }~%" type)))
 157            (parse-service-with-rpc (rpc)
 158              (parse-schema-containing (format nil "service ServiceWithUndefinedMethodType {~%~
 159                                                    ~&  ~A~%~
 160                                                    }~%" rpc)))
 161            (poor-mans-assert-regex-equal (expected-strings actual-string)
 162              (assert-true
 163               (loop with index = 0
 164                     for expected-string in expected-strings
 165                     as position = (search expected-string actual-string :start2 index)
 166                     always position
 167                     do (setf index (+ position (length expected-string))))))
 168            (do-field-test (field-type)
 169              (let ((condition (assert-error undefined-field-type
 170                                 (parse-message-with-field-type field-type))))
 171                (poor-mans-assert-regex-equal
 172                 (list "Undefined type: Field "
 173                       "BAR"
 174                       "in message "
 175                       "MESSAGE-WITH-UNDEFINED-FIELD-TYPE"
 176                       (format nil "has unknown type ~A" field-type))
 177                 (princ-to-string condition))
 178                (assert-equal field-type (error-type-name condition))
 179                (assert-equal "bar" (proto-name (error-field condition)))))
 180            (method-test-assertions (condition where method-lisp-name method-proto-name type)
 181              (poor-mans-assert-regex-equal
 182               (list (format nil "Undefined type: ~A type for RPC " where)
 183                     (format nil "~A" method-lisp-name)
 184                     "in service "
 185                     "ServiceWithUndefinedMethodType"
 186                     (format nil "has unknown type ~A" type))
 187               (princ-to-string condition))
 188              (assert-equal type (error-type-name condition))
 189              (assert-equal method-proto-name (proto-name (error-method condition))))
 190            (do-method-input-test (input-type)
 191              (let ((condition (assert-error undefined-input-type
 192                                 (parse-service-with-rpc
 193                                  (format nil "rpc MethodWithUndefinedInput (~A) ~
 194                                               returns (DefinedMessage);" input-type)))))
 195                (method-test-assertions condition "Input" "METHOD-WITH-UNDEFINED-INPUT"
 196                                        "MethodWithUndefinedInput" input-type)))
 197            (do-method-output-test (output-type)
 198              (let ((condition (assert-error undefined-output-type
 199                                 (parse-service-with-rpc
 200                                  (format nil "rpc MethodWithUndefinedOutput (DefinedMessage) ~
 201                                               returns (~A);" output-type)))))
 202                (method-test-assertions condition "Output" "METHOD-WITH-UNDEFINED-OUTPUT"
 203                                        "MethodWithUndefinedOutput" output-type)))
 204            (do-method-stream-test (stream-type)
 205              (let ((condition (assert-error undefined-stream-type
 206                                 (parse-service-with-rpc
 207                                  (format nil "rpc MethodWithUndefinedStream (DefinedMessage) ~
 208                                               returns (DefinedMessage) {~
 209                                               ~&    option stream_type = \"~A\";~
 210                                               ~&  };" stream-type)))))
 211                (method-test-assertions condition "Stream" "METHOD-WITH-UNDEFINED-STREAM"
 212                                        "MethodWithUndefinedStream" stream-type))))
 213
 214     (parse-message-with-field-type "int32")
 215     (do-field-test "int")
 216     (parse-message-with-field-type "DefinedMessage")
 217     (do-field-test "UndefinedMessage")
 218     (do-field-test "other_package.DefinedMessage")
 219
 220     (parse-service-with-rpc
 221      "rpc MethodWithDefinedInputOutput (DefinedMessage) returns (DefinedMessage);")
 222     (do-method-input-test "UndefinedMessage")
 223     ;; my understanding is that primitive types are not allowed for method input/output; if this is
 224     ;; incorrect, change to "int"
 225     (do-method-input-test "int32")
 226     (do-method-input-test "other_package.DefinedMessage")
 227
 228     (do-method-output-test "UndefinedMessage")
 229     (do-method-output-test "int32")
 230     (do-method-output-test "other_package.DefinedMessage")
 231
 232     ;; stream_type is required to be fully qualified
 233     (parse-service-with-rpc (format nil "rpc MethodWithDefinedInputOutput (DefinedMessage) ~
 234                                          returns (DefinedMessage) {~
 235                                          ~&    option stream_type = \"proto_test.DefinedMessage\";~
 236                                          ~&  };"))
 237     (do-method-stream-test "proto_test.UndefinedMessage")
 238     (do-method-stream-test "int32")
 239     (do-method-stream-test "other_package.DefinedMessage")))
 240
 241
 242 (define-test-suite lisp-reference-tests ()
 243   (cross-package-reference-test
 244    forward-reference-test
 245    undefined-types-test))
 246
 247 (register-test 'lisp-reference-tests)