Browse files

Generated protocol buffer code now lives in separate packages, the na…

…mes of

which are derived from the Java package name.

Protocol buffer function, such as IS-INITIALIZED, CLEAR, etc. continue to live
in the PROTOCOL-BUFFER package.

StudlyCaps field, message, and enum names are converted to hyphenated names.

String fields are stored as instances of %STRING-FIELD%, a hidden class.
Create new string fields with PB:STRING-FIELD.  Extract values from a string
field using PB:STRING-VALUE or PB:UTF8-STRING-VALUE.
  • Loading branch information...
1 parent 2fe74ca commit 35bb363ad581261f900bec45f155be0cbe184f8b @brown committed Feb 3, 2012
View
384 message-test.lisp
@@ -1,43 +1,45 @@
-
-;;;; message-test.lisp
-
-
-;; Copyright 2010, Google Inc. All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-
-;; * Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;; * Redistributions in binary form must reproduce the above
-;; copyright notice, this list of conditions and the following disclaimer
-;; in the documentation and/or other materials provided with the
-;; distribution.
-;; * Neither the name of Google Inc. nor the names of its
-;; contributors may be used to endorse or promote products derived from
-;; this software without specific prior written permission.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;; Copyright 2010 Google Inc. All Rights Reserved
+
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions are
+;;;; met:
+
+;;;; * Redistributions of source code must retain the above copyright
+;;;; notice, this list of conditions and the following disclaimer.
+;;;; * Redistributions in binary form must reproduce the above
+;;;; copyright notice, this list of conditions and the following disclaimer
+;;;; in the documentation and/or other materials provided with the
+;;;; distribution.
+;;;; * Neither the name of Google Inc. nor the names of its
+;;;; contributors may be used to endorse or promote products derived from
+;;;; this software without specific prior written permission.
+
+;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;;; Author: brown@google.com (Robert Brown)
+
+;;;; Test protocol buffer messages.
(in-package #:common-lisp-user)
(defpackage #:message-test
(:documentation "Tests for protocol buffer messages.")
(:use #:common-lisp
#:com.google.base
+ #:com.google.protobuf.test
#:hu.dwim.stefil
- #:protobuf-test-config)
+ #:protobuf-test-config
+ #:unittest-proto)
(:export #:test-message))
(in-package #:message-test)
@@ -54,228 +56,228 @@
(defconst +golden-packed-file-name+
(merge-pathnames "google/protobuf/testdata/golden_packed_fields_message" *base-directory*))
-(defconst +optional-field-info+
+(defun sf (string)
+ "Converts STRING into a protocol buffer string field value."
+ (pb:string-field string))
+
+(defun bf (string)
+ "Converts STRING into a protocol buffer byte field value."
+ (string-to-utf8-octets string))
+
+(defvar *optional-field-info*
;; field name, default value, value set by tests
- '((optional-int32 0 101) (optional-int64 0 102)
+ `((optional-int32 0 101) (optional-int64 0 102)
(optional-uint32 0 103) (optional-uint64 0 104)
(optional-sint32 0 105) (optional-sint64 0 106)
(optional-fixed32 0 107) (optional-fixed64 0 108)
(optional-sfixed32 0 109) (optional-sfixed64 0 110)
(optional-float 0f0 111f0) (optional-double 0d0 112d0)
(optional-bool nil t)
- (optional-string "" "115") (optional-bytes "" "116")
- (optional-nested-enum #.pb:+testalltypes-nestedenum-foo+ #.pb:+testalltypes-nestedenum-baz+)
- (optional-foreign-enum #.pb:+foreignenum-foreign-foo+ #.pb:+foreignenum-foreign-baz+)
- (optional-import-enum #.pb:+importenum-import-foo+ #.pb:+importenum-import-baz+)
+ (optional-string ,(sf "") ,(sf "115"))
+ (optional-bytes ,(bf "") ,(bf "116"))
+ (optional-nested-enum ,+test-all-types-nested-enum-foo+ ,+test-all-types-nested-enum-baz+)
+ (optional-foreign-enum ,+foreign-enum-foreign-foo+ ,+foreign-enum-foreign-baz+)
+ (optional-import-enum ,+import-enum-import-foo+ ,+import-enum-import-baz+)
;; XXXX: C++ test does not verify these fields.
- (optional-string-piece "" "124") (optional-cord "" "125")))
+ (optional-string-piece ,(sf "") ,(sf "124"))
+ (optional-cord ,(sf "") ,(sf "125"))))
-(defconst +default-field-info+
+(defvar *default-field-info*
;; field name, default value, value set by tests
- '((default-int32 41 401) (default-int64 42 402)
+ `((default-int32 41 401) (default-int64 42 402)
(default-uint32 43 403) (default-uint64 44 404)
(default-sint32 -45 405) (default-sint64 46 406)
(default-fixed32 47 407) (default-fixed64 48 408)
(default-sfixed32 49 409) (default-sfixed64 -50 410)
(default-float 51.5f0 411f0) (default-double 52d3 412d0)
(default-bool t nil)
- (default-string "hello" "415") (default-bytes "world" "416")
- (default-nested-enum #.pb:+testalltypes-nestedenum-bar+ #.pb:+testalltypes-nestedenum-foo+)
- (default-foreign-enum #.pb:+foreignenum-foreign-bar+ #.pb:+foreignenum-foreign-foo+)
- (default-import-enum #.pb:+importenum-import-bar+ #.pb:+importenum-import-foo+)
+ (default-string ,(sf "hello") ,(sf "415"))
+ (default-bytes ,(bf "world") ,(bf "416"))
+ (default-nested-enum ,+test-all-types-nested-enum-bar+ ,+test-all-types-nested-enum-foo+)
+ (default-foreign-enum ,+foreign-enum-foreign-bar+ ,+foreign-enum-foreign-foo+)
+ (default-import-enum ,+import-enum-import-bar+ ,+import-enum-import-foo+)
;; XXXX: C++ test does not verify these fields.
- (default-string-piece "abc" "424") (default-cord "123" "425")))
+ (default-string-piece ,(sf "abc") ,(sf "424"))
+ (default-cord ,(sf "123") ,(sf "425"))))
-(defconst +repeated-field-info+
+(defvar *repeated-field-info*
;; field name, default value, value set by tests, modification value
- '((repeated-int32 201 301 501) (repeated-int64 202 302 502)
+ `((repeated-int32 201 301 501) (repeated-int64 202 302 502)
(repeated-uint32 203 303 503) (repeated-uint64 204 304 504)
(repeated-sint32 205 305 505) (repeated-sint64 206 306 506)
(repeated-fixed32 207 307 507) (repeated-fixed64 208 308 508)
(repeated-sfixed32 209 309 509) (repeated-sfixed64 210 310 510)
(repeated-float 211f0 311f0 511f0) (repeated-double 212d0 312d0 512d0)
(repeated-bool t nil t)
- (repeated-string
- #.(string-to-utf8-octets "215")
- #.(string-to-utf8-octets "315")
- #.(string-to-utf8-octets "515"))
- (repeated-bytes
- #.(string-to-utf8-octets "216")
- #.(string-to-utf8-octets "316")
- #.(string-to-utf8-octets "516"))
+ (repeated-string ,(sf "215") ,(sf "315") ,(sf "515"))
+ (repeated-bytes ,(bf "216") ,(bf "316") ,(bf "516"))
(repeated-nested-enum
- #.pb:+testalltypes-nestedenum-bar+
- #.pb:+testalltypes-nestedenum-baz+
- #.pb:+testalltypes-nestedenum-foo+)
+ ,+test-all-types-nested-enum-bar+
+ ,+test-all-types-nested-enum-baz+
+ ,+test-all-types-nested-enum-foo+)
(repeated-foreign-enum
- #.pb:+foreignenum-foreign-bar+
- #.pb:+foreignenum-foreign-baz+
- #.pb:+foreignenum-foreign-foo+)
+ ,+foreign-enum-foreign-bar+
+ ,+foreign-enum-foreign-baz+
+ ,+foreign-enum-foreign-foo+)
(repeated-import-enum
- #.pb:+importenum-import-bar+
- #.pb:+importenum-import-baz+
- #.pb:+importenum-import-foo+)
+ ,+import-enum-import-bar+
+ ,+import-enum-import-baz+
+ ,+import-enum-import-foo+)
;; XXXX: C++ test does not verify these fields.
- (repeated-string-piece
- #.(string-to-utf8-octets "224")
- #.(string-to-utf8-octets "324")
- #.(string-to-utf8-octets "524"))
- (repeated-cord
- #.(string-to-utf8-octets "225")
- #.(string-to-utf8-octets "325")
- #.(string-to-utf8-octets "525"))))
-
-(defun field-equal (x y)
- (cond ((stringp x) (and (stringp y) (string= x y)))
- ((vectorp x) (equalp x y))
- (t (eql x y))))
+ (repeated-string-piece ,(sf "224") ,(sf "324") ,(sf "524"))
+ (repeated-cord ,(sf "225") ,(sf "325") ,(sf "525"))))
+
+(defun field-equal (value expected)
+ (cond ((eq (type-of expected) 'pb::%string-field%)
+ (is (string= (pb:string-value value) (pb:string-value expected))))
+ ((vectorp value) (is (equalp value expected)))
+ (t (is (eql value expected)))))
(defun field-function (prefix field)
- (let ((symbol-name (concatenate 'string prefix (symbol-name field)))
- (package (find-package "PROTOCOL-BUFFER")))
+ (let ((package (find-package 'unittest-proto))
+ (symbol-name (concatenate 'string prefix (symbol-name field))))
(symbol-function (find-symbol symbol-name package))))
(defun field-setter (field)
- (let ((package (find-package "PROTOCOL-BUFFER")))
+ (let ((package (find-package 'unittest-proto)))
(fdefinition `(setf ,(find-symbol (symbol-name field) package)))))
(defun expect-all-fields-set (m)
;; optional and default fields
- (let ((field-info (append +optional-field-info+ +default-field-info+)))
+ (let ((field-info (append *optional-field-info* *default-field-info*)))
(loop for (field . values) in field-info do
(let ((has (field-function "HAS-" field))
(accessor (field-function "" field))
(value (second values)))
(is (funcall has m))
- (is (field-equal (funcall accessor m) value)))))
+ (field-equal (funcall accessor m) value))))
- (is (pb:has-optionalgroup m))
- (is (pb:has-a (pb:optionalgroup m)))
- (is (= (pb:a (pb:optionalgroup m)) 117))
+ (is (has-optional-group m))
+ (is (has-a (optional-group m)))
+ (is (= (a (optional-group m)) 117))
- (is (pb:has-optional-nested-message m))
- (is (pb:has-bb (pb:optional-nested-message m)))
- (is (= (pb:bb (pb:optional-nested-message m)) 118))
+ (is (has-optional-nested-message m))
+ (is (has-bb (optional-nested-message m)))
+ (is (= (bb (optional-nested-message m)) 118))
- (is (pb:has-optional-foreign-message m))
- (is (pb:has-c (pb:optional-foreign-message m)))
- (is (= (pb:c (pb:optional-foreign-message m)) 119))
+ (is (has-optional-foreign-message m))
+ (is (has-c (optional-foreign-message m)))
+ (is (= (c (optional-foreign-message m)) 119))
- (is (pb:has-optional-import-message m))
- (is (pb:has-d (pb:optional-import-message m)))
- (is (= (pb:d (pb:optional-import-message m)) 120))
+ (is (has-optional-import-message m))
+ (is (has-d (optional-import-message m)))
+ (is (= (d (optional-import-message m)) 120))
;; repeated fields
- (let ((field-info +repeated-field-info+))
+ (let ((field-info *repeated-field-info*))
(loop for (field . values) in field-info do
(let ((accessor (field-function "" field))
(v0 (first values))
(v1 (second values)))
(is (= (length (funcall accessor m)) 2))
- (is (field-equal (aref (funcall accessor m) 0) v0))
- (is (field-equal (aref (funcall accessor m) 1) v1)))))
- (let ((v (pb:repeatedgroup m)))
+ (field-equal (aref (funcall accessor m) 0) v0)
+ (field-equal (aref (funcall accessor m) 1) v1))))
+ (let ((v (repeated-group m)))
(is (= (length v) 2))
- (is (= (pb:a (aref v 0)) 217))
- (is (= (pb:a (aref v 1)) 317)))
- (let ((v (pb:repeated-nested-message m)))
+ (is (= (a (aref v 0)) 217))
+ (is (= (a (aref v 1)) 317)))
+ (let ((v (repeated-nested-message m)))
(is (= (length v) 2))
- (is (= (pb:bb (aref v 0)) 218))
- (is (= (pb:bb (aref v 1)) 318)))
- (let ((v (pb:repeated-foreign-message m)))
+ (is (= (bb (aref v 0)) 218))
+ (is (= (bb (aref v 1)) 318)))
+ (let ((v (repeated-foreign-message m)))
(is (= (length v) 2))
- (is (= (pb:c (aref v 0)) 219))
- (is (= (pb:c (aref v 1)) 319)))
- (let ((v (pb:repeated-import-message m)))
+ (is (= (c (aref v 0)) 219))
+ (is (= (c (aref v 1)) 319)))
+ (let ((v (repeated-import-message m)))
(is (= (length v) 2))
- (is (= (pb:d (aref v 0)) 220))
- (is (= (pb:d (aref v 1)) 320))))
+ (is (= (d (aref v 0)) 220))
+ (is (= (d (aref v 1)) 320))))
-(defconst +packed-field-info+
- '((packed-int32 601 701) (packed-int64 602 702)
+(defvar *packed-field-info*
+ `((packed-int32 601 701) (packed-int64 602 702)
(packed-uint32 603 703) (packed-uint64 604 704)
(packed-sint32 605 705) (packed-sint64 606 706)
(packed-fixed32 607 707) (packed-fixed64 608 708)
(packed-sfixed32 609 709) (packed-sfixed64 610 710)
(packed-float 611f0 711f0) (packed-double 612d0 712d0)
(packed-bool t nil)
- (packed-enum #.pb:+foreignenum-foreign-bar+ #.pb:+foreignenum-foreign-baz+)))
+ (packed-enum ,+foreign-enum-foreign-bar+ ,+foreign-enum-foreign-baz+)))
(defun expect-packed-fields-set (m)
- (loop for (field . values) in +packed-field-info+ do
+ (loop for (field . values) in *packed-field-info* do
(let ((accessor (field-function "" field))
(v0 (first values))
(v1 (second values)))
(is (= (length (funcall accessor m)) 2))
- (is (field-equal (aref (funcall accessor m) 0) v0))
- (is (field-equal (aref (funcall accessor m) 1) v1)))))
+ (field-equal (aref (funcall accessor m) 0) v0)
+ (field-equal (aref (funcall accessor m) 1) v1))))
(defun read-message (class-name file-name)
(let ((message (make-instance class-name)))
- (with-open-file (input file-name
- :direction :input :element-type 'unsigned-byte)
+ (with-open-file (input file-name :direction :input :element-type 'unsigned-byte)
(let* ((size (file-length input))
(buffer (make-array size :element-type '(unsigned-byte 8))))
(read-sequence buffer input)
(pb:merge-from-array message buffer 0 size)))
message))
(deftest test-parse-from-file ()
- (let ((message (read-message 'pb:testalltypes +golden-file-name+)))
+ (let ((message (read-message 'test-all-types +golden-file-name+)))
(expect-all-fields-set message)))
(deftest test-parse-packed-from-file ()
- (let ((message (read-message 'pb:testpackedtypes +golden-packed-file-name+)))
+ (let ((message (read-message 'test-packed-types +golden-packed-file-name+)))
(expect-packed-fields-set message)))
(defun set-all-fields (m)
;; optional and default fields
- (let ((field-info (append +optional-field-info+ +default-field-info+)))
+ (let ((field-info (append *optional-field-info* *default-field-info*)))
(loop for (field . values) in field-info do
(let ((setter (field-setter field))
(value (second values)))
(funcall setter value m))))
- (setf (pb:a (pb:optionalgroup m)) 117)
- (setf (pb:bb (pb:optional-nested-message m)) 118)
- (setf (pb:c (pb:optional-foreign-message m)) 119)
- (setf (pb:d (pb:optional-import-message m)) 120)
+ (setf (a (optional-group m)) 117)
+ (setf (bb (optional-nested-message m)) 118)
+ (setf (c (optional-foreign-message m)) 119)
+ (setf (d (optional-import-message m)) 120)
;; repeated fields
- (let ((field-info +repeated-field-info+))
+ (let ((field-info *repeated-field-info*))
(loop for (field . values) in field-info do
(let ((accessor (field-function "" field))
(v0 (first values))
(v1 (second values)))
(vector-push-extend v0 (funcall accessor m))
(vector-push-extend v1 (funcall accessor m)))))
- (let ((v0 (make-instance 'pb:testalltypes-repeatedgroup))
- (v1 (make-instance 'pb:testalltypes-repeatedgroup)))
- (setf (pb:a v0) 217)
- (setf (pb:a v1) 317)
- (vector-push-extend v0 (pb:repeatedgroup m))
- (vector-push-extend v1 (pb:repeatedgroup m)))
- (let ((v0 (make-instance 'pb:testalltypes-nestedmessage))
- (v1 (make-instance 'pb:testalltypes-nestedmessage)))
- (setf (pb:bb v0) 218)
- (setf (pb:bb v1) 318)
- (vector-push-extend v0 (pb:repeated-nested-message m))
- (vector-push-extend v1 (pb:repeated-nested-message m)))
- (let ((v0 (make-instance 'pb:foreignmessage))
- (v1 (make-instance 'pb:foreignmessage)))
- (setf (pb:c v0) 219)
- (setf (pb:c v1) 319)
- (vector-push-extend v0 (pb:repeated-foreign-message m))
- (vector-push-extend v1 (pb:repeated-foreign-message m)))
- (let ((v0 (make-instance 'pb:importmessage))
- (v1 (make-instance 'pb:importmessage)))
- (setf (pb:d v0) 220)
- (setf (pb:d v1) 320)
- (vector-push-extend v0 (pb:repeated-import-message m))
- (vector-push-extend v1 (pb:repeated-import-message m))))
+ (let ((v0 (make-instance 'test-all-types-repeated-group))
+ (v1 (make-instance 'test-all-types-repeated-group)))
+ (setf (a v0) 217)
+ (setf (a v1) 317)
+ (vector-push-extend v0 (repeated-group m))
+ (vector-push-extend v1 (repeated-group m)))
+ (let ((v0 (make-instance 'test-all-types-nested-message))
+ (v1 (make-instance 'test-all-types-nested-message)))
+ (setf (bb v0) 218)
+ (setf (bb v1) 318)
+ (vector-push-extend v0 (repeated-nested-message m))
+ (vector-push-extend v1 (repeated-nested-message m)))
+ (let ((v0 (make-instance 'foreign-message))
+ (v1 (make-instance 'foreign-message)))
+ (setf (c v0) 219)
+ (setf (c v1) 319)
+ (vector-push-extend v0 (repeated-foreign-message m))
+ (vector-push-extend v1 (repeated-foreign-message m)))
+ (let ((v0 (make-instance 'import-message))
+ (v1 (make-instance 'import-message)))
+ (setf (d v0) 220)
+ (setf (d v1) 320)
+ (vector-push-extend v0 (repeated-import-message m))
+ (vector-push-extend v1 (repeated-import-message m))))
(deftest test-parse-helpers ()
- (let ((m1 (make-instance 'pb:testalltypes))
- (m2 (make-instance 'pb:testalltypes)))
+ (let ((m1 (make-instance 'test-all-types))
+ (m2 (make-instance 'test-all-types)))
(set-all-fields m1)
(expect-all-fields-set m1)
(let* ((size (pb:octet-size m1))
@@ -286,75 +288,75 @@
(defun expect-clear (m)
;; optional and default fields
- (let ((field-info (append +optional-field-info+ +default-field-info+)))
+ (let ((field-info (append *optional-field-info* *default-field-info*)))
(loop for (field . values) in field-info do
(let ((has (field-function "HAS-" field))
(accessor (field-function "" field))
(default-value (first values)))
(is (not (funcall has m)))
- (is (field-equal (funcall accessor m) default-value)))))
+ (field-equal (funcall accessor m) default-value))))
- (is (not (pb:has-optionalgroup m)))
- (is (not (pb:has-a (pb:optionalgroup m))))
- (is (= (pb:a (pb:optionalgroup m)) 0))
+ (is (not (has-optional-group m)))
+ (is (not (has-a (optional-group m))))
+ (is (= (a (optional-group m)) 0))
- (is (not (pb:has-optional-nested-message m)))
- (is (not (pb:has-bb (pb:optional-nested-message m))))
- (is (= (pb:bb (pb:optional-nested-message m)) 0))
+ (is (not (has-optional-nested-message m)))
+ (is (not (has-bb (optional-nested-message m))))
+ (is (= (bb (optional-nested-message m)) 0))
- (is (not (pb:has-optional-foreign-message m)))
- (is (not (pb:has-c (pb:optional-foreign-message m))))
- (is (= (pb:c (pb:optional-foreign-message m)) 0))
+ (is (not (has-optional-foreign-message m)))
+ (is (not (has-c (optional-foreign-message m))))
+ (is (= (c (optional-foreign-message m)) 0))
- (is (not (pb:has-optional-import-message m)))
- (is (not (pb:has-d (pb:optional-import-message m))))
- (is (= (pb:d (pb:optional-import-message m)) 0))
+ (is (not (has-optional-import-message m)))
+ (is (not (has-d (optional-import-message m))))
+ (is (= (d (optional-import-message m)) 0))
;; repeated fields
- (let ((field-info +repeated-field-info+))
+ (let ((field-info *repeated-field-info*))
(loop for (field . nil) in field-info do
(let ((accessor (field-function "" field)))
(is (zerop (length (funcall accessor m))))))))
(defun modify-repeated-fields (m)
- (let ((field-info +repeated-field-info+))
+ (let ((field-info *repeated-field-info*))
(loop for (field . values) in field-info do
(let ((accessor (field-function "" field))
(v (third values)))
(setf (aref (funcall accessor m) 1) v))))
- (setf (pb:a (aref (pb:repeatedgroup m) 1)) 517)
- (setf (pb::bb (aref (pb:repeated-nested-message m) 1)) 518)
- (setf (pb::c (aref (pb:repeated-foreign-message m) 1)) 519)
- (setf (pb::d (aref (pb:repeated-import-message m) 1)) 520))
+ (setf (a (aref (repeated-group m) 1)) 517)
+ (setf (bb (aref (repeated-nested-message m) 1)) 518)
+ (setf (c (aref (repeated-foreign-message m) 1)) 519)
+ (setf (d (aref (repeated-import-message m) 1)) 520))
(defun expect-repeated-fields-modified (m)
- (let ((field-info +repeated-field-info+))
+ (let ((field-info *repeated-field-info*))
(loop for (field . values) in field-info do
(let ((accessor (field-function "" field))
(v0 (first values))
(v1 (third values)))
(is (= (length (funcall accessor m)) 2))
- (is (field-equal (aref (funcall accessor m) 0) v0))
- (is (field-equal (aref (funcall accessor m) 1) v1)))))
- (let ((v (pb:repeatedgroup m)))
+ (field-equal (aref (funcall accessor m) 0) v0)
+ (field-equal (aref (funcall accessor m) 1) v1))))
+ (let ((v (repeated-group m)))
(is (= (length v) 2))
- (is (= (pb:a (aref v 0)) 217))
- (is (= (pb:a (aref v 1)) 517)))
- (let ((v (pb:repeated-nested-message m)))
+ (is (= (a (aref v 0)) 217))
+ (is (= (a (aref v 1)) 517)))
+ (let ((v (repeated-nested-message m)))
(is (= (length v) 2))
- (is (= (pb:bb (aref v 0)) 218))
- (is (= (pb:bb (aref v 1)) 518)))
- (let ((v (pb:repeated-foreign-message m)))
+ (is (= (bb (aref v 0)) 218))
+ (is (= (bb (aref v 1)) 518)))
+ (let ((v (repeated-foreign-message m)))
(is (= (length v) 2))
- (is (= (pb:c (aref v 0)) 219))
- (is (= (pb:c (aref v 1)) 519)))
- (let ((v (pb:repeated-import-message m)))
+ (is (= (c (aref v 0)) 219))
+ (is (= (c (aref v 1)) 519)))
+ (let ((v (repeated-import-message m)))
(is (= (length v) 2))
- (is (= (pb:d (aref v 0)) 220))
- (is (= (pb:d (aref v 1)) 520))))
+ (is (= (d (aref v 0)) 220))
+ (is (= (d (aref v 1)) 520))))
(deftest test-modify-repeated-fields ()
- (let ((m (make-instance 'pb:testalltypes)))
+ (let ((m (make-instance 'test-all-types)))
(expect-clear m)
(set-all-fields m)
(expect-all-fields-set m)
@@ -364,9 +366,9 @@
(expect-clear m)))
(deftest test-serialize-and-merge ()
- (let ((m1 (make-instance 'pb:testalltypes))
- (m2 (make-instance 'pb:testalltypes))
- (m3 (make-instance 'pb:testalltypes)))
+ (let ((m1 (make-instance 'test-all-types))
+ (m2 (make-instance 'test-all-types))
+ (m3 (make-instance 'test-all-types)))
(set-all-fields m1)
(pb:clear m2)
(pb:merge-from-message m2 m1)
View
16 package.lisp
@@ -33,20 +33,26 @@
(defpackage #:protocol-buffer
(:documentation "Machine generated protocol buffers.")
(:nicknames #:pb)
- ;; We use no packages, not even COMMON-LISP, so machine-generated protocol buffer code must
- ;; explicitly qualify references to symbols outside the PROTOCOL-BUFFER package. The benefit of
- ;; this approach is that protocol buffers can use field names such as SECOND or DEBUG, which live
- ;; in the COMMON-LISP package, without causing symbol conflicts.
+ ;; Packages containing machine-generated protocol buffer code, including this one, use no other
+ ;; packages, not even COMMON-LISP, so protocol buffer code must explicitly qualify references to
+ ;; symbols outside the PROTOCOL-BUFFER package. The benefit of this approach is that protocol
+ ;; buffers can use field names such as "second" or "debug", which when translated into Lisp would
+ ;; ordinarily conflict with symbols in the COMMON-LISP package.
(:use)
;; Machine-generated protocol buffer code exports additional symbols for each enum tag, protocol
;; buffer constructor, field accessor, etc.
(:export #:protocol-buffer
+ ;; Operations on protocol buffers
#:clear
#:is-initialized
#:octet-size
#:merge-from-array
#:merge-from-message
- #:serialize))
+ #:serialize
+ ;; String fields
+ #:string-field
+ #:string-value
+ #:utf8-string-value))
(defpackage #:portable-float
(:documentation "Portably access the bits of IEEE floating point numbers.")
View
181 proto-lisp-test.lisp
@@ -1,35 +1,34 @@
-
-;;;; proto-lisp-test.lisp
-
-
-;; Copyright 2008, Google Inc.
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-
-;; * Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;; * Redistributions in binary form must reproduce the above
-;; copyright notice, this list of conditions and the following disclaimer
-;; in the documentation and/or other materials provided with the
-;; distribution.
-;; * Neither the name of Google Inc. nor the names of its
-;; contributors may be used to endorse or promote products derived from
-;; this software without specific prior written permission.
-
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+;;;; Copyright 2008 Google Inc. All Rights Reserved
+
+;;;; Redistribution and use in source and binary forms, with or without
+;;;; modification, are permitted provided that the following conditions are
+;;;; met:
+
+;;;; * Redistributions of source code must retain the above copyright
+;;;; notice, this list of conditions and the following disclaimer.
+;;;; * Redistributions in binary form must reproduce the above
+;;;; copyright notice, this list of conditions and the following disclaimer
+;;;; in the documentation and/or other materials provided with the
+;;;; distribution.
+;;;; * Neither the name of Google Inc. nor the names of its
+;;;; contributors may be used to endorse or promote products derived from
+;;;; this software without specific prior written permission.
+
+;;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+;;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+;;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+;;;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+;;;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+;;;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+;;;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+;;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+;;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+;;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+;;;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+;;;; Author: brown@google.com (Robert Brown)
+
+;;;; Protobuf tests
(in-package #:common-lisp-user)
@@ -55,47 +54,44 @@
(defconst +test-file-name+ (merge-pathnames "test-output-file" *base-directory*)
"Pathname of file to which we write protocol buffer data.")
-(defmacro assert-string-equal ((field protobuf) string)
- (let* ((field-name (symbol-name field))
- (field-octets (intern (concatenate 'string field-name "-OCTETS")
- "PROTOCOL-BUFFER")))
- `(progn (is (equalp (,field ,protobuf) ,string))
- (is (equalp (,field-octets ,protobuf) (string-to-utf8-octets ,string))))))
+(defun verify-string-field (string-field expected)
+ (is (string= (pb:string-value string-field) expected))
+ (is (equalp (pb:utf8-string-value string-field) (string-to-utf8-octets expected))))
(deftest correctness-tests ()
;; Check that required strings are cleared by CLEAR.
- (let ((p (make-instance 'pb:TestProtocol)))
- (assert-string-equal (pb:zero p) "")
- (setf (pb:zero p) "x")
- (assert-string-equal (pb:zero p) "x")
+ (let ((p (make-instance 'pb:test-protocol)))
+ (verify-string-field (pb:zero p) "")
+ (setf (pb:zero p) (pb:string-field "x"))
+ (verify-string-field (pb:zero p) "x")
(pb:clear p)
- (assert-string-equal (pb:zero p) ""))
+ (verify-string-field (pb:zero p) ""))
;; Check that optional strings are set to their default value by CLEAR.
- (let ((p (make-instance 'pb:TestProtocol)))
- (assert-string-equal (pb:optstring p) "opt")
- (setf (pb:optstring p) "x")
- (assert-string-equal (pb:optstring p) "x")
+ (let ((p (make-instance 'pb:test-protocol)))
+ (verify-string-field (pb:opt-string p) "opt")
+ (setf (pb:opt-string p) (pb:string-field "x"))
+ (verify-string-field (pb:opt-string p) "x")
(pb:clear p)
- (assert-string-equal (pb:optstring p) "opt")
- (setf (pb:optstring p) "x")
+ (verify-string-field (pb:opt-string p) "opt")
+ (setf (pb:opt-string p) (pb:string-field "x"))
(pb:clear p)
- (assert-string-equal (pb:optstring p) "opt")
- (setf (pb:optstring p) "x")
- (pb:clear-optstring p)
- (assert-string-equal (pb:optstring p) "opt"))
+ (verify-string-field (pb:opt-string p) "opt")
+ (setf (pb:opt-string p) (pb:string-field "x"))
+ (pb:clear-opt-string p)
+ (verify-string-field (pb:opt-string p) "opt"))
(values))
(deftest test-pb-write ()
- (let ((p (make-instance 'pb:Test1Proto)))
+ (let ((p (make-instance 'pb:test1proto)))
;; verify enum values
- (is (= pb:+Test1Proto-EnumCode-FOO+ 0))
- (is (= pb:+Test1Proto-EnumCode-BAR+ 1))
- (is (= pb:+Test1Proto-EnumCode-BAZ+ 2))
+ (is (= pb:+test1proto-enum-code-foo+ 0))
+ (is (= pb:+test1proto-enum-code-bar+ 1))
+ (is (= pb:+test1proto-enum-code-baz+ 2))
;; default settings
(is (= (pb:d-int32 p) 12))
- (assert-string-equal (pb:d-string p) "foo")
+ (verify-string-field (pb:d-string p) "foo")
(is (eq (pb:d-bool p) t))
;; test is-initialized
@@ -112,8 +108,8 @@
(setf (pb:u-bool p) t)
(setf (pb:u-float p) 3.14159f0)
(setf (pb:u-double p) 3.14159265d0)
- (setf (pb:u-string p) "foo")
- (setf (pb:u-vardata p) "bar")
+ (setf (pb:u-string p) (pb:string-field "foo"))
+ (setf (pb:u-vardata p) (pb:string-field "bar"))
(setf (pb:foo (pb:u-msg p)) 12)
;; repeated things
@@ -133,27 +129,27 @@
(vector-push-extend -1.75f0 (pb:r-float p))
(vector-push-extend 3.3d0 (pb:r-double p))
(vector-push-extend -1.2d0 (pb:r-double p))
- (vector-push-extend (string-to-utf8-octets "foo") (pb:r-string p))
- (vector-push-extend (string-to-utf8-octets "bar") (pb:r-string p))
- (vector-push-extend (string-to-utf8-octets "ping") (pb:r-vardata p))
- (vector-push-extend (string-to-utf8-octets "pong") (pb:r-vardata p))
+ (vector-push-extend (pb:string-field "foo") (pb:r-string p))
+ (vector-push-extend (pb:string-field "bar") (pb:r-string p))
+ (vector-push-extend (pb:string-field "ping") (pb:r-vardata p))
+ (vector-push-extend (pb:string-field "pong") (pb:r-vardata p))
- (let ((x (make-instance 'pb:Test1Msg))
- (y (make-instance 'pb:Test1Msg)))
+ (let ((x (make-instance 'pb:test1msg))
+ (y (make-instance 'pb:test1msg)))
(setf (pb:foo x) 12)
(setf (pb:foo y) 13)
(vector-push-extend x (pb:r-msg p))
(vector-push-extend y (pb:r-msg p)))
- (let ((x (make-instance 'pb:Test1Proto-TestGroup1))
- (y (make-instance 'pb:Test1Proto-TestGroup2))
- (z (make-instance 'pb:Test1Proto-TestGroup2)))
+ (let ((x (make-instance 'pb:test1proto-test-group1))
+ (y (make-instance 'pb:test1proto-test-group2))
+ (z (make-instance 'pb:test1proto-test-group2)))
(setf (pb:a x) 80)
(setf (pb:b y) 100)
(setf (pb:b z) 130)
- (vector-push-extend x (pb:testgroup1 p))
- (vector-push-extend y (pb:testgroup2 p))
- (vector-push-extend z (pb:testgroup2 p)))
+ (vector-push-extend x (pb:test-group1 p))
+ (vector-push-extend y (pb:test-group2 p))
+ (vector-push-extend z (pb:test-group2 p)))
;; int32 tests
(loop for x in (list (1- (ash 1 31)) (- (ash 1 31)) 1 0 -1)
@@ -205,16 +201,17 @@
(is (= (length value) golden-size))
(loop for v across value
for g in golden
- ;; V and G are either NIL/T, numbers, or strings, actually simple
- ;; arrays of octets.
- do (cond ((and (member v '(t nil)) (member g '(t nil)))
- (is (eq v g)))
- ((and (numberp v) (numberp g)) (is (= v g)))
- ((and (arrayp v) (arrayp g)) (is (equalp v g)))
- (t (is (progn "type mismatch" nil)))))))
+ do (cond ((stringp g) (is (string= (pb:string-value v) g)))
+ ((vectorp g)
+ (cond ((stringp (aref g 0))
+ (is (= (length v) (length g)))
+ (dotimes (i (length g))
+ (is (string= (pb:string-value (aref v i)) (aref g i)))))
+ (t (is (equalp v g)))))
+ (t (is (eql v g)))))))
(deftest test-pb-read ()
- (let ((p (make-instance 'pb:Test1Proto)))
+ (let ((p (make-instance 'pb:test1proto)))
(with-open-file (golden-input +golden-file-name+ :direction :input
:element-type 'unsigned-byte)
(let* ((size (file-length golden-input))
@@ -256,32 +253,30 @@
(test-repeated (pb:r-bool p) '(nil t))
(test-repeated (pb:r-float p) '(1.5f0 -1.75f0))
(test-repeated (pb:r-double p) '(3.3d0 -1.2d0))
- (test-repeated (pb:r-string p)
- (list (string-to-utf8-octets "foo") (string-to-utf8-octets "bar")))
- (test-repeated (pb:r-vardata p)
- (list (string-to-utf8-octets "ping") (string-to-utf8-octets "pong")))
+ (test-repeated (pb:r-string p) '("foo" "bar"))
+ (test-repeated (pb:r-vardata p) '("ping" "pong"))
(is (= (length (pb:r-msg p)) 2))
(is (= (pb:foo (aref (pb:r-msg p) 0)) 12))
(is (= (pb:foo (aref (pb:r-msg p) 1)) 13))
;; groups
- (is (= (length (pb:testgroup1 p)) 1))
- (is (= (pb:a (aref (pb:testgroup1 p) 0)) 80))
+ (is (= (length (pb:test-group1 p)) 1))
+ (is (= (pb:a (aref (pb:test-group1 p) 0)) 80))
- (is (= (length (pb:testgroup2 p)) 2))
- (is (= (pb:b (aref (pb:testgroup2 p) 0)) 100))
- (is (= (pb:b (aref (pb:testgroup2 p) 1)) 130))
+ (is (= (length (pb:test-group2 p)) 2))
+ (is (= (pb:b (aref (pb:test-group2 p) 0)) 100))
+ (is (= (pb:b (aref (pb:test-group2 p) 1)) 130))
;; default settings
(is (= (pb:d-int32 p) 12))
- (assert-string-equal (pb:d-string p) "foo")
+ (verify-string-field (pb:d-string p) "foo")
(is (eq (pb:d-bool p) t))))
(defun parser-timing (iterations)
- (let ((src (make-instance 'pb:TimeProtocol)))
+ (let ((src (make-instance 'pb:time-protocol)))
(dotimes (i 1000)
- (let ((new (make-instance 'pb:TimeProtocol-G)))
+ (let ((new (make-instance 'pb:time-protocol-g)))
(setf (pb:v1 new) 100)
(setf (pb:v2 new) 80)
(vector-push-extend new (pb:g src))))
@@ -290,7 +285,7 @@
;; XXXXXXXXXX
(size (pb:serialize src buffer 0 10000)))
(time (dotimes (i iterations)
- (let ((msg (make-instance 'pb:TimeProtocol)))
+ (let ((msg (make-instance 'pb:time-protocol)))
(pb:merge-from-array msg buffer 0 size)))))))
;; XXXXXXXXXXXXXXXXXXXX use parser-timing here
View
36 protoc/lisp/enum.cc
@@ -43,7 +43,7 @@ namespace lisp {
EnumGenerator::EnumGenerator(const EnumDescriptor* descriptor)
: descriptor_(descriptor),
- classname_(ClassName(descriptor, false)) {
+ classname_(ClassName(descriptor)) {
}
EnumGenerator::~EnumGenerator() {}
@@ -107,6 +107,40 @@ void EnumGenerator::GenerateDefType(io::Printer* printer) {
printer->Print("(cl:export '$classname$)\n\n", "classname", classname_);
}
+// void EnumGenerator::GeneratePackageExports(io::Printer* printer) {
+// map<string, string> vars;
+// vars["classname"] = classname_;
+
+// const EnumValueDescriptor* min_value = descriptor_->value(0);
+// const EnumValueDescriptor* max_value = descriptor_->value(0);
+
+// printer->Print(vars, "(:export #:$classname$\n");
+// printer->Indent();
+
+// for (int i = 0; i < descriptor_->value_count(); i++) {
+// vars["name"] = LispifyName(descriptor_->value(i)->name());
+// vars["number"] = SimpleItoa(descriptor_->value(i)->number());
+
+// printer->Print(vars, "#:+$classname$-$name$+\n");
+
+// if (descriptor_->value(i)->number() < min_value->number()) {
+// min_value = descriptor_->value(i);
+// }
+// if (descriptor_->value(i)->number() > max_value->number()) {
+// max_value = descriptor_->value(i);
+// }
+// }
+
+// vars["min_name"] = LispifyName(min_value->name());
+// vars["max_name"] = LispifyName(max_value->name());
+// printer->Print(
+// vars,
+// "#:+minimum-$classname$+\n"
+// "#:+maximum-$classname$+)");
+
+// printer->Outdent();
+// }
+
} // namespace lisp
} // namespace compiler
} // namespace protobuf
View
3 protoc/lisp/enum.h
@@ -58,6 +58,9 @@ class EnumGenerator {
// values.
void GenerateDefType(io::Printer* printer);
+ // Generate the package export list.
+// void GeneratePackageExports(io::Printer* printer);
+
private:
const EnumDescriptor* descriptor_;
string classname_;
View
18 protoc/lisp/enum_field.cc
@@ -48,12 +48,12 @@ namespace {
void SetEnumVariables(const FieldDescriptor* descriptor,
map<string, string>* variables) {
(*variables)["name"] = FieldName(descriptor);
- (*variables)["type"] = ClassName(descriptor->enum_type(), true);
+ (*variables)["type"] = ClassName(descriptor->enum_type());
(*variables)["default"] = DefaultValue(descriptor);
-
+ (*variables)["package"] = FileLispPackage(descriptor->enum_type()->file());
(*variables)["index"] = SimpleItoa(descriptor->index());
(*variables)["number"] = SimpleItoa(descriptor->number());
-// (*variables)["classname"] = ClassName(FieldScope(descriptor), false);
+// (*variables)["classname"] = ClassName(FieldScope(descriptor));
(*variables)["tag"] = SimpleItoa(WireFormat::MakeTag(descriptor));
(*variables)["tag_size"] =
SimpleItoa(WireFormat::TagSize(
@@ -74,14 +74,14 @@ void EnumFieldGenerator::GenerateSlot(io::Printer* printer) const {
variables_,
"($name$\n"
" :accessor $name$\n"
- " :initform $default$\n"
- " :type $type$)\n");
+ " :initform $package$::$default$\n"
+ " :type $package$::$type$)\n");
}
void EnumFieldGenerator::GenerateClearingCode(io::Printer* printer) const {
printer->Print(
variables_,
- "(cl:setf (cl:slot-value self '$name$) $default$)");
+ "(cl:setf (cl:slot-value self '$name$) $package$::$default$)");
}
void EnumFieldGenerator::GenerateOctetSize(io::Printer* printer) const {
@@ -143,9 +143,9 @@ void RepeatedEnumFieldGenerator::GenerateSlot(io::Printer* printer) const {
" :accessor $name$\n"
" :initform (cl:make-array\n"
" 0\n"
- " :element-type '$type$\n"
+ " :element-type '$package$::$type$\n"
" :fill-pointer 0 :adjustable cl:t)\n"
- " :type (cl:vector $type$))\n");
+ " :type (cl:vector $package$::$type$))\n");
}
void RepeatedEnumFieldGenerator::GenerateClearingCode(io::Printer* printer)
@@ -155,7 +155,7 @@ void RepeatedEnumFieldGenerator::GenerateClearingCode(io::Printer* printer)
"(cl:setf (cl:slot-value self '$name$)\n"
" (cl:make-array\n"
" 0\n"
- " :element-type '$type$\n"
+ " :element-type '$package$::$type$\n"
" :fill-pointer 0 :adjustable cl:t))");
}
View
35 protoc/lisp/file.cc
@@ -90,10 +90,39 @@ void FileGenerator::GenerateSource(io::Printer* printer) {
";;; Generated by the protocol buffer compiler. DO NOT EDIT!\n"
"\n"
"\n"
- "(cl:in-package #:protocol-buffer)\n"
- "\n",
+ "(cl:in-package #:common-lisp-user)\n",
"basename", StripProto(file_->name()));
+ printer->Print(
+ "(eval-when (:compile-toplevel :load-toplevel :execute)\n"
+ " (unless (find-package '#:$package_name$)\n"
+ " (make-package '#:$package_name$ :use nil)))\n",
+ "package_name", FileLispPackage(file_));
+
+ // printer->Print(
+ // "(cl:defpackage #:$package_name$\n"
+ // " (:use)",
+ // "package_name", FileLispPackage(file_));
+ // printer->Indent();
+ // // Generate package exports for each top-level enum.
+ // for (int i = 0; i < file_->enum_type_count(); i++) {
+ // printer->Print("\n");
+ // enum_generators_[i]->GeneratePackageExports(printer);
+ // }
+ // // Generate package exports for all messages and nested enums.
+ // for (int i = 0; i < file_->message_type_count(); i++) {
+ // printer->Print("\n");
+ // message_generators_[i]->GeneratePackageExports(printer);
+ // }
+ // printer->Outdent();
+ // printer->Print(")\n");
+
+ printer->Print(
+ "(in-package #:$package_name$)\n"
+ "(cl:declaim #.com.google.base:*optimize-default*)\n"
+ "\n",
+ "package_name", FileLispPackage(file_));
+
// Generate a type and constants for each top-level enum.
for (int i = 0; i < file_->enum_type_count(); i++) {
enum_generators_[i]->GenerateDefType(printer);
@@ -119,7 +148,7 @@ void FileGenerator::GenerateSource(io::Printer* printer) {
// for (int i = 0; i < file_->enum_type_count(); i++) {
// printer->Print(
// "const ::google::protobuf::EnumDescriptor* $name$_descriptor_ = NULL;\n",
- // "name", ClassName(file_->enum_type(i), false));
+ // "name", ClassName(file_->enum_type(i)));
// }
// for (int i = 0; i < file_->service_count(); i++) {
// printer->Print(
View
168 protoc/lisp/helpers.cc
@@ -28,12 +28,14 @@
// (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
// OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+#include <stdio.h>
#include <vector>
#include "hash.h"
#include "helpers.h"
#include <google/protobuf/stubs/common.h>
#include "strutil.h"
+#include <google/protobuf/descriptor.pb.h>
namespace google {
namespace protobuf {
@@ -65,29 +67,88 @@ string StripProto(const string& filename) {
}
}
+string FileLispPackage(const FileDescriptor* file) {
+ if (file->options().has_java_package()) {
+ return LispifyName(file->options().java_package());
+ } else if (file->options().has_java_outer_classname()) {
+ return LispifyName(file->options().java_outer_classname());
+ } else {
+ return "protocol-buffer";
+ }
+}
+
+const int unknown = 0;
+const int lower = 1;
+const int upper = 2;
+
+string HyphenateStudlyCaps(const string& name) {
+ int state = unknown;
+ string result;
+
+ for (int i = 0; i < name.size(); ++i) {
+ result.append(1, name[i]);
+ switch (state) {
+ case unknown:
+ if (isalpha(name[i])) {
+ if (isupper(name[i])) {
+ state = upper;
+ } else if (islower(name[i])) {
+ state = lower;
+ }
+ }
+ break;
+ case lower:
+ if (i < name.size() - 1) {
+ // We can look ahead one character.
+ if (! isalpha(name[i + 1])) {
+ state = unknown;
+ } else if (isupper(name[i + 1])) {
+ result.append(1, '-');
+ state = upper;
+ }
+ }
+ break;
+ case upper:
+ if (i < name.size() - 2) {
+ // We can look two characters ahead.
+ if (! isalpha(name[i + 1])) {
+ state = unknown;
+ } else if (islower(name[i + 1])) {
+ state = lower;
+ } else if (isalpha(name[i + 2]) && islower(name[i + 2])) {
+ // Next character is upper, following character is lower.
+ result.append(1, '-');
+ result.append(1, name[++i]);
+ state = lower;
+ }
+ }
+ break;
+ }
+ }
+ return result;
+}
+
string LispifyName(const string& proto_name) {
string result = UnderscoresToHyphens(proto_name);
+ result = HyphenateStudlyCaps(result);
LowerString(&result);
return result;
}
-string ClassName(const EnumDescriptor* enum_descriptor, bool qualified) {
- // qualified must be FALSE XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
-
+string ClassName(const EnumDescriptor* enum_descriptor) {
if (enum_descriptor->containing_type() == NULL) {
+ // The enum type is defined at top-level in the file.
return LispifyName(enum_descriptor->name());
} else {
- string result = ClassName(enum_descriptor->containing_type(), qualified);
+ // The enum type is embedded in a message filed definition.
+ string result = ClassName(enum_descriptor->containing_type());
result += '-';
- result += enum_descriptor->name();
- return LispifyName(result);
+ result += LispifyName(enum_descriptor->name());
+ return result;
}
}
-string ClassName(const Descriptor* descriptor, bool qualified) {
- // XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX qualified must be false
-
-
+string ClassName(const Descriptor* descriptor) {
// Find "outer", the descriptor of the top-level message in which
// "descriptor" is embedded.
const Descriptor* outer = descriptor;
@@ -99,8 +160,8 @@ string ClassName(const Descriptor* descriptor, bool qualified) {
return LispifyName(outer->name() + DotsToUnderscores(inner_name));
}
-const char* PrimitiveTypeName(FieldDescriptor::CppType type) {
- switch (type) {
+const char* PrimitiveTypeName(const FieldDescriptor* field) {
+ switch (field->cpp_type()) {
case FieldDescriptor::CPPTYPE_INT32:
return "(cl:signed-byte 32)";
case FieldDescriptor::CPPTYPE_INT64:
@@ -118,7 +179,11 @@ const char* PrimitiveTypeName(FieldDescriptor::CppType type) {
case FieldDescriptor::CPPTYPE_ENUM:
return "(cl:unsigned-byte 32)";
case FieldDescriptor::CPPTYPE_STRING:
- return "(cl:simple-array (cl:unsigned-byte 8) (cl:*))";
+ if (field->type() == FieldDescriptor::TYPE_BYTES) {
+ return "(cl:simple-array (cl:unsigned-byte 8) (cl:*))";
+ } else {
+ return "pb::%string-field%";
+ }
case FieldDescriptor::CPPTYPE_MESSAGE:
return NULL;
@@ -131,17 +196,24 @@ const char* PrimitiveTypeName(FieldDescriptor::CppType type) {
}
string FieldName(const FieldDescriptor* field) {
- return LispifyName(UnderscoresToHyphens(field->name()));
+ // Groups are hacky: The name of the field is just the lower-cased name
+ // of the group type. In Java, though, we would like to retain the original
+ // capitalization of the type name.
+ if (field->type() == FieldDescriptor::TYPE_GROUP) {
+ return LispifyName(field->message_type()->name());
+ } else {
+ return LispifyName(field->name());
+ }
}
-string StringOctets(const string string_default) {
+string StringOctets(const string str) {
string octets;
- int default_length = string_default.size();
+ int str_length = str.size();
- for (int i = 0; i < default_length; ++i) {
- int octet = string_default[i] & 0xff;
+ for (int i = 0; i < str_length; ++i) {
+ int octet = str[i] & 0xff;
octets += SimpleItoa(octet);
- if (i != default_length - 1) {
+ if (i != str_length - 1) {
octets += " ";
}
}
@@ -186,6 +258,22 @@ string LispSimpleDtoa(double value) {
return c_result + "d0";
}
+string LispEscapeString(string str) {
+ string lisp;
+
+ lisp.append(1, '"');
+ for (int i = 0; i < str.size(); i++) {
+ if (str[i] == '"') {
+ lisp.append(1, '\\');
+ lisp.append(1, '"');
+ } else {
+ lisp.append(1, str[i]);
+ }
+ }
+ lisp.append(1, '"');
+ return lisp;
+}
+
string DefaultValue(const FieldDescriptor* field) {
switch (field->cpp_type()) {
case FieldDescriptor::CPPTYPE_INT32:
@@ -196,28 +284,48 @@ string DefaultValue(const FieldDescriptor* field) {
return SimpleItoa(field->default_value_int64());
case FieldDescriptor::CPPTYPE_UINT64:
return SimpleItoa(field->default_value_uint64());
+
case FieldDescriptor::CPPTYPE_DOUBLE:
return LispSimpleDtoa(field->default_value_double());
case FieldDescriptor::CPPTYPE_FLOAT:
return LispSimpleFtoa(field->default_value_float());
+
case FieldDescriptor::CPPTYPE_BOOL:
return field->default_value_bool() ? "cl:t" : "cl:nil";
+ case FieldDescriptor::CPPTYPE_STRING:
+ if (field->type() == FieldDescriptor::TYPE_BYTES) {
+ if (field->has_default_value()) {
+ return ("(cl:make-array "
+ + SimpleItoa(field->default_value_string().size())
+ + " :element-type '(cl:unsigned-byte 8) :initial-contents '("
+ + StringOctets(field->default_value_string())
+ + "))");
+ } else {
+ return "(cl:make-array 0 :element-type '(cl:unsigned-byte 8))";
+ }
+ } else {
+ if (field->has_default_value()) {
+ return "(pb:string-field " + LispEscapeString(field->default_value_string()) + ")";
+ } else {
+ return "(pb:string-field \"\")";
+ }
+ }
+
case FieldDescriptor::CPPTYPE_ENUM:
- return ("#.+"
- + ClassName(field->enum_type(), false)
+ return ("+"
+ + ClassName(field->enum_type())
+ "-"
+ LispifyName(field->default_value_enum()->name())
+ "+");
- case FieldDescriptor::CPPTYPE_STRING:
case FieldDescriptor::CPPTYPE_MESSAGE:
- GOOGLE_LOG(FATAL) << "Shouldn't get here.";
- return "";
+ return StringOctets(field->default_value_string());
+ // No default because we want the compiler to complain if any new types are
+ // added.
}
- // Can't actually get here; make compiler happy. We could add a default
- // case above but then we wouldn't get the nice compiler warning when a
- // new type is added.
+
+ GOOGLE_LOG(FATAL) << "Shouldn't get here.";
return "";
}
@@ -256,14 +364,16 @@ string OctetSize(FieldDescriptor::Type type, string reference) {
return "1";
case FieldDescriptor::TYPE_STRING:
+ return ("(cl:let ((s (pb::%utf8-string-length% " + reference + ")))\n"
+ " (cl:+ s (varint:length32 s)))");
case FieldDescriptor::TYPE_BYTES:
return ("(cl:let ((s (cl:length " + reference + ")))\n"
" (cl:+ s (varint:length32 s)))");
case FieldDescriptor::TYPE_GROUP:
- return "(octet-size " + reference + ")";
+ return "(pb:octet-size " + reference + ")";
case FieldDescriptor::TYPE_MESSAGE:
- return ("(cl:let ((s (octet-size " + reference + ")))\n"
+ return ("(cl:let ((s (pb:octet-size " + reference + ")))\n"
" (cl:+ s (varint:length32 s)))");
// No default because we want the compiler to complain if any new
View
24 protoc/lisp/helpers.h
@@ -42,30 +42,17 @@ namespace lisp {
// Strips ".proto" or ".protodevel" from the end of a filename.
string StripProto(const string& filename);
+// Returns the file's Lisp package name.
+string FileLispPackage(const FileDescriptor* file);
+
// Converts underscores to hyphens and characters to lower case.
string LispifyName(const string& proto_name);
-// Returns the non-nested type name for the given type. If "qualified" is
-// true, prefix the type with the full namespace. For example, if you had:
-// package foo.bar;
-// message Baz { message Qux {} }
-// Then the qualified ClassName for Qux would be:
-// ::foo::bar::Baz_Qux
-// While the non-qualified version would be:
-// Baz_Qux
-string ClassName(const Descriptor* descriptor, bool qualified);
-string ClassName(const EnumDescriptor* enum_descriptor, bool qualified);
+string ClassName(const Descriptor* descriptor);
+string ClassName(const EnumDescriptor* enum_descriptor);
// XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX fix comments
-// Get the C++ type name for a primitive type (e.g. "double",
-// "::google::protobuf::int32", etc.).
-// Note: non-built-in type names will be qualified, meaning they will start
-// with a ::. If you are using the type as a template parameter, you will
-// need to insure there is a space between the < and the ::, because the
-// ridiculous C++ standard defines "<:" to be a synonym for "[".
-const char* PrimitiveTypeName(FieldDescriptor::CppType type);
-
// Get the (unqualified) name that should be used for this field. People
// should be using lowercase-with-underscores style for proto field names
// and this function replaces the underscores with hyphens.
@@ -74,6 +61,7 @@ string FieldName(const FieldDescriptor* field);
// XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX comment these
+const char* PrimitiveTypeName(const FieldDescriptor* field);
string StringOctets(const string string_default);
string LispSimpleFtoa(float value);
string LispSimpleDtoa(double value);
View
76 protoc/lisp/message.cc
@@ -135,7 +135,7 @@ static bool HasRequiredFields(const Descriptor* type) {
MessageGenerator::MessageGenerator(const Descriptor* descriptor)
: descriptor_(descriptor),
- classname_(ClassName(descriptor, false)),
+ classname_(ClassName(descriptor)),
// dllexport_decl_(dllexport_decl),
field_generators_(descriptor),
nested_generators_(new scoped_ptr<MessageGenerator>[
@@ -175,6 +175,36 @@ void MessageGenerator::GenerateEnumDefinitions(io::Printer* printer) {
}
}
+// void MessageGenerator::GeneratePackageExports(io::Printer* printer) {
+// // Nested classes
+// for (int i = 0; i < descriptor_->nested_type_count(); i++) {
+// nested_generators_[i]->GeneratePackageExports(printer);
+// printer->Print("\n");
+// }
+// // Enums
+// for (int i = 0; i < descriptor_->enum_type_count(); i++) {
+// enum_generators_[i]->GeneratePackageExports(printer);
+// printer->Print("\n");
+// }
+
+// map<string, string> vars;
+// vars["classname"] = classname_;
+
+// printer->Print(vars, "(:export #:$classname$\n");
+// printer->Indent();
+
+// for (int i = 0; i < descriptor_->field_count(); i++) {
+// const FieldDescriptor* field = descriptor_->field(i);
+// vars["name"] = FieldName(field);
+
+// // Export the field accessor symbols
+// printer->Print(vars, "#:$name$ #:has-$name$ #:clear-$name$\n");
+// }
+
+// printer->Print(")");
+// printer->Outdent();
+// }
+
void MessageGenerator::GenerateClassDefinition(io::Printer* printer) {
// Generate class definitions of all nested classes.
@@ -187,7 +217,7 @@ void MessageGenerator::GenerateClassDefinition(io::Printer* printer) {
vars["classname"] = classname_;
vars["field_count"] = SimpleItoa(descriptor_->field_count());
- printer->Print(vars, "(cl:defclass $classname$ (protocol-buffer)\n");
+ printer->Print(vars, "(cl:defclass $classname$ (pb:protocol-buffer)\n");
printer->Indent();
printer->Print("(\n");
@@ -206,8 +236,7 @@ void MessageGenerator::GenerateClassDefinition(io::Printer* printer) {
}
printer->Print(
vars,
- "(%cached-size%\n"
- " :accessor %cached-size%\n"
+ "(pb::%cached-size%\n"
" :initform 0\n"
" :type (cl:integer 0 #.(cl:1- cl:array-dimension-limit)))\n");
printer->Print("))\n");
@@ -324,7 +353,10 @@ void MessageGenerator::GeneratePrintObject(io::Printer* printer) {
printer->Print(
"(cl:defmethod cl:print-object ((self $classname$) stream)\n"
" (cl:print-unreadable-object"
- " (self stream :type cl:t :identity cl:t)\n",
+ " (self stream :type cl:t :identity cl:t)\n"
+ " (cl:pprint-logical-block (stream cl:nil)\n"
+,
+// " (cl:pprint-indent :block 1 stream)\n",
"classname", classname_);
printer->Indent();
printer->Indent();
@@ -338,8 +370,10 @@ void MessageGenerator::GeneratePrintObject(io::Printer* printer) {
"index", SimpleItoa(field->index()));
printer->Indent();
}
+ // Use the getter so that string protobuf fields are output as Lisp
+ // strings, not as arrays of octets.
printer->Print(
- "(cl:format stream \"$name$: ~s \" (cl:slot-value self '$name$))",
+ " (cl:format stream \"~_$name$: ~s \" ($name$ self))",
"name", FieldName(field));
if (!field->is_repeated()) {
printer->Print(")");
@@ -348,15 +382,15 @@ void MessageGenerator::GeneratePrintObject(io::Printer* printer) {
printer->Print("\n");
}
- printer->Print(")\n");
+ printer->Print("))\n");
printer->Outdent();
printer->Print("(cl:values))\n");
printer->Outdent();
}
void MessageGenerator::GenerateClear(io::Printer* printer) {
printer->Print(
- "(cl:defmethod clear ((self $classname$))\n",
+ "(cl:defmethod pb:clear ((self $classname$))\n",
"classname", classname_);
printer->Indent();
@@ -414,7 +448,7 @@ void MessageGenerator::GenerateClear(io::Printer* printer) {
}
void MessageGenerator::GenerateIsInitialized(io::Printer* printer) {
- printer->Print("(cl:defmethod is-initialized ((self $classname$))\n",
+ printer->Print("(cl:defmethod pb:is-initialized ((self $classname$))\n",
"classname", classname_);
printer->Indent();
@@ -437,7 +471,7 @@ void MessageGenerator::GenerateIsInitialized(io::Printer* printer) {
"(cl:when (cl:/= (cl:logand (cl:slot-value self '%has-bits%)\n"
" #b$mask$)\n"
" #b$mask$)\n"
- " (cl:return-from is-initialized cl:nil))\n",
+ " (cl:return-from pb:is-initialized cl:nil))\n",
"mask", mask);
}
@@ -452,17 +486,17 @@ void MessageGenerator::GenerateIsInitialized(io::Printer* printer) {
"(cl:let* ((x (cl:slot-value self '$name$))\n"
" (length (cl:length x)))\n"
" (cl:dotimes (i length)\n"
- " (cl:unless (is-initialized (cl:aref x i))\n"
- " (cl:return-from is-initialized cl:nil))))\n",
+ " (cl:unless (pb:is-initialized (cl:aref x i))\n"
+ " (cl:return-from pb:is-initialized cl:nil))))\n",
"name", FieldName(field));
} else {
// XXXXXXXXXXXXXXXXXXXX: not sure what's going on here with
// required vs. optional fields
// Maybe the C++ code hardwires has-XXX to true for required fields.
printer->Print(
"(cl:when (cl:logbitp $index$ (cl:slot-value self '%has-bits%))\n"
- " (cl:unless (is-initialized (cl:slot-value self '$name$))\n"
- " (cl:return-from is-initialized cl:nil)))\n",
+ " (cl:unless (pb:is-initialized (cl:slot-value self '$name$))\n"
+ " (cl:return-from pb:is-initialized cl:nil)))\n",
"index", SimpleItoa(field->index()),
"name", FieldName(field));
}
@@ -474,12 +508,12 @@ void MessageGenerator::GenerateIsInitialized(io::Printer* printer) {
}
void MessageGenerator::GenerateOctetSize(io::Printer* printer) {
- printer->Print("(cl:defmethod octet-size ((self $classname$))\n",
+ printer->Print("(cl:defmethod pb:octet-size ((self $classname$))\n",
"classname", classname_);
printer->Indent();
// XXXXXXXXXXXXXXXXXXXX previous Lisp code does:
- // (assert (is-initialized self))
+ // (assert (pb:is-initialized self))
printer->Print("(cl:let ((size 0))\n");
printer->Indent();
@@ -527,7 +561,7 @@ void MessageGenerator::GenerateOctetSize(io::Printer* printer) {
// of C++, _cached_size_ should be made into an atomic<int>.
// XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX: Protect update with lock ???
printer->Print(
- "(cl:setf (cl:slot-value self '%cached-size%) size)\n"
+ "(cl:setf (cl:slot-value self 'pb::%cached-size%) size)\n"
"size))\n");
printer->Outdent();
printer->Outdent();
@@ -566,7 +600,7 @@ void MessageGenerator::GenerateSerializeOneExtensionRange(
void MessageGenerator::GenerateSerializeWithCachedSizes(io::Printer* printer) {
printer->Print(
- "(cl:defmethod serialize ((self $classname$) buffer index limit)\n"
+ "(cl:defmethod pb:serialize ((self $classname$) buffer index limit)\n"
" (cl:declare (cl:type com.google.base:octet-vector buffer)\n"
" (cl:type com.google.base:vector-index index limit)\n"
" (cl:ignorable buffer limit))\n",
@@ -627,7 +661,7 @@ void MessageGenerator::GenerateSerializeWithCachedSizes(io::Printer* printer) {
void MessageGenerator::GenerateMergeFromArray(io::Printer* printer) {
printer->Print(
- "(cl:defmethod merge-from-array"
+ "(cl:defmethod pb:merge-from-array"
" ((self $classname$) buffer start limit)\n"
" (cl:declare (cl:type com.google.base:octet-vector buffer)\n"
" (cl:type com.google.base:vector-index start limit))\n"
@@ -669,7 +703,7 @@ void MessageGenerator::GenerateMergeFromArray(io::Printer* printer) {
printer->Indent();
printer->Print(
"(cl:when (cl:= (cl:logand tag 7) $end_group$)\n"
- " (cl:return-from merge-from-array index))\n",
+ " (cl:return-from pb:merge-from-array index))\n",
"end_group", SimpleItoa(WireFormatLite::WIRETYPE_END_GROUP));
// XXXXXXXXXXXXXXXXXXXX: the comment is wrong
@@ -689,7 +723,7 @@ void MessageGenerator::GenerateMergeFromArray(io::Printer* printer) {
void MessageGenerator::GenerateMergeFromMessage(io::Printer* printer) {
printer->Print(
- "(cl:defmethod merge-from-message"
+ "(cl:defmethod pb:merge-from-message"
" ((self $classname$) (from $classname$))\n",
"classname", classname_);
printer->Indent();
View
3 protoc/lisp/message.h
@@ -66,6 +66,9 @@ class MessageGenerator {
// Generate all the methods of the class.
void GenerateClassMethods(io::Printer* printer);
+ // Generate the package export list.
+// void GeneratePackageExports(io::Printer* printer);
+
private:
// Generate standard Message methods.
void GeneratePrintObject(io::Printer* printer);
View
56 protoc/lisp/message_field.cc
@@ -49,10 +49,12 @@ namespace {
void SetMessageVariables(const FieldDescriptor* descriptor,
map<string, string>* variables) {
(*variables)["name"] = FieldName(descriptor);
- (*variables)["type"] = ClassName(descriptor->message_type(), false);
+ (*variables)["type"] = ClassName(descriptor->message_type());
(*variables)["index"] = SimpleItoa(descriptor->index());
(*variables)["number"] = SimpleItoa(descriptor->number());
- (*variables)["classname"] = ClassName(FieldScope(descriptor), false);
+ (*variables)["classname"] = ClassName(FieldScope(descriptor));
+ (*variables)["package"] = FileLispPackage(descriptor->message_type()->file());
+
// For groups, the tag size includes the size of the group end tag.
(*variables)["tag_size"] =
SimpleItoa(WireFormat::TagSize(
@@ -74,7 +76,7 @@ void MessageFieldGenerator::GenerateSlot(io::Printer* printer) const {
"($name$\n"
" :writer (cl:setf $name$)\n"
" :initform cl:nil\n"
- " :type (cl:or cl:null $type$))\n");
+ " :type (cl:or cl:null $package$::$type$))\n");
}
void MessageFieldGenerator::GenerateClearingCode(io::Printer* printer) const {
@@ -87,13 +89,13 @@ void MessageFieldGenerator::GenerateOctetSize(io::Printer* printer) const {
if (descriptor_->type() == FieldDescriptor::TYPE_MESSAGE) {
printer->Print(
variables_,
- "(cl:let ((s (octet-size (cl:slot-value self '$name$))))\n"
+ "(cl:let ((s (pb:octet-size (cl:slot-value self '$name$))))\n"
" (cl:incf size (cl:+ $tag_size$ s (varint:length32 s))))");
} else if (descriptor_->type() == FieldDescriptor::TYPE_GROUP) {
printer->Print(
variables_,
"(cl:incf size (cl:+ $tag_size$"
- " (octet-size (cl:slot-value self '$name$))))");
+ " (pb:octet-size (cl:slot-value self '$name$))))");
} else {
GOOGLE_LOG(FATAL) << "Invalid message type";
}
@@ -108,7 +110,7 @@ void MessageFieldGenerator::GenerateAccessor(io::Printer* printer) const {
"(cl:defmethod $name$ ((self $classname$))\n"
" (cl:let ((result (cl:slot-value self '$name$)))\n"
" (cl:when (cl:null result)\n"
- " (cl:setf result (cl:make-instance '$type$))\n"
+ " (cl:setf result (cl:make-instance '$package$::$type$))\n"
" (cl:setf (cl:slot-value self '$name$) result))\n"
" (cl:setf (cl:ldb (cl:byte 1 $index$)"
" (cl:slot-value self '%has-bits%)) 1)\n"
@@ -133,9 +135,9 @@ void MessageFieldGenerator::GenerateSerializeWithCachedSizes(
"(cl:setf index"
" (varint:encode-uint32-carefully"
" buffer index limit"
- " (cl:slot-value (cl:slot-value self '$name$) '%cached-size%)))\n"
+ " (cl:slot-value (cl:slot-value self '$name$) 'pb::%cached-size%)))\n"
"(cl:setf index"
- " (serialize (cl:slot-value self '$name$) buffer index limit))");
+ " (pb:serialize (cl:slot-value self '$name$) buffer index limit))");
} else if (descriptor_->type() == FieldDescriptor::TYPE_GROUP) {
uint32 start_tag =
WireFormatLite::MakeTag(descriptor_->number(),
@@ -150,7 +152,7 @@ void MessageFieldGenerator::GenerateSerializeWithCachedSizes(
printer->Print(
variables_,
"(cl:setf index"
- " (serialize (cl:slot-value self '$name$) buffer index limit))\n");
+ " (pb:serialize (cl:slot-value self '$name$) buffer index limit))\n");
printer->Print(
"(cl:setf index"
" (varint:encode-uint32-carefully buffer index limit $end_tag$))",
@@ -171,12 +173,12 @@ void MessageFieldGenerator::GenerateMergeFromArray(
" (cl:error \"buffer overflow\"))\n"
" (cl:let ((message (cl:slot-value self '$name$)))\n"
" (cl:when (cl:null message)\n"
- " (cl:setf message (cl:make-instance '$type$))\n"
+ " (cl:setf message (cl:make-instance '$package$::$type$))\n"
" (cl:setf (cl:slot-value self '$name$) message)\n"
" (cl:setf (cl:ldb (cl:byte 1 $index$)"
" (cl:slot-value self '%has-bits%)) 1))\n"
" (cl:setf index"
- " (merge-from-array message buffer new-index"
+ " (pb:merge-from-array message buffer new-index"
" (cl:+ new-index length)))\n"
" (cl:when (cl:not (cl:= index (cl:+ new-index length)))\n"
" (cl:error \"buffer overflow\"))))");
@@ -185,11 +187,11 @@ void MessageFieldGenerator::GenerateMergeFromArray(
variables_,
"(cl:let ((message (cl:slot-value self '$name$)))\n"
" (cl:when (cl:null message)\n"
- " (cl:setf message (cl:make-instance '$type$))\n"
+ " (cl:setf message (cl:make-instance '$package$::$type$))\n"
" (cl:setf (cl:slot-value self '$name$) message)\n"
" (cl:setf (cl:ldb (cl:byte 1 $index$)"
" (cl:slot-value self '%has-bits%)) 1))\n"
- " (cl:setf index (merge-from-array message buffer index limit))\n");
+ " (cl:setf index (pb:merge-from-array message buffer index limit))\n");
// XXXXXXXXXX: The end tag can be more than one byte, so the (1- index)
// is wrong. We need to compare several bytes.
@@ -211,11 +213,11 @@ void MessageFieldGenerator::GenerateMergingCode(io::Printer* printer) const {
variables_,
"(cl:let ((message (cl:slot-value self '$name$)))\n"
" (cl:when (cl:null message)\n"
- " (cl:setf message (cl:make-instance '$type$))\n"
+ " (cl:setf message (cl:make-instance '$package$::$type$))\n"
" (cl:setf (cl:slot-value self '$name$) message)\n"
" (cl:setf (cl:ldb (cl:byte 1 $index$)"
" (cl:slot-value self '%has-bits%)) 1))\n"
- " (merge-from-message message (cl:slot-value from '$name$)))");
+ " (pb:merge-from-message message (cl:slot-value from '$name$)))");
}
RepeatedMessageFieldGenerator::RepeatedMessageFieldGenerator(
@@ -233,17 +235,17 @@ void RepeatedMessageFieldGenerator::GenerateSlot(io::Printer* printer) const {
" :accessor $name$\n"
" :initform (cl:make-array\n"
" 0\n"
- " :element-type '$type$\n"
+ " :element-type '$package$::$type$\n"
" :fill-pointer 0 :adjustable cl:t)\n"
- " :type (cl:vector $type$))\n");
+ " :type (cl:vector $package$::$type$))\n");
}
void RepeatedMessageFieldGenerator::GenerateClearingCode(io::Printer* printer)
const {
printer->Print(
variables_,
"(cl:setf (cl:slot-value self '$name$)\n"
- " (cl:make-array 0 :element-type '$type$\n"
+ " (cl:make-array 0 :element-type '$package$::$type$\n"
" :fill-pointer 0 :adjustable cl:t))");
}
@@ -257,11 +259,11 @@ void RepeatedMessageFieldGenerator::GenerateOctetSize(io::Printer* printer)
" (cl:dotimes (i length)\n");
if (descriptor_->type() == FieldDescriptor::TYPE_MESSAGE) {
printer->Print(
- " (cl:let ((s (octet-size (cl:aref v i))))\n"
+ " (cl:let ((s (pb:octet-size (cl:aref v i))))\n"
" (cl:incf size (cl:+ s (varint:length32 s))))))");
} else if (descriptor_->type() == FieldDescriptor::TYPE_GROUP) {
printer->Print(
- " (cl:incf size (octet-size (cl:aref v i)))))");
+ " (cl:incf size (pb:octet-size (cl:aref v i)))))");
}
}
@@ -285,8 +287,8 @@ void RepeatedMessageFieldGenerator::GenerateSerializeWithCachedSizes(
" (cl:setf index"
" (varint:encode-uint32-carefully buffer index limit $tag$))\n"
" (cl:setf index (varint:encode-uint32-carefully"
- " buffer index limit (cl:slot-value (cl:aref v i) '%cached-size%)))\n"
- " (cl:setf index (serialize (cl:aref v i) buffer index limit))))",
+ " buffer index limit (cl:slot-value (cl:aref v i) 'pb::%cached-size%)))\n"
+ " (cl:setf index (pb:serialize (cl:aref v i) buffer index limit))))",
"tag", SimpleItoa(tag));
} else if (descriptor_->type() == FieldDescriptor::TYPE_GROUP) {
uint32 start_tag =
@@ -298,7 +300,7 @@ void RepeatedMessageFieldGenerator::GenerateSerializeWithCachedSizes(
printer->Print(
" (cl:setf index"
" (varint:encode-uint32-carefully buffer index limit $start_tag$))\n"
- " (cl:setf index (serialize (cl:aref v i) buffer index limit))\n"
+ " (cl:setf index (pb:serialize (cl:aref v i) buffer index limit))\n"
" (cl:setf index"
" (varint:encode-uint32-carefully buffer index limit $end_tag$))))",
"start_tag", SimpleItoa(start_tag),
@@ -317,9 +319,9 @@ void RepeatedMessageFieldGenerator::GenerateMergeFromArray(
" (varint:parse-uint31-carefully buffer index limit)\n"
" (cl:when (cl:> (cl:+ new-index length) limit)\n"
" (cl:error \"buffer overflow\"))\n"
- " (cl:let ((message (cl:make-instance '$type$)))\n"
+ " (cl:let ((message (cl:make-instance '$package$::$type$)))\n"
" (cl:setf index"
- " (merge-from-array message buffer new-index"
+ " (pb:merge-from-array message buffer new-index"
" (cl:+ new-index length)))\n"
" (cl:when (cl:not (cl:= index (cl:+ new-index length)))\n"
" (cl:error \"buffer overflow\"))\n"
@@ -328,8 +330,8 @@ void RepeatedMessageFieldGenerator::GenerateMergeFromArray(
// XXXXXXXXXXXXXXXXXXXX this is probably wrong, but allows old test to pass
printer->Print(
variables_,
- "(cl:let ((message (cl:make-instance '$type$)))\n"
- " (cl:setf index (merge-from-array message buffer index limit))\n"
+ "(cl:let ((message (cl:make-instance '$package$::$type$)))\n"
+ " (cl:setf index (pb:merge-from-array message buffer index limit))\n"
" (cl:vector-push-extend message (cl:slot-value self '$name$)))\n");
// XXXXXXXXXX: The end tag can be more than one byte, so the (1- index)
// is wrong. We need to compare several bytes.
View
4 protoc/lisp/primitive_field.cc
@@ -188,11 +188,11 @@ void SetPrimitiveVariables(const FieldDescriptor* descriptor,
map<string, string>* variables,
bool repeated) {
(*variables)["name"] = FieldName(descriptor);
- (*variables)["type"] = PrimitiveTypeName(descriptor->cpp_type());
+ (*variables)["type"] = PrimitiveTypeName(descriptor);
(*variables)["default"] = DefaultValue(descriptor);
(*variables)["index"] = SimpleItoa(descriptor->index());
// (*variables)["number"] = SimpleItoa(descriptor->number());
-// (*variables)["classname"] = ClassName(FieldScope(descriptor), false);
+// (*variables)["classname"] = ClassName(FieldScope(descriptor));
(*variables)["tag"] = SimpleItoa(WireFormat::MakeTag(descriptor));
(*variables)["tag_size"] =
SimpleItoa(WireFormat::TagSize(
View
18 protoc/lisp/service.cc
@@ -140,8 +140,8 @@ void ServiceGenerator::GenerateMethodSignatures(
const MethodDescriptor* method = descriptor_->method(i);
map<string, string> sub_vars;
sub_vars["name"] = method->name();
- sub_vars["input_type"] = ClassName(method->input_type(), true);
- sub_vars["output_type"] = ClassName(method->output_type(), true);
+ sub_vars["input_type"] = ClassName(method->input_type());
+ sub_vars["output_type"] = ClassName(method->output_type());
sub_vars["virtual"] = virtual_or_non == VIRTUAL ? "virtual " : "";
printer->Print(sub_vars,
@@ -195,8 +195,8 @@ void ServiceGenerator::GenerateNotImplementedMethods(io::Printer* printer) {
sub_vars["classname"] = descriptor_->name();
sub_vars["name"] = method->name();
sub_vars["index"] = SimpleItoa(i);
- sub_vars["input_type"] = ClassName(method->input_type(), true);
- sub_vars["output_type"] = ClassName(method->output_type(), true);
+ sub_vars["input_type"] = ClassName(method->input_type());
+ sub_vars["output_type"] = ClassName(method->output_type());
printer->Print(sub_vars,
"void $classname$::$name$(::google::protobuf::RpcController* controller,\n"
@@ -225,8 +225,8 @@ void ServiceGenerator::GenerateCallMethod(io::Printer* printer) {
map<string, string> sub_vars;
sub_vars["name"] = method->name();
sub_vars["index"] = SimpleItoa(i);
- sub_vars["input_type"] = ClassName(method->input_type(), true);
- sub_vars["output_type"] = ClassName(method->output_type(), true);
+ sub_vars["input_type"] = ClassName(method->input_type());
+ sub_vars["output_type"] = ClassName(method->output_type());
// Note: ::google::protobuf::down_cast does not work here because it only works on pointers,
// not references.
@@ -270,7 +270,7 @@ void ServiceGenerator::GenerateGetPrototype(RequestOrResponse which,
map<string, string> sub_vars;
sub_vars["index"] = SimpleItoa(i);
- sub_vars["type"] = ClassName(type, true);
+ sub_vars["type"] = ClassName(type);
printer->Print(sub_vars,
" case $index$:\n"
@@ -293,8 +293,8 @@ void ServiceGenerator::GenerateStubMethods(io::Printer* printer) {
sub_vars["classname"] = descriptor_->name();
sub_vars["name"] = method->name();
sub_vars["index"] = SimpleItoa(i);
- sub_vars["input_type"] = ClassName(method->input_type(), true);
- sub_vars["output_type"] = ClassName(method->output_type(), true);
+ sub_vars["input_type"] = ClassName(method->input_type());
+ sub_vars["output_type"] = ClassName(method->output_type());
printer->Print(sub_vars,
"void $classname$_Stub::$name$(::google::protobuf::RpcController* controller,\n"
View
162 protoc/lisp/string_field.cc
@@ -49,17 +49,18 @@ namespace {
void SetStringVariables(const FieldDescriptor* descriptor,
map<string, string>* variables) {
(*variables)["name"] = FieldName(descriptor);
- (*variables)["type"] = PrimitiveTypeName(descriptor->cpp_type());
+ (*variables)["type"] = PrimitiveTypeName(descriptor);
(*variables)["defaultlength"]
= SimpleItoa(descriptor->default_value_string().size());
- (*variables)["default"] = StringOctets(descriptor->default_value_string());
+ (*variables)["default"] = DefaultValue(descriptor);
(*variables)["index"] = SimpleItoa(descriptor->index());
(*variables)["number"] = SimpleItoa(descriptor->number());
- (*variables)["classname"] = ClassName(FieldScope(descriptor), false);
(*variables)["tag"] = SimpleItoa(WireFormat::MakeTag(descriptor));
(*variables)["tag_size"]
= SimpleItoa(WireFormat::TagSize(
descriptor->number(), descriptor->type()));
+ (*variables)["element_size"]
+ = OctetSize(descriptor->type(), "(cl:aref x i)");
}
} // namespace
@@ -77,21 +78,15 @@ void StringFieldGenerator::GenerateSlot(io::Printer* printer) const {
printer->Print(
variables_,
"($name$\n"
-// " :accessor $name$\n" XXXX: custom accessors
- " :initform (cl:make-array\n"
- " $defaultlength$\n"
- " :element-type '(cl:unsigned-byte 8)\n"
- " :initial-contents '($default$))\n"
+ " :accessor $name$\n"
+ " :initform $default$\n"
" :type $type$)\n");
}
void StringFieldGenerator::GenerateClearingCode(io::Printer* printer) const {
printer->Print(
variables_,
- "(cl:setf (cl:slot-value self '$name$)\n"
- " (cl:make-array $defaultlength$"
- " :element-type '(cl:unsigned-byte 8)\n"
- " :initial-contents '($default$)))");
+ "(cl:setf (cl:slot-value self '$name$) $default$)");
}
void StringFieldGenerator::GenerateOctetSize(io::Printer* printer) const {
@@ -103,59 +98,51 @@ void StringFieldGenerator::GenerateOctetSize(io::Printer* printer) const {
}
void StringFieldGenerator::GenerateAccessor(io::Printer* printer) const {
- // XXXXXXXXXXXXXXX: the C++ code looks at
- // if (descriptor_->type() == FieldDescriptor::TYPE_BYTES)
- // and does some special things.
-
- // The string accessors convert octets to and from strings.
- printer->Print(
- variables_,
- "(cl:unless (cl:fboundp '$name$)\n"
- " (cl:defgeneric $name$ (proto)))\n"
- "(cl:defmethod $name$ ((self $classname$))\n"
- " (com.google.base:utf8-octets-to-string (cl:slot-value self '$name$)))\n"
- "\n"
- "(cl:export '$name$-octets)\n"
- "(cl:unless (cl:fboundp '$name$-octets)\n"
- " (cl:defgeneric $name$-octets (proto)))\n"
- "(cl:defmethod $name$-octets ((self $classname$))\n"
- " (cl:slot-value self '$name$))\n"
- "\n"
- "(cl:unless (cl:fboundp '(cl:setf $name$))\n"
- " (cl:defgeneric (cl:setf $name$) (new-value proto)))\n"
- "(cl:defmethod (cl:setf $name$) (new-value (self $classname$))\n"
- " (cl:etypecase new-value\n"
- " ((cl:string)\n"
- " (cl:setf (cl:slot-value self '$name$)\n"
- " (com.google.base:string-to-utf8-octets new-value)))\n"
- " ((com.google.base:octet-vector)\n"
- " (cl:setf (cl:slot-value self '$name$) new-value)))\n"
- " (cl:setf (cl:ldb (cl:byte 1 $index$)"
- " (cl:slot-value self '%has-bits%)) 1)\n"
- " new-value)\n");
+ // The default accessor works fine for string fields.
}
void StringFieldGenerator::GenerateSerializeWithCachedSizes(
io::Printer* printer) const {
printer->Print(
variables_,
"(cl:setf index"
- " (varint:encode-uint32-carefully buffer index limit $tag$))\n"
- "(cl:setf index"
- " (wire-format:write-octets-carefully"
- " buffer index limit (cl:slot-value self '$name$)))");
+ " (varint:encode-uint32-carefully buffer index limit $tag$))\n");
+ if (descriptor_->type() == FieldDescriptor::TYPE_BYTES) {
+ printer->Print(
+ variables_,
+ "(cl:setf index"
+ " (wire-format:write-octets-carefully"
+ " buffer index limit (cl:slot-value self '$name$)))");
+ } else {
+ printer->Print(
+ variables_,
+ "(cl:setf index"
+ " (wire-format:write-octets-carefully"
+ " buffer index limit (cl:slot-value (cl:slot-value self '$name$) 'pb::%octets%)))");
+ }
}
void StringFieldGenerator::GenerateMergeFromArray(
io::Printer* printer) const {
- printer->Print(
- variables_,
- "(cl:multiple-value-bind (value new-index)\n"
- " (wire-format:read-octets-carefully buffer index limit)\n"
- " (cl:setf (cl:slot-value self '$name$) value)\n"
- " (cl:setf (cl:ldb (cl:byte 1 $index$)"
- " (cl:slot-value self '%has-bits%)) 1)\n"
- " (cl:setf index new-index))");
+ if (descriptor_->type() == FieldDescriptor::TYPE_BYTES) {
+ printer->Print(
+ variables_,
+ "(cl:multiple-value-bind (value new-index)\n"
+ " (wire-format:read-octets-carefully buffer index limit)\n"
+ " (cl:setf (cl:slot-value self '$name$) value)\n"
+ " (cl:setf (cl:ldb (cl:byte 1 $index$)"
+ " (cl:slot-value self '%has-bits%)) 1)\n"
+ " (cl:setf index new-index))");
+ } else {
+ printer->Print(
+ variables_,
+ "(cl:multiple-value-bind (value new-index)\n"
+ " (wire-format:read-octets-carefully buffer index limit)\n"
+ " (cl:setf (cl:slot-value self '$name$) (pb:string-field value))\n"
+ " (cl:setf (cl:ldb (cl:byte 1 $index$)"
+ " (cl:slot-value self '%has-bits%)) 1)\n"
+ " (cl:setf index new-index))");
+ }
}
void StringFieldGenerator::GenerateMergingCode(io::Printer* printer) const {
@@ -175,8 +162,6 @@ RepeatedStringFieldGenerator::RepeatedStringFieldGenerator(
RepeatedStringFieldGenerator::~RepeatedStringFieldGenerator() {}
void RepeatedStringFieldGenerator::GenerateSlot(io::Printer* printer) const {
- // XXXX: C++ code generator creates a _default_$name$_ member.
- // What is it used for? Should we do the same?
printer->Print(
variables_,
"($name$\n"
@@ -207,9 +192,7 @@ void RepeatedStringFieldGenerator::GenerateOctetSize(io::Printer* printer)
" (length (cl:length x)))\n"
" (cl:incf size (cl:* $tag_size$ length))\n"
" (cl:dotimes (i length)\n"
- " (cl:incf size\n"
- " (cl:let ((s (cl:length (cl:aref x i))))\n"
- " (cl:+ s (varint:length32 s))))))");
+ " (cl:incf size $element_size$)))");
}
void RepeatedStringFieldGenerator::GenerateAccessor(io::Printer* printer)
@@ -219,36 +202,57 @@ void RepeatedStringFieldGenerator::GenerateAccessor(io::Printer* printer)
void RepeatedStringFieldGenerator::GenerateSerializeWithCachedSizes(
io::Printer* printer) const {
- printer->Print(
- variables_,
- "(cl:let* ((v (cl:slot-value self '$name$))\n"
- " (length (cl:length v)))\n"
- " (cl:loop for i from 0 below length do\n"
- " (cl:setf index"
- " (varint:encode-uint32-carefully buffer index limit $tag$))\n"
- " (cl:setf index"