tests/lisp-extend-test.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: Alejandro Sedeño                                ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-TEST")
  12
  13 (define-test extend-test ()
  14   (let* ((schema (proto:find-schema "ExtendTest"))
  15          (imported-schema (proto:find-schema "ExtendTestBase"))
  16          (foo (proto:find-message schema "Foo"))
  17          (bar (proto:find-message schema "Bar"))
  18          (quux (proto:find-message schema "Quux"))
  19          (ifoo (proto:find-message imported-schema "Foo"))
  20          (ibar (proto:find-message imported-schema "Bar"))
  21          (ibaz (proto:find-message imported-schema "Baz")))
  22     (destructuring-bind (local-local local-import import-local import-import)
  23         (proto-impl:proto-extenders bar)
  24       ;; Are we extending the right message?
  25       (assert-equal (proto-impl:proto-class local-local)
  26                     (proto-impl:proto-class foo))
  27       (assert-equal (proto-impl:proto-class local-import)
  28                     (proto-impl:proto-class foo))
  29       (assert-equal (proto-impl:proto-class import-local)
  30                     (proto-impl:proto-class ifoo))
  31       (assert-equal (proto-impl:proto-class import-import)
  32                     (proto-impl:proto-class ifoo))
  33       ;; Is the extended field of the right type?
  34       (assert-equal (proto-impl:proto-class
  35                      (first (proto-impl:proto-extended-fields local-local)))
  36                     (proto-impl:proto-class bar))
  37       (assert-equal (proto-impl:proto-class
  38                      (first (proto-impl:proto-extended-fields local-import)))
  39                     (proto-impl:proto-class ibar))
  40       (assert-equal (proto-impl:proto-class
  41                      (first (proto-impl:proto-extended-fields import-local)))
  42                     (proto-impl:proto-class bar))
  43       (assert-equal (proto-impl:proto-class
  44                      (first (proto-impl:proto-extended-fields import-import)))
  45                     (proto-impl:proto-class ibar)))
  46     ;; Smaller stand-alone test
  47     (let ((ebaz (first (proto-extenders quux))))
  48       (assert-equal (proto-impl:proto-class ebaz) (proto-impl:proto-class ibaz))
  49       (assert-equal (proto-impl:proto-class (first (proto-extended-fields ebaz)))
  50                     (proto-impl:proto-class quux)))))
  51
  52 (register-test 'extend-test)