(pathname-directory-pathname
(merge-pathnames* path parent-path)))
+(defun protobuf-mangle-name (input-file)
+ (let ((directory (pathname-directory input-file)))
+ (format nil "~{~A-~}~A-~A"
+ (if (eq (first directory) :absolute)
+ (rest directory)
+ directory)
+ (pathname-name input-file)
+ (pathname-type input-file))))
+
+(defun protobuf-lispize-pathname (input-file)
+ (make-pathname
+ :name (protobuf-mangle-name input-file)
+ :type "lisp"
+ :defaults input-file))
+
(defmethod input-files ((op proto-to-lisp) (component protobuf-file))
"The input file is just the .proto file."
(declare (ignorable op))
stored where .fasl files are stored"
(declare (ignorable op))
(let* ((base-pathname (component-pathname component))
- (lisp-file (make-pathname
- :name (format nil "~A.proto" (pathname-name base-pathname))
- :type "lisp"
- :defaults base-pathname)))
+ (lisp-file (protobuf-lispize-pathname base-pathname)))
(values (list lisp-file
(make-pathname :type "proto-imports"
:defaults lisp-file))
(block import-one
(let* ((import (pathname import))
(import-name (pathname-name import))
- (imported (find-schema (class-name->proto import-name))))
- ;; If this schema has already been imported somewhere else,
- ;; mark it as imported here and carry on
+ (proto-file (do-process-import import import-name))
+ (imported (find-schema proto-file)))
(when imported
- (appendf (proto-imported-schemas schema) (list imported))
- (return-from import-one))
- (do-process-import import import-name)
- (let* ((imported (find-schema (class-name->proto import-name))))
- (when imported
- (appendf (proto-imported-schemas schema) (list imported)))
- (return-from import-one))))))
+ (appendf (proto-imported-schemas schema) (list imported)))
+ (return-from import-one)))))
(defun process-imports-from-file (imports-file)
(when (probe-file imports-file)
(dolist (import imports)
(let* ((import (pathname import))
(import-name (pathname-name import)))
- ;; If this schema has already been loaded, we're done.
- (unless (find-schema (class-name->proto import-name))
- (do-process-import import import-name)))))))
+ (do-process-import import import-name))))))
(defun do-process-import (import import-name
&key (search-path *protobuf-search-path*)
(let* ((base-path (asdf::merge-pathnames* import path))
(proto-file (make-pathname :name import-name :type "proto"
:defaults base-path))
- (lisp-file (asdf::lispize-pathname
- (if output-path
- (make-pathname :name import-name
- :directory (pathname-directory output-path))
- base-path)))
+ (lisp-file (if output-path
+ (asdf::lispize-pathname
+ (make-pathname :name (asdf::protobuf-mangle-name base-path)
+ :directory (pathname-directory output-path)))
+ (asdf::protobuf-lispize-pathname base-path)))
(imports-file (make-pathname :type "proto-imports"
:defaults lisp-file))
(fasl-file (compile-file-pathname lisp-file))
(fasl-date (asdf::safe-file-write-date fasl-file))
(imports-date (asdf::safe-file-write-date imports-file)))
(when (probe-file proto-file)
+ (when (find-schema proto-file)
+ (return proto-file))
(let ((*protobuf-pathname* proto-file))
(when (string= (pathname-type base-path) "proto")
;; The user asked to import a .proto file
(let ((*compile-file-pathname* nil)
(*load-pathname* fasl-file))
(load fasl-file)))))
- (return (values))))))
+ (return proto-file)))))
"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)
"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*
"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*
(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.
(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"))
(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)))
(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 MessageWithCrossPackageReference {
- required MessageInOtherPackage baz = 1;
- required EnumInOtherPackage bonk = 2;
+ required protobuf_package_unittest2.MessageInOtherPackage baz = 1;
+ required protobuf_package_unittest2.EnumInOtherPackage bonk = 2;
required MessageDefinedInBothPackages bam = 3;
required protobuf_package_unittest2.MessageDefinedInBothPackages bing = 5;
}
message MessageWithCrossPackageExtension {
- extend MessageInOtherPackage {
+ extend protobuf_package_unittest2.MessageInOtherPackage {
required int32 baa = 1000;
}
- required MessageInOtherPackage boo = 1;
+ required protobuf_package_unittest2.MessageInOtherPackage boo = 1;
}
service ServiceWithCrossPackageInputOutput {
- rpc Bloop(MessageInOtherPackage) returns (MessageWithCrossPackageReference);
- rpc Beep(MessageWithCrossPackageReference) returns (MessageInOtherPackage);
+ rpc Bloop(protobuf_package_unittest2.MessageInOtherPackage) returns (MessageWithCrossPackageReference);
+ rpc Beep(MessageWithCrossPackageReference) returns (protobuf_package_unittest2.MessageInOtherPackage);
}
projects / cl-protobufs.git / commitdiff