Fix some user-reported bugs

Testing : precheckin --full --strict-errors
Reviewer: Sergey V, Shaun M

JTB impact: No
Ops impact: No

Change to config                        : No
Change to XML schema                    : No
Change to DB schema                     : No
Change to transport (timeouts, headers) : No
Any change (or new use) of OAQs         : No
Change to inter-component transactions  : No
Depends on any other checkin / bug      : No

Tests that will verify:

The CL-Protobufs tests

Description:

I had made a "policy decision" that the package created
by importing a .proto file would (:use :common-lisp). In
practice, this turned out to be a mistake. Sergey suggested
a fix that I think is correct, so in it goes.

Shaun noticed that the optimized 'serialize-object' and
'object-size' methods didn't quite implement what they were
supposed to for optional boolean fields whose value was never
supplied. Fix the optimized methods to implement the same
(correct) semantics as the unoptimized ones.

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/trunk/qres/lisp/libs/cl-protobufs@561714 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/parser.lisp b/parser.lisp
index 922c2c6..5f77b75 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -319,7 +319,10 @@
                                (name   (and option (proto-name option)))
                                (value  (and option (proto-value option))))
                           (when (and option (option-name= name "lisp_package"))
-                            (let ((package (or (find-proto-package value) *protobuf-package*)))
+                            (let ((package (or (find-proto-package value)
+                                               ;; Try to put symbols into the right package
+                                               (make-package (string-upcase value) :use ())
+                                               *protobuf-package*)))
                               (setf (proto-lisp-package schema) value)
                               (setq *protobuf-package* package)))))
                        ((string= token "enum")

diff --git a/printer.lisp b/printer.lisp
index 97e19de..75cfcb6 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -422,13 +422,15 @@
 
 ;;; Pretty print a schema as a .lisp file
 
-(defvar *show-lisp-enum-indexes* t)
+(defvar *show-lisp-enum-indexes*  t)
 (defvar *show-lisp-field-indexes* t)
+(defvar *use-common-lisp-package* nil)
 
 (defmethod write-schema-as ((type (eql :lisp)) (schema protobuf-schema) stream
                             &key (indentation 0)
                                  (show-field-indexes *show-lisp-field-indexes*)
-                                 (show-enum-indexes *show-lisp-enum-indexes*))
+                                 (show-enum-indexes *show-lisp-enum-indexes*)
+                                 (use-common-lisp *use-common-lisp-package*))
   (with-prefixed-accessors (name class documentation package lisp-package imports) (proto- schema)
     (let* ((optimize (let ((opt (find-option schema "optimize_for")))
                        (and opt (cond ((string= opt "SPEED") :speed)
@@ -438,18 +440,20 @@
                                 (proto-options schema)))
            (pkg      (and package (if (stringp package) package (string package))))
            (lisp-pkg (and lisp-package (if (stringp lisp-package) lisp-package (string lisp-package))))
-           (*show-lisp-enum-indexes* show-enum-indexes)
+           (*show-lisp-enum-indexes*  show-enum-indexes)
            (*show-lisp-field-indexes* show-field-indexes)
+           (*use-common-lisp-package* use-common-lisp)
            (*protobuf-package* (or (find-proto-package lisp-pkg) *package*))
            (*package* *protobuf-package*))
       (when (or lisp-pkg pkg)
         (let ((pkg (string-upcase (or lisp-pkg pkg))))
           (format stream "~&(cl:eval-when (:execute :compile-toplevel :load-toplevel) ~
                           ~%  (unless (cl:find-package \"~A\") ~
-                          ~%    (cl:defpackage ~A (:use :COMMON-LISP)))) ~
+                          ~%    (cl:defpackage ~A (:use~@[ ~(~S~)~])))) ~
                           ~%(cl:in-package \"~A\") ~
                           ~%(cl:export '(~{~A~^~%             ~}))~%~%"
-                  pkg pkg pkg (collect-exports schema))))
+                  pkg pkg (and *use-common-lisp-package* :common-lisp) pkg
+                  (collect-exports schema))))
       (when documentation
         (write-schema-documentation type documentation stream :indentation indentation))
       (format stream "~&(proto:define-schema ~(~A~)" (or class name))

diff --git a/serialize.lisp b/serialize.lisp
index e4cb77d..595df40 100644 (file)
--- a/serialize.lisp
+++ b/serialize.lisp
@@ -82,7 +82,7 @@
     (declare (type fixnum index))
     (macrolet ((read-slot (object slot reader)
                  ;; Don't do a boundp check, we assume the object is fully populated
-                 ;; Unpopulated slots should be "nullable" and should contain nil
+                 ;; Unpopulated slots should be "nullable" and will contain nil when empty
                  `(if ,reader
                     (funcall ,reader ,object)
                     (slot-value ,object ,slot))))
@@ -465,7 +465,7 @@
     (declare (type fixnum size))
     (macrolet ((read-slot (object slot reader)
                  ;; Don't do a boundp check, we assume the object is fully populated
-                 ;; Unpopulated slots should be "nullable" and should contain nil
+                 ;; Unpopulated slots should be "nullable" and will contain nil when empty
                  `(if ,reader
                     (funcall ,reader ,object)
                     (slot-value ,object ,slot))))
@@ -658,7 +658,7 @@
                            (let ((tag (make-tag class index)))
                              (if (eq class :bool)
                                (if (or (eq (proto-required field) :required)
-                                       reader)
+                                       (null (proto-value field)))
                                  `(let ((,vval ,reader))
                                     (setq ,vidx (serialize-prim ,vval ,class ,tag ,vbuf ,vidx)))
                                  `(let ((,vval (cond ((slot-boundp ,vobj ',(proto-value field))
@@ -971,7 +971,7 @@
                             (collect-sizer
                              (if (eq class :bool)
                                (if (or (eq (proto-required field) :required)
-                                       reader)
+                                       (null (proto-value field)))
                                  `(let ((,vval ,reader))
                                     (declare (ignorable ,vval))
                                     (iincf ,vsize (prim-size ,vval ,class ,tag)))