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 e43eb15aa890c09f6f205fecd2e119b242f68b2e..1f99edd970bbb82cd8b5fd0bc00c45500d94e903 100644 (file)
--- 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 51ecaf5ea7b1fb8fc7f79d2194bed8f5b480760d..bdd74a65f27f5e2ab2ae48f582bde6ff70916a1d 100644 (file)
--- 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 6ebda96e50216af81e20907b0a87db32b81a403a..0e5cd3b45723ffdfccdbaf53102e4bf78a45ce63 100644 (file)
--- 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 f3b9cab0edf0ab05fa3ff01004846c16b77d51f1..e288c7bc0bd42a020366051e624a74719bbe53f9 100644 (file)
--- 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)))