* FIND-SCHEMA no longer works on a string or keyword. Both of these
were based on the PATHNAME-NAME of the protobuf, which has a high
probability of collision. (e.g., common.proto -> "COMMON", :COMMON)
Instead, look up schemas based on package and name. For instance,
the protobuf foo.proto, declaring "package FooPackage;", can be
found with: (FIND-SCHEMA 'FOO-PACKAGE::FOO)
* Pathname-based schema lookup no longer ignores file type.
"Given a name (a symbol or string), return the 'protobuf-schema' object having that name."))
(defmethod find-schema ((name symbol))
"Given a name (a symbol or string), return the 'protobuf-schema' object having that name."))
(defmethod find-schema ((name symbol))
- (values (gethash (keywordify name) *all-schemas*)))
-
-(defmethod find-schema ((name string))
- (values (gethash (string-upcase name) *all-schemas*)))
+ (assert (not (keywordp name)))
+ (values (gethash name *all-schemas*)))
(defmethod find-schema ((path pathname))
"Given a pathname, return the 'protobuf-schema' object that came from that path."
(defmethod find-schema ((path pathname))
"Given a pathname, return the 'protobuf-schema' object that came from that path."
- (values (gethash (make-pathname :type nil :defaults path) *all-schemas*)))
+ (values (gethash path *all-schemas*)))
(defvar *all-messages* (make-hash-table :test #'equal)
(defvar *all-messages* (make-hash-table :test #'equal)
"The model class that represents a Protobufs schema, i.e., one .proto file."))
(defmethod make-load-form ((s protobuf-schema) &optional environment)
"The model class that represents a Protobufs schema, i.e., one .proto file."))
(defmethod make-load-form ((s protobuf-schema) &optional environment)
- (with-slots (class name) s
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots s :environment environment)
(values `(let ((s ,constructor))
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots s :environment environment)
(values `(let ((s ,constructor))
- (record-protobuf s ',class ',name nil)
+ (record-protobuf s ',class nil)
-(defgeneric record-protobuf (schema &optional symbol name type)
+(defgeneric record-protobuf (schema &optional symbol type)
(:documentation
"Record all the names by which the Protobufs schema might be known.")
(:documentation
"Record all the names by which the Protobufs schema might be known.")
- (:method ((schema protobuf-schema) &optional symbol name type)
+ (:method ((schema protobuf-schema) &optional symbol type)
- (let ((symbol (or symbol (proto-class schema)))
- (name (or name (proto-name schema))))
+ (let ((symbol (or symbol (proto-class schema))))
- (setf (gethash (keywordify symbol) *all-schemas*) schema))
- (when name
- (setf (gethash (string-upcase name) *all-schemas*) schema))
+ (setf (gethash symbol *all-schemas*) schema))
(let ((path (or *protobuf-pathname* *compile-file-pathname*)))
(when path
(let ((path (or *protobuf-pathname* *compile-file-pathname*)))
(when path
- ;; Record the file from which the Protobufs schema came, sans file type
- (setf (gethash (make-pathname :type nil :defaults path) *all-schemas*) schema))))))
+ ;; Record the file from which the Protobufs schema came
+ (setf (gethash path *all-schemas*) schema))))))
(defmethod print-object ((s protobuf-schema) stream)
(if *print-escape*
(defmethod print-object ((s protobuf-schema) stream)
(if *print-escape*
"The model class that represents a Protobufs message."))
(defmethod make-load-form ((m protobuf-message) &optional environment)
"The model class that represents a Protobufs message."))
(defmethod make-load-form ((m protobuf-message) &optional environment)
- (with-slots (class name message-type) m
+ (with-slots (class message-type) m
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots m :environment environment)
(values (if (eq message-type :extends)
constructor
`(let ((m ,constructor))
(multiple-value-bind (constructor initializer)
(make-load-form-saving-slots m :environment environment)
(values (if (eq message-type :extends)
constructor
`(let ((m ,constructor))
- (record-protobuf m ',class ',name ',message-type)
+ (record-protobuf m ',class ',message-type)
-(defmethod record-protobuf ((message protobuf-message) &optional class name type)
+(defmethod record-protobuf ((message protobuf-message) &optional class type)
;; No need to record an extension, it's already been recorded
(let ((class (or class (proto-class message)))
;; No need to record an extension, it's already been recorded
(let ((class (or class (proto-class message)))
- (name (or name (proto-name message)))
(type (or type (proto-message-type message))))
(unless (eq type :extends)
(when class
(type (or type (proto-message-type message))))
(unless (eq type :extends)
(when class
- (setf (gethash class *all-messages*) message))
- (when name
- (setf (gethash name *all-messages*) message)))))
+ (setf (gethash class *all-messages*) message)))))
(defmethod print-object ((m protobuf-message) stream)
(if *print-escape*
(defmethod print-object ((m protobuf-message) stream)
(if *print-escape*
(in-package "PROTO-TEST")
(define-test case-preservation-test ()
(in-package "PROTO-TEST")
(define-test case-preservation-test ()
- (let ((service (proto:find-service :case-preservation "QUUXService")))
+ (let ((service (proto:find-service 'protobuf-case-preservation-unittest::case-preservation
+ "QUUXService")))
(assert-true service)
;; We're reaching into the implementation to verify the objects have
;; been properly constructed.
(assert-true service)
;; We're reaching into the implementation to verify the objects have
;; been properly constructed.
(in-package "PROTO-TEST")
(define-test extend-test ()
(in-package "PROTO-TEST")
(define-test extend-test ()
- (let* ((schema (proto:find-schema "ExtendTest"))
- (imported-schema (proto:find-schema "ExtendTestBase"))
+ (let* ((schema (proto:find-schema 'protobuf-extend-unittest::extend-test))
+ (imported-schema (proto:find-schema 'protobuf-extend-base-unittest::extend-test-base))
(foo (proto:find-message schema "Foo"))
(bar (proto:find-message schema "Bar"))
(quux (proto:find-message schema "Quux"))
(foo (proto:find-message schema "Foo"))
(bar (proto:find-message schema "Bar"))
(quux (proto:find-message schema "Quux"))
(define-test cross-package-reference-test ()
(flet ((find-by-name (name proto-objects)
(find name proto-objects :key #'proto-name :test #'string=)))
(define-test cross-package-reference-test ()
(flet ((find-by-name (name proto-objects)
(find name proto-objects :key #'proto-name :test #'string=)))
- (let* ((schema (find-schema :package_test1))
+ (let* ((schema (find-schema 'protobuf-package-unittest1::package_test1))
(message-with-cross-package-reference
(find-by-name "MessageWithCrossPackageReference" (proto-messages schema)))
(baz (find-by-name "baz" (proto-fields message-with-cross-package-reference)))
(message-with-cross-package-reference
(find-by-name "MessageWithCrossPackageReference" (proto-messages schema)))
(baz (find-by-name "baz" (proto-fields message-with-cross-package-reference)))
(define-test forward-reference-test ()
(flet ((find-by-name (name proto-objects)
(find name proto-objects :key #'proto-name :test #'string=)))
(define-test forward-reference-test ()
(flet ((find-by-name (name proto-objects)
(find name proto-objects :key #'proto-name :test #'string=)))
- (let* ((schema (find-schema :forward_reference))
+ (let* ((schema (find-schema 'protobuf-forward-reference-unittest::forward_reference))
(message-with-forward-reference
(find-by-name "MessageWithForwardReference" (proto-messages schema)))
(foo (find-by-name "foo" (proto-fields message-with-forward-reference)))
(message-with-forward-reference
(find-by-name "MessageWithForwardReference" (proto-messages schema)))
(foo (find-by-name "foo" (proto-fields message-with-forward-reference)))