From: Alejandro R Sedeño Date: Tue, 5 Mar 2013 22:32:05 +0000 (-0500) Subject: Change how protobuf schemas and classes are recorded and found X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=commitdiff_plain;h=ef6185ea536dfbea02ba97a2ed8b55e1aaa207e1;p=cl-protobufs.git Change how protobuf schemas and classes are recorded and found * 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. --- diff --git a/model-classes.lisp b/model-classes.lisp index e43eb15..1f99edd 100644 --- a/model-classes.lisp +++ b/model-classes.lisp @@ -21,14 +21,12 @@ "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." - (values (gethash (make-pathname :type nil :defaults path) *all-schemas*))) + (values (gethash path *all-schemas*))) (defvar *all-messages* (make-hash-table :test #'equal) @@ -170,29 +168,26 @@ "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 + (with-slots (class) s (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) s) initializer)))) -(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.") - (:method ((schema protobuf-schema) &optional symbol name type) + (:method ((schema protobuf-schema) &optional symbol type) (declare (ignore type)) - (let ((symbol (or symbol (proto-class schema))) - (name (or name (proto-name schema)))) + (let ((symbol (or symbol (proto-class schema)))) (when symbol - (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 - ;; 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* @@ -491,26 +486,23 @@ "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)) - (record-protobuf m ',class ',name ',message-type) + (record-protobuf m ',class ',message-type) m)) initializer)))) -(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))) - (name (or name (proto-name message))) (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* diff --git a/tests/case-preservation-test.lisp b/tests/case-preservation-test.lisp index 51ecaf5..bdd74a6 100644 --- a/tests/case-preservation-test.lisp +++ b/tests/case-preservation-test.lisp @@ -11,7 +11,8 @@ (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. diff --git a/tests/lisp-extend-test.lisp b/tests/lisp-extend-test.lisp index 6ebda96..0e5cd3b 100644 --- a/tests/lisp-extend-test.lisp +++ b/tests/lisp-extend-test.lisp @@ -11,8 +11,8 @@ (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")) diff --git a/tests/lisp-reference-tests.lisp b/tests/lisp-reference-tests.lisp index f3b9cab..e288c7b 100644 --- a/tests/lisp-reference-tests.lisp +++ b/tests/lisp-reference-tests.lisp @@ -13,7 +13,7 @@ (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))) @@ -93,7 +93,7 @@ (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)))