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.
brown · Feb 3, 2012 · 35bb363 · 35bb363
1 parent 2fe74ca
commit 35bb363
Show file tree

Hide file tree

Showing 17 changed files with 837 additions and 624 deletions.
diff --git a/message-test.lisp b/message-test.lisp
diff --git a/package.lisp b/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.")

diff --git a/proto-lisp-test.lisp b/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

diff --git a/protoc/lisp/enum.cc b/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

diff --git a/protoc/lisp/enum.h b/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_;