(defmethod object-initialized-p (object (type symbol))
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(object-initialized-p object message)))
(defmethod object-initialized-p (object (message protobuf-message))
(defmethod slot-initialized-p (object (type symbol) slot)
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(slot-initialized-p object message slot)))
(defmethod slot-initialized-p (object (message protobuf-message) slot)
(defmethod reinitialize-object (object (type symbol))
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(reinitialize-object object message)))
(defmethod reinitialize-object (object (message protobuf-message))
(:method ((object standard-object))
(let* ((class (type-of object))
(message (find-message-for-class class)))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(object-initialized-p object message))))
(defgeneric clear (object)
(:method ((object standard-object))
(let* ((class (type-of object))
(message (find-message-for-class class)))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(reinitialize-object object message))))
(defgeneric has-field (object slot)
(:method ((object standard-object) slot)
(let* ((class (type-of object))
(message (find-message-for-class class)))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(slot-initialized-p object message slot))))
(defgeneric clear-field (object slot)
(:method ((object standard-object) slot)
(let* ((class (type-of object))
(message (find-message-for-class class)))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(reinitialize-slot object message slot))))
;; This is simpler than 'object-size', but doesn't fully support aliasing
(let* ((class (type-of object))
(message (find-message-for-class class))
(type (and message (proto-class message))))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(let ((visited (make-size-cache object type)))
(object-size object type visited)))))
(let* ((class (type-of object))
(message (find-message-for-class class))
(type (and message (proto-class message))))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(let* ((visited (make-size-cache object type))
(size (object-size object type visited))
(start (or start 0))
(buffer (or buffer (make-byte-vector size))))
- (assert (>= (length buffer) size) ()
- "The buffer ~S is not large enough to hold ~S" buffer object)
+ (unless (>= (length buffer) size)
+ (serialization-error "The buffer ~S is not large enough to hold ~S" buffer))
(multiple-value-bind (nbuf nend)
(serialize-object object type buffer start visited)
- (declare (ignore nbuf))
- (values nend buffer))))))
+ (declare (ignore nbuf))
+ (values nend buffer))))))
(defgeneric merge-from-array (object buffer &optional start end)
(:documentation
(let* ((class (type-of object))
(message (find-message-for-class class))
(type (and message (proto-class message))))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
(let* ((start (or start 0))
(end (or end (length buffer))))
(merge-from-message object (deserialize-object type buffer start end))))))
(let* ((class (type-of object))
(message (find-message-for-class class))
(type (and message (proto-class message))))
- (assert message ()
- "There is no Protobufs message for the class ~S" class)
- (assert (eq class (type-of source)) ()
- "The objects ~S and ~S are of not of the same class" object source)
+ (unless message
+ (serialization-error "There is no Protobufs message for the class ~S" class))
+ (unless (eq class (type-of source))
+ (serialization-error "The objects ~S and ~S are of not of the same class" object source))
;;--- Do this (should return side-effected 'object', not 'source')
type
source)))
(define-condition undefined-stream-type (undefined-method-type)
()
(:default-initargs :where "Stream"))
+
+
+;;; (De)serialization errors
+
+(define-condition serialization-error (simple-error)
+ ()
+ (:documentation "Indicates that some sort of (de)serialization error has occurred.")
+ (:default-initargs :format-control "Serialization error")
+ (:report (lambda (condition stream)
+ (format stream "~?"
+ (simple-condition-format-control condition)
+ (simple-condition-format-arguments condition)))))
+
+(defun serialization-error (format-control &rest format-args)
+ (error 'serialization-error
+ :format-control format-control
+ :format-arguments (copy-list format-args)))
"ERROR-TYPE-NAME"
"ERROR-FIELD"
"ERROR-METHOD"
+ "SERIALIZATION-ERROR"
;; Object lookup
"FIND-MESSAGE"
(defmethod clear-size-cache ((object base-protobuf-message) type)
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(macrolet ((read-slot (object slot reader)
`(if ,reader
(funcall ,reader ,object)
(defmethod serialize-object (object type buffer &optional start visited)
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
- (serialize-object object message buffer start visited)))
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
+ (handler-case
+ (serialize-object object message buffer start visited)
+ (error (e)
+ (serialization-error "Error serializing object ~S: ~A" object (princ-to-string e))))))
;; 'visited' is used to cache object sizes
;; If it's non-nil. it must to be a table with the sizes already in it
(defmethod deserialize-object (type buffer &optional start end (end-tag 0))
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
- (deserialize-object message buffer start end end-tag)))
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
+ (handler-case
+ (deserialize-object message buffer start end end-tag)
+ (error (e)
+ (serialization-error "Error deserializing buffer ~S: ~A" buffer (princ-to-string e))))))
;; The default method uses metadata from the protobuf "schema" for the message
(defmethod deserialize-object ((message protobuf-message) buffer &optional start end (end-tag 0))
;; If there's no field descriptor for this index, just skip
;; the next element in the buffer having the given wire type
(setq index (skip-element buffer index tag))
- ;;--- Check for mismatched wire type, running past end of buffer, etc
+ ;; We don't explicitly check for mismatched wire type, running past the
+ ;; end of the buffer, etc; instead, we'll count on the high likelihood
+ ;; of some kind of an error getting signalled (e.g., array out of bounds)
+ ;; and catch it at a higher level. Yay, Lisp!
(cond ((and field (eq (proto-required field) :repeated))
(let ((vectorp (vector-field-p field)))
(cond ((and (proto-packed field) (packed-type-p type))
(defmethod object-size (object type &optional visited)
(let ((message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(object-size object message visited)))
;; 'visited' is used to cache object sizes
(suppress-line-breaks *suppress-line-breaks*) (print-name t))
(let* ((type (or type (type-of object)))
(message (find-message-for-class type)))
- (assert message ()
- "There is no Protobuf message having the type ~S" type)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(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
(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)
+ (unless message
+ (serialization-error "There is no Protobuf message having the type ~S" type))
(parse-text-format message :stream stream :parse-name parse-name)))
(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))))
+ (unless (string= name (proto-name message))
+ (serialization-error "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
(let ((idx (encode-uint32 ,tag ,buffer ,index)))
(declare (type fixnum idx))
,(ecase type
- ((:int32 )
+ ((:int32)
`(encode-uint32 (ldb (byte 32 0) ,val) ,buffer idx))
((:int64)
`(encode-uint64 (ldb (byte 64 0) ,val) ,buffer idx))
(type (unsigned-byte 32) tag))
(let ((idx (let ((e (find val enum-values :key #'proto-value)))
(and e (proto-index e)))))
- (assert idx () "There is no enum value for ~S" val)
+ (unless idx
+ (serialization-error "There is no enum value for ~S" val))
(i+ (length32 tag) (length32 (ldb (byte 32 0) idx)))))
(defun packed-enum-size (values enum-values tag)
(map () #'(lambda (val)
(let ((idx (let ((e (find val enum-values :key #'proto-value)))
(and e (proto-index e)))))
- (assert idx () "There is no enum value for ~S" val)
+ (unless idx
+ (serialization-error "There is no enum value for ~S" val))
(iincf len (length32 (ldb (byte 32 0) idx))))) values)
len)))
(declare (type (unsigned-byte 32) len))
(setq val (,logior val (,ash bits places))))
until (i< byte 128)
finally (progn
- (assert (< val ,(ash 1 bits)) ()
- "The value ~D is longer than ~A bits" val ,bits)
+ (unless (< val ,(ash 1 bits))
+ (serialization-error "The value ~D is longer than ~A bits" val ,bits))
(return (values val index))))))
(defun ,decode-int (buffer index)
,(format nil
((i= (i- tag $wire-type-start-group) (i- new-tag $wire-type-end-group))
(return idx))
(t
- (assert (i= (i- tag $wire-type-start-group) (i- new-tag $wire-type-end-group)) ()
- "Couldn't find a matching end group tag"))))))
+ (unless (i= (i- tag $wire-type-start-group) (i- new-tag $wire-type-end-group))
+ (serialization-error "Couldn't find a matching end group tag")))))))
(t index)))
projects / cl-protobufs.git / commitdiff