1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Free Software published under an MIT-like license. See LICENSE ;;;
5 ;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
7 ;;; Original author: Alejandro SedeƱo ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package "PROTO-TEST")
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)))))
52 (register-test 'extend-test)