Merge pull request #87 from sharplispers/develop

Improve tests and enable extensions

.gitignore

@@ -1,3 +1,12 @@
 /manual/clx.info
 /manual/clx.info-1
 /manual/clx.info-2
+*.lx64fsl
+/manual/clx.tps
+/manual/clx.tp
+/manual/clx.toc
+/manual/clx.pdf
+/manual/clx.log
+/manual/clx.fns
+/manual/clx.fn
+/manual/clx.aux

clx.asd

@@ -80,7 +80,11 @@ Independent FOSS developers"
                (:file "xtest")
                (:file "screensaver")
                (:file "randr")
-               (:file "xinerama")))
+               (:file "xinerama")
+               (:file "dbe")
+               (:file "xc-misc")
+               (:file "dri2")
+               (:file "composite")))
      (:static-file "NEWS")
      (:static-file "CHANGES")
      (:static-file "README.md")
@@ -135,10 +139,7 @@ Independent FOSS developers"
   ((:module "tests"
 	    :components
 	    ((:file "package")
-	     (:file "test"
-		    :depends-on ("package"))
-	     (:file "example"
-		    :depends-on ("test"))))))
+             (:file "core-protocol" :depends-on ("package"))))))
 
 #+sbcl
 (defmethod perform :around ((o compile-op) (f xrender-source-file))

dep-openmcl.lisp

@@ -29,6 +29,17 @@
 ;;; Number of seconds to wait for a reply to a server request
 (defparameter *reply-timeout* nil) 
 
+#-(or clx-overlapping-arrays (not clx-little-endian))
+(progn
+  (defconstant +word-0+ 0)
+  (defconstant +word-1+ 1)
+
+  (defconstant +long-0+ 0)
+  (defconstant +long-1+ 1)
+  (defconstant +long-2+ 2)
+  (defconstant +long-3+ 3))
+
+#-(or clx-overlapping-arrays clx-little-endian)
 (progn
   (defconstant +word-0+ 1)
   (defconstant +word-1+ 0)

depdefs.lisp

@@ -146,6 +146,10 @@
     (:big-endian)
     (:little-endian (pushnew :clx-little-endian *features*))))
 
+#+openmcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  #+little-endian-target (pushnew :clx-little-endian *features*))
+
 ;;; Steele's Common-Lisp states:  "It is an error if the array specified
 ;;; as the :displaced-to argument  does not have the same :element-type
 ;;; as the array being created" If this is the case on your lisp, then

extensions/composite.lisp

@@ -133,9 +133,9 @@
     (declare (type display display)
 	     (type window window))
     (with-buffer-request (display (composite-opcode display))
-      ((data +composite-namewindowpixmap+)
-       (window window)
-       (drawable drawable)))))
+      (data +composite-namewindowpixmap+)
+      (window window)
+      (drawable drawable))))
 
 (defun composite-get-overlay-window (window)
   ""
@@ -151,9 +151,9 @@
 
 (defun composite-release-overlay-window (window)
   ""
-  (let ((display (window-display window))))
-  (declare (type display display)
-	   (type window window))
-  (with-buffer-request (display (composite-opcode display))
-				 ((data +composite-releaseoverlaywindow+)
-				  (window window))))
+  (let ((display (window-display window)))
+    (declare (type display display)
+             (type window window))
+    (with-buffer-request (display (composite-opcode display))
+      (data +composite-releaseoverlaywindow+)
+      (window window))))

extensions/dri2.lisp

@@ -186,10 +186,11 @@
 				   ((data +dri2-wait-msc+))
       (values))))
 
