aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJavier Olaechea <pirata@gmail.com>2020-04-06 01:46:36 -0500
committerJavier Olaechea <pirata@gmail.com>2020-04-06 01:46:36 -0500
commit81ace6066fbe9ddd14eb8e76b45479863c4d31da (patch)
tree7a25f7eea0d4ebb6f8aacf5bfae5971840104c7b
parentf366e8f7ac46f7aa764f9eb82413dfabf040038a (diff)
downloadcl-xcb-81ace6066fbe9ddd14eb8e76b45479863c4d31da.tar.gz
Account for first field being potentially in the header
We can't implement the opcode rule right now because requests have not slot for opcodes for the time being.
-rw-r--r--src/xcb/mop.lisp15
-rw-r--r--tests/lang/mop.lisp5
2 files changed, 13 insertions, 7 deletions
diff --git a/src/xcb/mop.lisp b/src/xcb/mop.lisp
index a902db0..8daa717 100644
--- a/src/xcb/mop.lisp
+++ b/src/xcb/mop.lisp
@@ -239,7 +239,14 @@
;; possible, that is the size of the first field is 8 bits. We also
;; need to 'pad align' any variable length fields.
(defun compute-request-length (xcb-request)
- (ceiling
- (loop :for slot :in (sb-mop:class-slots (class-of xcb-request))
- :sum (xcb-slot-size slot xcb-request))
- 4))
+ (let* ((slots (sb-mop:class-slots (class-of xcb-request)))
+ ;; TODO: We should return false if the opcode of the
+ ;; request is higher than 128
+ (first-field-in-header-p (= 1 (xcb-slot-size (first slots) xcb-request))))
+ (when first-field-in-header-p
+ (setf slots (rest slots)))
+ (ceiling
+ (+ 4
+ (loop :for slot :in slots
+ :sum (xcb-slot-size slot xcb-request)))
+ 4)))
diff --git a/tests/lang/mop.lisp b/tests/lang/mop.lisp
index a4784ce..d4af377 100644
--- a/tests/lang/mop.lisp
+++ b/tests/lang/mop.lisp
@@ -47,7 +47,7 @@
:protocol-major-version 11)))
(is (not (slot-boundp req 'pad~1)))
(is (= (xcb/lang::compute-request-length req)
- 7))))
+ 3))))
;; 3. padding slots error when provided incompatible options.
;; Behaviour tests
@@ -69,9 +69,8 @@
(let ((req (make-instance 'not-setup-request-3
:byte-order (char-code #\l)
:protocol-major-version 11)))
- ;; FIXME: Take into account header.
(is (= (xcb/lang::compute-request-length req)
- 3))))
+ 2))))
(defclass not-intern-atom-1 ()
((only-if-exists :initarg :only-if-exists