It's an error to assign field numbers between 19000 and 19999.

The .proto parser should try to put symbols in the right package.

git-svn-id: http://svn.internal.itasoftware.com/svn/ita/branches/qres/swm/borgify-1/qres/lisp/quux/protobufs@533822 f8382938-511b-0410-9cdd-bb47b084005c

diff --git a/clos-transform.lisp b/clos-transform.lisp
index 7273e5489dfb1eab82b6e084a36df8000ba7b51e..6030c71aa74e7d0f814ebf403f4a3646ab5d8229 100644 (file)
--- a/clos-transform.lisp
+++ b/clos-transform.lisp
@@ -58,7 +58,7 @@
           (when msg
             (collect-msg msg))
           (when field
-            (incf index 1)
+            (incf index 1)                              ;don't worry about the 19000-19999 restriction
             (collect-field field))))
       (make-instance 'protobuf-message
         :name  (class-name->proto (class-name class))

diff --git a/define-proto.lisp b/define-proto.lisp
index f4d0aa02002290ae365df01f6b6aefbc6ca6ce25..6dff00780685b5d821e55b88f72bede407413f3b 100644 (file)
--- a/define-proto.lisp
+++ b/define-proto.lisp
@@ -122,6 +122,7 @@
                     (slots collect-slot)
                     (forms collect-form))
     (let ((index 0))
+      (declare (type fixnum index))
       (dolist (fld fields)
         (case (car fld)
           ((define-enum define-message define-extension)
@@ -138,8 +139,10 @@
                ((define-extension)
                 (collect-msg model)))))
           (otherwise
+           (when (i= index 18999)                       ;skip over the restricted range
+             (setq index 19999))
            (destructuring-bind (slot &key type default) fld
-             (let* ((idx  (if (listp slot) (second slot) (incf index)))
+             (let* ((idx  (if (listp slot) (second slot) (iincf index)))
                     (slot (if (listp slot) (first slot) slot))
                     (reqd (clos-type-to-protobuf-required type))
                     (accessor (intern (if conc-name (format nil "~A~A" conc-name slot) (symbol-name slot))

diff --git a/model-classes.lisp b/model-classes.lisp
index 21278f0a809ac344f4125237c1ce6e7659258219..5f727db11254326a0adfede06581f853cea7f3aa 100644 (file)
--- a/model-classes.lisp
+++ b/model-classes.lisp
@@ -22,6 +22,7 @@
 
 ;; A few things (the pretty printer) want to keep track of the current schema
 (defvar *protobuf* nil)
+(defvar *protobuf-package* nil)
 
 
 ;;; The model classes
@@ -59,7 +60,7 @@
             :accessor proto-package
             :initarg :package
             :initform nil)
-   ;;--- Support imports properly
+   ;;---*** Support imports properly
    (imports :type (list-of string)              ;any imports
             :accessor proto-imports
             :initarg :imports
@@ -245,6 +246,11 @@
   (:documentation
    "The model class that represents one field within a Protobufs message."))
 
+(defmethod initialize-instance :after ((field protobuf-field) &rest initargs)
+  (declare (ignore initargs))
+  (assert (not (<= 19000 (proto-index field) 19999)) ()
+          "Protobuf field indexes between 19000 and 19999 are not allowed"))
+
 (defmethod print-object ((f protobuf-field) stream)
   (print-unprintable-object (f stream :type t :identity t)
     (format stream "~A ~A~:[~*~*~; (~S~@[ :: ~S~])~] = ~D"

diff --git a/parser.lisp b/parser.lisp
index 72fe5ec9df65dd505a4331fba725e935672e0301..8c51d4012b79860cd27df2b11c40e09a47564599 100644 (file)
--- a/parser.lisp
+++ b/parser.lisp
@@ -13,6 +13,8 @@
 
 ;;; .proto file parsing
 
+;;; Parsing utilities
+
 (defun-inline proto-whitespace-char-p (ch)
   (locally (declare (optimize (speed 3) (safety 0) (debug 0)))
     (and ch (member ch '(#\space #\tab #\return #\newline)))))
@@ -71,6 +73,7 @@
                   (return))))
   (skip-whitespace stream))
 
+
 (defun expect-char (stream ch &optional within)
   "Expect to see 'ch' as the next character in the stream; signal an error if it's not there.
    Then skip all of the following whitespace."
@@ -95,18 +98,6 @@
                     (skip-whitespace stream)
                     (return (coerce token 'string))))))
 
-(defun parse-int (stream)
-  "Parse the next token in the stream as an integer, then skip the following whitespace.
-   The returned value is the integer."
-  (when (digit-char-p (peek-char nil stream nil))
-    (loop for ch = (read-char stream nil)
-          for ch1 = (peek-char nil stream nil)
-          collect ch into token
-          until (or (null ch1) (not (digit-char-p ch1)))
-          finally (progn
-                    (skip-whitespace stream)
-                    (return (parse-integer (coerce token 'string)))))))
-
 (defun parse-string (stream)
   "Parse the next quoted string in the stream, then skip the following whitespace.
    The returned value is the string, without the quotation marks."
@@ -118,13 +109,20 @@
                   (skip-whitespace stream)
                   (return (coerce string 'string)))))
 
+(defun parse-int (stream)
+  "Parse the next token in the stream as an integer, then skip the following whitespace.
+   The returned value is the integer."
+  (when (digit-char-p (peek-char nil stream nil))
+    (loop for ch = (read-char stream nil)
+          for ch1 = (peek-char nil stream nil)
+          collect ch into token
+          until (or (null ch1) (not (digit-char-p ch1)))
+          finally (progn
+                    (skip-whitespace stream)
+                    (return (parse-integer (coerce token 'string)))))))
 
-(defun proto-intern (name intern-fn)
-  (let ((package (and *protobuf*
-                      (proto-package *protobuf*)
-                      (find-package (proto-package *protobuf*)))))
-    (funcall intern-fn name package)))
 
+;;; The parser itself
 
 (defun parse-protobuf-from-file (filename)
   "Parses the named file as a .proto file, and returns the Protobufs schema."
@@ -135,14 +133,15 @@
     (parse-protobuf-from-stream stream :name (pathname-name (pathname stream)))))
 
 ;; The syntax for Protocol Buffers is so simple that it doesn't seem worth
-;; writing a complicated parser
+;; writing a sophisticated parser
 ;; Note that we don't put the result into *all-protobufs*; do that at a higher level
 (defun parse-protobuf-from-stream (stream &key name)
   "Parses a top-level .proto file from the stream 'stream'.
    Returns the protobuf schema that describes the .proto file."
   (let* ((protobuf   (make-instance 'protobuf
                        :name name))
-         (*protobuf* protobuf))
+         (*protobuf* protobuf)
+         (*protobuf-package* nil))
     (loop
       (skip-whitespace stream)
       (maybe-skip-comments stream)
@@ -169,9 +168,12 @@
 (defun parse-proto-package (stream protobuf &optional (terminator #\;))
   "Parse a Protobufs package line from 'stream'.
    Updates the 'protobuf' object to use the package."
-  (let ((package (prog1 (parse-token stream)
-                   (expect-char stream terminator "package")
-                   (maybe-skip-comments stream))))
+  (let* ((package  (prog1 (parse-token stream)
+                     (expect-char stream terminator "package")
+                     (maybe-skip-comments stream)))
+         (lisp-pkg (or (find-package package)
+                       (find-package (string-upcase package)))))
+    (setq *protobuf-package* lisp-pkg)
     (setf (proto-package protobuf) package)))
 
 (defun parse-proto-import (stream protobuf &optional (terminator #\;))
@@ -209,7 +211,7 @@
                  (maybe-skip-comments stream)))
          (enum (make-instance 'protobuf-enum
                  :name name
-                 :class (proto-intern name #'proto->class-name))))
+                 :class (proto->class-name name *protobuf-package*))))
     (loop
       (let ((name (parse-token stream)))
         (when (null name)
@@ -229,7 +231,7 @@
          (value (make-instance 'protobuf-enum-value
                   :name  name
                   :index idx
-                  :value (proto-intern name #'proto->enum-name))))
+                  :value (proto->enum-name name *protobuf-package*))))
     (setf (proto-values enum) (nconc (proto-values enum) (list value)))))
 
 
@@ -241,7 +243,7 @@
                  (maybe-skip-comments stream)))
          (message (make-instance 'protobuf-message
                     :name name
-                    :class (proto-intern name #'proto->class-name))))
+                    :class (proto->class-name name *protobuf-package*))))
     (loop
       (let ((token (parse-token stream)))
         (when (null token)
@@ -278,10 +280,10 @@
                                     "string" "bytes" "bool" "float" "double") :test #'string=)
                    (kintern type)
                    type))
-         (class  (if (keywordp ptype) ptype (proto-intern type #'proto->class-name)))
+         (class  (if (keywordp ptype) ptype (proto->class-name type *protobuf-package*)))
          (field  (make-instance 'protobuf-field
                    :name  name
-                   :value (proto-intern name #'proto->slot-name)
+                   :value (proto->slot-name name *protobuf-package*)
                    :type  type
                    :class class
                    ;; One of :required, :optional or :repeated
@@ -343,11 +345,11 @@
                  opts))
          (rpc (make-instance 'protobuf-rpc
                 :name  name
-                :class (proto-intern name #'proto->class-name)
+                :class (proto->class-name name *protobuf-package*)
                 :input-type  in
-                :input-class (proto-intern in #'proto->class-name)
+                :input-class (proto->class-name in *protobuf-package*)
                 :output-type  out
-                :output-class (proto-intern out #'proto->class-name)
+                :output-class (proto->class-name out *protobuf-package*)
                 :options opts)))
     (assert (string= ret "returns") ()
             "Syntax error in 'message' at position ~D" (file-position stream))

diff --git a/upgradable.lisp b/upgradable.lisp
index 345ec062579af04e114a6bd19e6d6230cd8a1a41..d5ccaa4a28ec2517a6b28dfdb3a75021c63da1f0 100644 (file)
--- a/upgradable.lisp
+++ b/upgradable.lisp
@@ -13,6 +13,7 @@
 
 ;;; Can a version of a protobuf be upgraded to a new version
 
+;;--- This should return (a set of) reason(s) if the upgrade will fail
 (defgeneric protobuf-upgradable (new old)
   (:documentation
    "Returns true if and only if the old protobuf schema (enum, message, etc)