-(defun dri2-swap-interval ()
+(defun dri2-swap-interval (drawable)
   ""
-  (with-buffer-request (display (dri2-opcode display))
-    (data +dri2-swap-interval+)))
+  (let ((display (drawable-display drawable)))
+    (with-buffer-request (display (dri2-opcode display))
+      (data +dri2-swap-interval+))))
 
 (defun dri2-get-param (drawable)
 ""

extensions/glx.lisp

@@ -71,9 +71,9 @@
 
 (in-package #:xlib/glx)
 
-
-(declaim (optimize (debug 3) (safety 3)))
-
+;;; Generally don't want this declamation to have load-time effects
+(eval-when (:compile-toplevel)
+  (declaim (optimize (debug 3) (safety 3))))
 
 (define-extension "GLX"
     :events (:glx-pbuffer-clobber)

extensions/randr.lisp

@@ -696,16 +696,17 @@
 	 value-length
 	 (when (not (eql value-length 0)) 
 	   (case byte-format 
-	     ('card8 ( sequence-get :format card8 :index +replysize+ :length value-length :result-type result-type))
-	     ('card16 ( sequence-get :format card16 :index +replysize+ :length value-length :result-type result-type))
-	     ('card32 ( sequence-get :format card32 :index +replysize+ :length value-length :result-type result-type))))
-	 )
-	))))
+	     (card8 (sequence-get :format card8 :index +replysize+
+                                  :length value-length :result-type result-type))
+	     (card16 (sequence-get :format card16 :index +replysize+
+                                   :length value-length :result-type result-type))
+	     (card32 (sequence-get :format card32 :index +replysize+
+                                   :length value-length :result-type result-type)))))))))
 
 
 
 (defun rr-create-mode (window mode-info name)
-"FIXME"
+  "FIXME"
   (let ((display (window-display window)))
     (declare (type display display)
 	     (type window window)

manual/clx.texinfo

@@ -2355,15 +2355,15 @@ paragraphs.
 A @var{display} object.
 @end table
 
-Returns the authorization data string for @var{display} that was
+Returns the authorization data vector for @var{display} that was
 transmitted to the server by @var{open-display} during connection
 setup. The data is specific to the particular authorization protocol
 that was used. The @var{display-authorization-name} function returns
 the protocol used.
 
 @table @var
 @item authorization-data
-Type @var{string}.
+Type @var{vector}.
 @end table
 
 @end defun
@@ -2473,15 +2473,16 @@ and error handling, refer to the section entitled Common Lisp
 Condition System in the @emph{Lisp Reference} manual.
 
 If the value of @var{error-handler} is a sequence, it is expected to
-contain a handler function for each specific error. The error code is
-used as an index into the sequence to fetch the appropriate handler
-function. If this element is a function, it is called for all
-errors. Any results returned by the handler are ignored since it is
-assumed the handler either takes care of the error completely or else
-signals. The arguments passed to the handler function are the
-@var{display} object, a symbol naming the type of error, and a set of
-keyword-value argument pairs that vary depending on the type of
-error. For all core errors, the keyword-value argument pairs are:
+contain a handler function designator for each specific error. The
+error code is used as an index into the sequence to fetch the
+appropriate handler function. If this element is a function
+designator, it is called for all errors. Any results returned by the
+handler are ignored since it is assumed the handler either takes care
+of the error completely or else signals. The arguments passed to the
+handler function are the @var{display} object, a symbol naming the
+type of error, and a set of keyword-value argument pairs that vary
+depending on the type of error. For all core errors, the keyword-value
+argument pairs are:
 
 @multitable @columnfractions 0.5 0.5
 @item @var{:current-sequence} @tab @var{card16}
@@ -2514,7 +2515,7 @@ pairs plus:
 
 @table @var
 @item error-handler
-Type @var{function} or @var{sequence}.
+Type @var{function} or @var{symbol} or @var{sequence}.
 @end table
 
 @end defun
@@ -2874,7 +2875,7 @@ Type @var{string}.
 @end defun
 
 
-@defun display-version-number display
+@defun display-release-number display
 
 @table @var
 @item display
@@ -2884,7 +2885,7 @@ A @var{display} object.
 Returns the X protocol version number for this implementation of CLX.
 @table @var
 @item version-number
-Type @var{card16}.
+Type @var{card32}.
 @end table
 
 @end defun
@@ -2896,11 +2897,11 @@ Type @var{card16}.
 A @var{display} object.
 @end table
 
-Returns the function that is used to allocate server resource IDs for
-this @emph{display}.
+Returns the function designator that is used to allocate server
+resource IDs for this @emph{display}.
 @table @var
 @item resource-allocator
-Type @var{function}.
+Type @var{function} or @var{symbol}.
 @end table
 
 @end defun
@@ -17528,9 +17529,6 @@ Explicitly invokes the @emph{after-function} of the display.
 internally called after every request.
 @end defun
 
-@defun display-release-number object
-@end defun
-
 @defun event-handler handlers event-key
 @end defun
 

tests/core-protocol.lisp

@@ -0,0 +1,68 @@
+(fiasco:define-test-package (#:xlib-test-displays :in xlib-test:xlib-all-tests)
+  (:documentation "Tests for `3. Displays' section of the manual."))
+(in-package #:xlib-test-displays)
+
+;;; Manual notes:
+;;;
+;;; - xlib:display-error-handler documentation has broken reference "See
+;;;   <undefined> [Errors], page <undefined>";
+
+;;; This test will fail the day "FOO" extension is written.
+(deftest display-protocol ()
+  "Opens display, checks its attributes and closes it."
+  (let ((display (xlib:open-default-display)))
+    (is (null (xlib:query-extension display "FOO")))
+    (is (typep (xlib:display-authorization-data display) 'vector))
+    (is (typep (xlib:display-authorization-name display) 'string))
+    (is (typep (xlib:display-bitmap-format display) 'xlib:bitmap-format))
+    (is (typep (xlib:display-byte-order display) '(member :lsbfirst :msbfirst)))
+    (is (typep (xlib:display-display display) 'integer))
+    (is (typep (xlib:display-error-handler display) '(or function symbol)))
+    (is (typep (xlib:display-image-lsb-first-p display) 'boolean))
+    (multiple-value-bind (min-keycode max-keycode) (xlib:display-keycode-range display)
+      (is (typep min-keycode 'xlib:card8))
+      (is (typep max-keycode 'xlib:card8))
+      (is (= min-keycode (xlib:display-min-keycode display)))
+      (is (= max-keycode (xlib:display-max-keycode display))))
+    (let ((max-request-size (xlib:display-max-request-length display)))
+      (is (>= max-request-size 4096))
+      (is (typep max-request-size 'xlib:card16)))
+    (is (typep (xlib:display-motion-buffer-size display) 'xlib:card32))
+    (is (typep (xlib:display-nscreens display) 'integer))
+    (is (xlib:display-p display))
+    (is (not (xlib:display-p :not-a-display)))
+    (is (every #'xlib:pixmap-format-p (xlib:display-pixmap-formats display)))
+    ;; display-plist
+    (finishes (setf (getf (xlib:display-plist display) :foo) :bar))
+    (is (eql :bar (getf (xlib:display-plist display) :foo)))
+    (finishes (remf (xlib:display-plist display) :foo))
+    (is (eql nil (getf (xlib:display-plist display) :foo)))
+    (multiple-value-bind (major minor) (xlib:display-protocol-version display)
+      (is (typep minor 'xlib:card16))
+      (is (typep major 'xlib:card16))
+      (is (= minor (xlib:display-protocol-minor-version display)))
+      (is (= major (xlib:display-protocol-major-version display))))
+    (is (typep (xlib:display-resource-id-base display) 'xlib:resource-id))
+    (is (typep (xlib:display-resource-id-mask display) 'xlib:resource-id))
+    (is (every #'xlib:screen-p (xlib:display-roots display)))
+    (multiple-value-bind (name release) (xlib:display-vendor display)
+      (is (typep name 'string))
+      (is (typep release 'xlib:card32))
+      (is (string= name (xlib:display-vendor-name display)))
+      (is (= release (xlib:display-release-number display))))
+    (is (typep (xlib:display-xid display) '(or function symbol)))
+    ;; dummy test
+    (let ((count 0))
+      (finishes (setf (xlib:display-after-function display)
+                      (lambda (display)
+                        (declare (ignore display))
+                        (incf count)))
+                (xlib:with-display (display)
+                  (xlib:query-extension display "FOO")
+                  (xlib:display-finish-output display)
+                  (xlib:query-extension display "FOO")
+                  (xlib:display-force-output display)))
+      (is (<= 2 count)))
+    (is (null (xlib:close-display display)))
+    ;; We can't query closed display.
+    (signals xlib:closed-display (xlib:query-extension display "FOO"))))

tests/package.lisp

@@ -1,5 +1,6 @@
-(defpackage :xlib-test
-  (:use :common-lisp)
-  (:export :run-all-tests
-	   :define-test-suite
-	   :xlib-all-tests))
+(defpackage #:xlib-test
+  (:use :cl)
+  (:export #:run-all-tests #:xlib-test #:xlib-all-tests))
+(in-package #:xlib-test)
+
+(fiasco:defsuite (xlib-all-tests :bind-to-package #:xlib-test))