Add a few missing features that aren't in any documentation.

Testing : precheckin --full --strict-errors
Reviewer: Fare (please)

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:

I extended the CL-Protobufs examples

Description:

Add a few missing features that aren't in any documentation.

String literals can look like "foo"<whitespace>"bar".
 - Fix 'parse-string' to handle this.

Option values can be complex structures, not just atoms.
 - If 'parse-proto-option' sees a '{' character after the '=',
   it should use 'parse-text-format' to read the option value.
 - Fix the 'protobuf-option' printer to call 'print-text-format'
   for complex option values.
 - Minor refactoring to the text format parser and printer in
   order to support the above.

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

diff --git a/parser.lisp b/parser.lisp
index 3ef687a..922c2c6 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -156,7 +156,11 @@
         collect ch into string
         finally (progn
                   (skip-whitespace stream)
-                  (return (coerce string 'string)))))
+                  (if (eql (peek-char nil stream nil) ch0)
+                    ;; If the next character is a quote character, that means
+                    ;; we should go parse another string and concatenate it
+                    (return (strcat (coerce string 'string) (parse-string stream)))
+                    (return (coerce string 'string))))))
 
 (defun unescape-char (stream)
   "Parse the next \"escaped\" character from the stream."
@@ -375,6 +379,14 @@
                               (parse-string stream))
                              ((or (digit-char-p ch) (member ch '(#\- #\+ #\.)))
                               (parse-number stream))
+                             ((eql ch #\{)
+                              (let ((message (find-message (or protobuf *protobuf*) key)))
+                                (if message
+                                  ;; We've got a complex message as a value to an option
+                                  ;; This only shows up in custom optionss
+                                  (parse-text-format message :stream stream :parse-name nil)
+                                  ;; Who knows what to do? Skip the value
+                                  (skip-field stream))))
                              (t (kintern (parse-token stream)))))
                 (setq terminator (expect-char stream terminators () "option"))
                 (maybe-skip-comments stream)))

diff --git a/printer.lisp b/printer.lisp
index 7844ff2..97e19de 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -138,27 +138,46 @@
       nil)))
 
 (defun cl-user::protobuf-option (stream option colon-p atsign-p)
-  (let ((type (or (second (find (proto-name option) *option-types* :key #'first :test #'string=))
-                  (proto-type option))))
+  (let* ((type (or (second (find (proto-name option) *option-types* :key #'first :test #'string=))
+                   (proto-type option)))
+         (value (proto-value option)))
     (cond (colon-p                              ;~:/protobuf-option/ -- .proto format
            (let ((fmt-control
                   (cond ((find (proto-name option) *lisp-options* :key #'first :test #'string=)
                          (case type
                            ((symbol) "(~A)~@[ = ~A~]")
                            ((boolean) "(~A)~@[ = ~(~A~)~]")
-                           (otherwise "(~A)~@[ = ~S~]")))
+                           (otherwise
+                            (cond ((typep value 'standard-object)
+                                   ;; If the value is an instance of some class,
+                                   ;; then it must be some sort of complex option,
+                                   ;; so print the value using the text format
+                                   (setq value
+                                         (with-output-to-string (s)
+                                           (print-text-format value nil
+                                                              :stream s :print-name nil :suppress-line-breaks t)))
+                                   "(~A)~@[ = ~A~]")
+                                  (t
+                                   "(~A)~@[ = ~S~]")))))
                         (t
                          (case type
                            ((symbol) "~A~@[ = ~A~]")
                            ((boolean) "~A~@[ = ~(~A~)~]")
-                           (otherwise "~A~@[ = ~S~]"))))))
-             (format stream fmt-control (proto-name option) (proto-value option))))
+                           (otherwise
+                            (cond ((typep value 'standard-object)
+                                   (setq value
+                                         (with-output-to-string (s)
+                                           (print-text-format value nil
+                                                              :stream s :print-name nil :suppress-line-breaks t)))
+                                   "~A~@[ = ~A~]")
+                                  (t "~A~@[ = ~S~]"))))))))
+             (format stream fmt-control (proto-name option) value)))
           (atsign-p                             ;~@/protobuf-option/ -- string/value format
            (let ((fmt-control (if (eq type 'symbol) "~(~S~) ~A" "~(~S~) ~S")))
-             (format stream fmt-control (proto-name option) (proto-value option))))
+             (format stream fmt-control (proto-name option) value)))
           (t                                    ;~/protobuf-option/  -- keyword/value format
            (let ((fmt-control (if (eq type 'symbol) "~(:~A~) ~A" "~(:~A~) ~S")))
-             (format stream fmt-control (proto-name option) (proto-value option)))))))
+             (format stream fmt-control (proto-name option) value))))))
 
 (defun cl-user::source-location (stream location colon-p atsign-p)
   (declare (ignore colon-p atsign-p))

diff --git a/text-format.lisp b/text-format.lisp
index 18af325..183b1a8 100644 (file)
--- a/text-format.lisp
+++ b/text-format.lisp
@@ -16,7 +16,7 @@
 (defvar *suppress-line-breaks* nil
   "When true, don't generate line breaks in the text format")
 
-(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks)
+(defgeneric print-text-format (object &optional type &key stream suppress-line-breaks print-name)
   (:documentation
    "Prints the object 'object' of type 'type' onto the stream 'stream' using the
     textual format.
@@ -24,7 +24,7 @@
 
 (defmethod print-text-format (object &optional type
                               &key (stream *standard-output*)
-                                   (suppress-line-breaks *suppress-line-breaks*))
+                                   (suppress-line-breaks *suppress-line-breaks*) (print-name t))
   (let* ((type    (or type (type-of object)))
          (message (find-message-for-class type)))
     (assert message ()
@@ -122,9 +122,11 @@
                                          (print-prim v type field stream
                                                      (or suppress-line-breaks indent)))))))))))))
         (declare (dynamic-extent #'do-field))
-        (if suppress-line-breaks
-          (format stream "~A { " (proto-name message))
-          (format stream "~&~A {~%" (proto-name message)))
+        (if print-name
+          (if suppress-line-breaks
+            (format stream "~A { " (proto-name message))
+            (format stream "~&~A {~%" (proto-name message)))
+          (format stream "{"))
         (map () (curry #'do-field object message 0) (proto-fields message))
         (if suppress-line-breaks
           (format stream "}")
@@ -175,20 +177,23 @@
 
 ;;; Parse objects that were serialized using the text format
 
-(defgeneric parse-text-format (type &key stream)
+(defgeneric parse-text-format (type &key stream parse-name)
   (:documentation
    "Parses an object of type 'type' from the stream 'stream' using the textual format."))
 
-(defmethod parse-text-format ((type symbol) &key (stream *standard-input*))
+(defmethod parse-text-format ((type symbol)
+                              &key (stream *standard-input*) (parse-name t))
   (let ((message (find-message-for-class type)))
     (assert message ()
             "There is no Protobuf message having the type ~S" type)
-    (parse-text-format message :stream stream)))
+    (parse-text-format message :stream stream :parse-name parse-name)))
 
-(defmethod parse-text-format ((message protobuf-message) &key (stream *standard-input*))
-  (let ((name (parse-token stream)))
-    (assert (string= name (proto-name message)) ()
-            "The message is not of the expected type ~A" (proto-name message)))
+(defmethod parse-text-format ((message protobuf-message)
+                              &key (stream *standard-input*) (parse-name t))
+  (when parse-name
+    (let ((name (parse-token stream)))
+      (assert (string= name (proto-name message)) ()
+              "The message is not of the expected type ~A" (proto-name message))))
   (labels ((deserialize (type trace)
              (let* ((message (find-message trace type))
                     (object  (and message
@@ -286,24 +291,25 @@
                                                   (otherwise (parse-signed-int stream)))))
                                        (when slot
                                          (setf (slot-value object slot)
-                                               (funcall (proto-deserializer msg) val))))))))))))))
-           (skip-field (stream)
-             ;; Skip either a token or a balanced {}-pair
-             (ecase (peek-char nil stream nil)
-               ((#\:)
-                (read-char stream)
-                (skip-whitespace stream)
-                (parse-token-or-string stream))
-               ((#\{)
-                (let ((depth 0))
-                  (loop for ch = (read-char stream)
-                        do (cond ((eql ch #\")
-                                  (loop for ch0 = (read-char stream)
-                                        until (eql ch0 #\")))
-                                 ((eql ch #\{)
-                                  (iincf depth))
-                                 ((eql ch #\})
-                                  (idecf depth)))
-                        until (i= depth 0)))))))
-    (declare (dynamic-extent #'deserialize #'skip-field))
+                                               (funcall (proto-deserializer msg) val)))))))))))))))
+    (declare (dynamic-extent #'deserialize))
     (deserialize (proto-class message) message)))
+
+(defun skip-field (stream)
+  "Skip either a token or a balanced {}-pair."
+  (ecase (peek-char nil stream nil)
+    ((#\:)
+     (read-char stream)
+     (skip-whitespace stream)
+     (parse-token-or-string stream))
+    ((#\{)
+     (let ((depth 0))
+       (loop for ch = (read-char stream)
+             do (cond ((eql ch #\")
+                       (loop for ch0 = (read-char stream)
+                             until (eql ch0 #\")))
+                      ((eql ch #\{)
+                       (iincf depth))
+                      ((eql ch #\})
+                       (idecf depth)))
+             until (i= depth 0))))))