(fiasco:define-test-package (#:xlib-test-displays :in xlib-test:xlib-all-tests)
  (:documentation "Tests for the core protocol.")
  (:use #:clx-test-utils))
(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"))))

(deftest screen-protocol ()
  "Gets the default screen of the default display and validates its attributes."
  (with-default-display display
    (let ((screen (xlib:display-default-screen display)))
      (is (member (xlib:screen-backing-stores screen) '(:always :never :when-mapped)))
      (is (typep (xlib:screen-black-pixel screen) 'xlib:pixel))
      (is (typep (xlib:screen-default-colormap screen) 'xlib:colormap))
      (let ((depths (xlib:screen-depths screen)))
        (loop for depth in depths do
             (is (consp depth))
             (is (< 0 (car depth)))
             (is (listp (cdr depth)))
             (loop for visual in (cdr depth) do
                  (is (typep visual 'xlib:visual-info)))))
      (is (typep (xlib:screen-event-mask-at-open screen) 'xlib:mask32))
      (is (typep (xlib:screen-height screen) 'xlib:card16))
      (is (typep (xlib:screen-height-in-millimeters screen) 'xlib:card16))
      (is (typep (xlib:screen-max-installed-maps screen) 'xlib:card16))
      (is (typep (xlib:screen-min-installed-maps screen) 'xlib:card16))

      ;; Test whether we can insert and retrieve a property.
      (is (xlib:screen-p screen))
      (is (typep (xlib:screen-plist screen) 'list))
      (finishes (setf (getf (xlib:screen-plist screen) 'foo) "hell is empty"))
      (is (string= "hell is empty" (getf (xlib:screen-plist screen) 'foo)))

      (is (typep (xlib:screen-root screen) '(or null xlib:window)))
      (is (typep (xlib:screen-root-depth screen) 'xlib:image-depth))
      (is (typep (xlib:screen-root-visual screen) 'xlib:card29))
      (is (typep (xlib:screen-save-unders-p screen) 'boolean))
      (is (typep (xlib:screen-white-pixel screen) 'xlib:pixel))
      (is (typep (xlib:screen-width screen) 'xlib:card16))
      (is (typep (xlib:screen-width-in-millimeters screen) 'xlib:card16)))))

(deftest windows-and-pixmaps ()
  (with-default-display display
    (let* ((screen (xlib:display-default-screen display))
           (root-window (xlib:screen-root screen))
           (child-window nil)
           (child-window2 nil)
           (pixmap nil)
           (pixmap2 nil))
      (test-required-params xlib:create-window :parent root-window :x 0 :y 0 :width 100 :height 100)
      (finishes
        (progn
          (setf child-window (xlib:create-window :parent root-window
                                                 :x 50
                                                 :y 50
                                                 :width 100
                                                 :height 100
                                                 :class :input-output))
          (setf child-window2 (xlib:create-window :parent root-window
                                                  :x 100
                                                  :y 0
                                                  :width 200
                                                  :height 300))))
      (test-required-params xlib:create-pixmap :width 100 :height 100 :depth 24 :drawable root-window)
      (finishes
        (setf pixmap (xlib:create-pixmap :width 100 :height 100 :depth 24 :drawable child-window))
        (setf pixmap2 (xlib:create-pixmap :width 100 :height 100 :depth 24 :drawable child-window)))

      (is (not (xlib:drawable-equal pixmap child-window)))
      (is (not (xlib:drawable-equal pixmap root-window)))
      (is (not (xlib:drawable-equal child-window root-window)))
      (dolist (not-drawable (list display screen t "bleh" 3 3.3))
        (is (not (xlib:drawable-p not-drawable))))
      (dolist (drawable (list root-window child-window pixmap))
        (is (equalp display (xlib:drawable-display drawable)))
        (is (xlib:drawable-equal drawable drawable))
        (is (typep (xlib:drawable-id drawable) 'xlib:resource-id))
        (is (= (xlib:drawable-id drawable) (xlib:drawable-id drawable)))
        (is (xlib:drawable-p drawable))
        (is (typep (xlib:drawable-border-width drawable) 'xlib:card16))
        (is (typep (xlib:drawable-depth drawable) 'xlib:card8))
        (is (typep (xlib:drawable-height drawable) 'xlib:card16))
        (is (typep (xlib:drawable-width drawable) 'xlib:card16))
        (is (typep (xlib:drawable-x drawable) 'xlib:int16))
        (is (typep (xlib:drawable-y drawable) 'xlib:int16))

        ;; Test whether we can insert and retrieve a property.
        (is (typep (xlib:drawable-plist drawable) 'list))
        (finishes (setf (getf (xlib:drawable-plist drawable) 'foo) "hell is empty"))
        (is (string= "hell is empty" (getf (xlib:drawable-plist drawable) 'foo))))
      (is (zerop (xlib:drawable-border-width child-window))) ;default
      (is (zerop (xlib:drawable-border-width pixmap))) ;always 0 for pixmaps
      (dolist (window (list root-window child-window))
        (is (typep (xlib:window-all-event-masks window) 'xlib:mask32))
        (finishes (setf (xlib:window-background window) pixmap))
        (finishes (setf (xlib:window-background window) #xffffff))
        (finishes (setf (xlib:window-background window) :none))
        (finishes (setf (xlib:window-background window) :parent-relative))
        (signals type-error (setf (xlib:window-background window) :bogus))
        (signals type-error (setf (xlib:window-background window) "bogus"))
        (signals type-error (setf (xlib:window-background window) -1))
        (is (typep (xlib:window-backing-pixel window) 'xlib:pixel))
        (is (typep (xlib:window-backing-planes window) 'xlib:pixel))
        (is (typep (xlib:window-bit-gravity window) 'xlib:bit-gravity))
        (is (member (xlib:window-class window) '(:input-output :input-only)))
        (is (typep (xlib:window-colormap window) '(or xlib:colormap null)))
        (is (typep (xlib:window-colormap-installed-p window) 'boolean))
        (is (equalp display (xlib:window-display window)))
        (is (typep (xlib:window-do-not-propagate-mask window) 'xlib:mask32))
        (is (xlib:window-equal window window))
        (is (typep (xlib:window-event-mask window) 'xlib:mask32))
        (is (typep (xlib:window-gravity window) 'xlib:win-gravity))
        (is (typep (xlib:window-id window) 'xlib:resource-id))
        (is (member (xlib:window-map-state window) '(:unmapped :unviewable :viewable)))
        (is (member (xlib:window-override-redirect window) '(:off :on)))
        (is (xlib:window-p window))

        ;; Test whether we can insert and retrieve a property.
        (is (typep (xlib:window-plist window) 'list))
        (finishes (setf (getf (xlib:window-plist window) 'foo) "hell is empty"))
        (is (string= "hell is empty" (getf (xlib:window-plist window) 'foo)))

        (is (member (xlib:window-save-under window) '(:on :off)))
        (is (typep (xlib:window-visual window) 'xlib:card29)))
      (is (not (xlib:window-equal child-window root-window)))
      (is (= (xlib:window-backing-planes child-window) #xffffffff))
      (is (equal (xlib:window-backing-store child-window) :not-useful))
      (is (member (xlib:window-backing-store root-window)
                  '(:always :not-useful :when-mapped)))
      (is (equal (xlib:window-bit-gravity child-window) :forget))
      (is (= (xlib:window-event-mask child-window) 0))
      (is (equal (xlib:window-gravity child-window) :north-west))
      (is (/= (xlib:window-id root-window) (xlib:window-id child-window)))
      (is (equal (xlib:window-override-redirect child-window) :off))
      (dolist (not-window '(list pixmap display screen "bleh" 1 nil t))
        (is (not (xlib:window-p not-window))))
      (finishes (xlib:circulate-window-down child-window))
      (finishes (xlib:circulate-window-up child-window))
      (is (xlib:drawable-equal (xlib:drawable-root child-window) root-window))
      (is (xlib:drawable-equal (xlib:drawable-root child-window2) root-window))
      (is (xlib:drawable-equal (xlib:drawable-root pixmap) root-window))
      (is (not (xlib:drawable-equal (xlib:drawable-root child-window) child-window)))
      (is (not (xlib:drawable-equal (xlib:drawable-root root-window) child-window)))
      (finishes
        (let ((query-tree (xlib:query-tree root-window)))
          (dolist (window (list child-window child-window2))
            (is (member window query-tree :test #'xlib:drawable-equal)))))
      (finishes (xlib:reparent-window child-window2 child-window 50 50))
      (multiple-value-bind (x y)
          (xlib:translate-coordinates child-window2 0 0 root-window)
        (is (= x 100))
        (is (= y 100)))
      (multiple-value-bind (x y)
          (xlib:translate-coordinates child-window2 22 33 root-window)
        (is (= x 122))
        (is (= y 133)))
      (is (xlib:pixmap-equal pixmap pixmap))
      (is (not (xlib:pixmap-equal pixmap pixmap2)))
      (is (equalp (xlib:pixmap-display pixmap) display))
      (is (typep (xlib:pixmap-id pixmap) 'xlib:resource-id))
      (is (xlib:pixmap-p pixmap))
      (loop for not-pixmap in (list display screen root-window child-window) do
           (is (not (xlib:pixmap-p not-pixmap))))

      ;; setf tests
      (is (typep (xlib:pixmap-plist pixmap) 'list))
      (finishes (setf (getf (xlib:pixmap-plist pixmap) 'foo) "hell is empty"))
      (is (string= "hell is empty" (getf (xlib:pixmap-plist pixmap) 'foo)))
      (is (= (xlib:drawable-border-width child-window) 0))
      (finishes (setf (xlib:drawable-border-width child-window) 2))
      (is (xlib:drawable-border-width pixmap) 0)
      (is (= (xlib:drawable-width child-window) 100))
      (is (= (xlib:drawable-height child-window) 100))
      (is (= (xlib:drawable-x child-window) 50))
      (is (= (xlib:drawable-y child-window) 50))
      (finishes (setf (xlib:drawable-width child-window) 120))
      (finishes (setf (xlib:drawable-height child-window) 120))
      (finishes (setf (xlib:drawable-x child-window) 60))
      (finishes (setf (xlib:drawable-y child-window) 70))
      (finishes (setf (xlib:window-backing-pixel child-window) #xAAAAAA))
      (finishes (setf (xlib:window-backing-planes child-window) #xBBBBBB))
      (finishes (setf (xlib:window-backing-store child-window) :when-mapped))
      (finishes (setf (xlib:window-bit-gravity child-window) :south-west))
      (finishes (setf (xlib:window-border child-window) #xCCCCCC))
      ;; TODO: setfing colormaps, cursors
      (finishes (setf (xlib:window-do-not-propagate-mask child-window) 4))
      (finishes (setf (xlib:window-event-mask child-window) 5))
      (finishes (setf (xlib:window-gravity child-window) :south-west))
      (finishes (setf (xlib:window-override-redirect child-window) :on))
      (loop for priority in '(:above :below :bottom-if :opposite :top-if) do
           (finishes (setf (xlib:window-priority child-window) priority)))
      (finishes (setf (xlib:window-save-under child-window) :on))

      (is (= (xlib:drawable-width child-window) 100))
      (sleep 2)
      (is (= (xlib:drawable-width child-window) 120))
      (is (= (xlib:drawable-height child-window) 120))
      (is (= (xlib:drawable-x child-window) 60))
      (is (= (xlib:drawable-y child-window) 70))
      (is (= (xlib:window-backing-pixel child-window) #xAAAAAA))
      (is (= (xlib:window-backing-planes child-window) #xBBBBBB))
      (is (equalp (xlib:window-backing-store child-window) :when-mapped))
      (is (equalp (xlib:window-bit-gravity child-window) :south-west))
      (is (= (xlib:window-do-not-propagate-mask child-window) 4))
      (is (= (xlib:window-event-mask child-window) 5))
      (is (equalp (xlib:window-gravity child-window) :south-west))
      (is (equalp (xlib:window-override-redirect child-window) :on))
      (is (equalp (xlib:window-save-under child-window) :on))

      (xlib:with-state (child-window2)
        (finishes (setf (xlib:drawable-width child-window2) 120))
        (finishes (setf (xlib:drawable-height child-window2) 120))
        (finishes (setf (xlib:drawable-x child-window2) 60))
        (finishes (setf (xlib:drawable-y child-window2) 70))
        (finishes (setf (xlib:window-backing-pixel child-window2) #xAAAAAA))
        (finishes (setf (xlib:window-backing-planes child-window2) #xBBBBBB))
        (finishes (setf (xlib:window-backing-store child-window2) :when-mapped))
        (finishes (setf (xlib:window-bit-gravity child-window2) :south-west))
        (finishes (setf (xlib:window-border child-window2) #xCCCCCC))
        (finishes (setf (xlib:window-do-not-propagate-mask child-window2) 4))
        (finishes (setf (xlib:window-event-mask child-window2) 5))
        (finishes (setf (xlib:window-gravity child-window2) :south-west))
        (finishes (setf (xlib:window-override-redirect child-window2) :on))
        (loop for priority in '(:above :below :bottom-if :opposite :top-if) do
             (finishes (setf (xlib:window-priority child-window2) priority)))
        (finishes (setf (xlib:window-save-under child-window2) :on))
        (is (= (xlib:drawable-width child-window2) 120))
        (is (= (xlib:drawable-height child-window2) 120))
        (is (= (xlib:drawable-x child-window2) 60))
        (is (= (xlib:drawable-y child-window2) 70))
        (is (= (xlib:window-backing-pixel child-window2) #xAAAAAA))
        (is (= (xlib:window-backing-planes child-window2) #xBBBBBB))
        (is (equalp (xlib:window-backing-store child-window2) :when-mapped))
        (is (equalp (xlib:window-bit-gravity child-window2) :south-west))
        (is (= (xlib:window-do-not-propagate-mask child-window2) 4))
        (is (= (xlib:window-event-mask child-window2) 5))
        (is (equalp (xlib:window-gravity child-window2) :south-west))
        (is (equalp (xlib:window-override-redirect child-window2) :on))
        (is (equalp (xlib:window-save-under child-window2) :on)))

      (finishes (xlib:map-window child-window))
      (finishes (xlib:map-subwindows root-window))
      (finishes (xlib:unmap-window child-window))
      (finishes (xlib:unmap-subwindows root-window))
      (finishes (xlib:free-pixmap pixmap))
      (finishes (xlib:destroy-window child-window))
      (setf child-window (xlib:create-window :parent root-window :x 50 :y 50 :width 100 :height 100))
      (setf child-window2 (xlib:create-window :parent child-window :x 100 :y 0 :width 200 :height 300))
      (finishes (xlib:destroy-subwindows root-window)))))

(deftype pixmap-or-null ()
  '(or xlib::pixmap null))

(deftest graphics-contexts ()
  (with-default-display display
    (let* ((screen (xlib:display-default-screen display))
           (root-window (xlib:screen-root screen))
           (gc nil))
      (test-required-params xlib:create-gcontext :drawable root-window)
      (finishes (setf gc (xlib:create-gcontext :drawable root-window)))
      ;;test default attributes and getters
      (is (eql (xlib:gcontext-arc-mode gc) :pie-slice))
      (is (eql (xlib:gcontext-background gc) 1))
      (is (eql (xlib:gcontext-cap-style gc) :butt))
      (is (eql (xlib:gcontext-clip-mask gc) :none))
      (is (eql (xlib:gcontext-clip-x gc) 0))
      (is (eql (xlib:gcontext-clip-y gc) 0))
      (is (eql (xlib:gcontext-dash-offset gc) 0))
      (is (equal (xlib:gcontext-dashes gc) 4))
      (is (eql (xlib:gcontext-exposures gc) :on))
      (is (eql (xlib:gcontext-fill-rule gc) :even-odd))
      (is (eql (xlib:gcontext-fill-style gc) :solid))
      (finishes (xlib:gcontext-font gc))
      (is (eql (xlib:gcontext-foreground gc) 0))
      (is (eql (xlib:gcontext-function gc) xlib::boole-1))
      (is (eql (xlib:gcontext-join-style gc) :miter))
      (is (eql (xlib:gcontext-line-style gc) :solid))
      (is (eql (xlib:gcontext-line-width gc) 0))
      (is (eql (xlib:gcontext-plane-mask gc) #b11111111111111111111111111111111))
      ;; #'xlib:gcontext-tile and #'xlib:gcontext-stipple give pixmaps, whose data
      ;; probably cannot be extracted to check whether it matches the expected
      ;; default data
      (is (typep (xlib:gcontext-stipple gc) 'pixmap-or-null))
      (is (typep (xlib:gcontext-tile gc) 'pixmap-or-null))
      (is (eql (xlib:gcontext-subwindow-mode gc) :clip-by-children))
      (is (eql (xlib:gcontext-ts-x gc) 0))
      (is (eql (xlib:gcontext-ts-y gc) 0))
      (finishes (setf (xlib:gcontext-arc-mode gc) :chord))
      (is (eql (xlib:gcontext-arc-mode gc) :chord))
      (finishes (setf (xlib:gcontext-background gc) 55))
      (is (eql (xlib:gcontext-background gc) 55))
      (is (typep (xlib:gcontext-cache-p gc) 'boolean))
      (finishes (setf (xlib:gcontext-cache-p gc) t))
      (is (eql (xlib:gcontext-cache-p gc) t))
      (finishes (setf (xlib:gcontext-cache-p gc) nil))
      (is (eql (xlib:gcontext-cache-p gc) nil))
      (finishes (setf (xlib:gcontext-cap-style gc) :not-last))
      (is (eql (xlib:gcontext-cap-style gc) :not-last))
      (finishes (setf (xlib:gcontext-cap-style gc) :projecting))
      (is (eql (xlib:gcontext-cap-style gc) :projecting))
      (finishes (setf (xlib:gcontext-cap-style gc) :round))
      (is (eql (xlib:gcontext-cap-style gc) :round))
      (let ((valid-pixmap (xlib:create-pixmap :width 100
                                              :height 100
                                              :depth 1
                                              :drawable root-window)))
        (finishes (setf (xlib:gcontext-clip-mask gc) valid-pixmap))
        (finishes (xlib:gcontext-clip-mask gc))
        (is (eql (xlib:gcontext-clip-mask gc) valid-pixmap))
        )
      (finishes (setf (xlib:gcontext-clip-x gc) 5))
      (is (= (xlib:gcontext-clip-x gc) 5))
      (finishes (setf (xlib:gcontext-clip-y gc) 5))
      (is (= (xlib:gcontext-clip-y gc) 5))
      (finishes (setf (xlib:gcontext-dash-offset gc) 5))
      (is (= (xlib:gcontext-dash-offset gc) 5))
      (finishes (setf (xlib:gcontext-dashes gc) 6))
      (is (or (= (xlib:gcontext-dashes gc) 6)
              (equalp (xlib:gcontext-dashes gc) '(6 6))))
      (finishes (setf (xlib:gcontext-dashes gc) '(6 6)))
      (is (or (equalp (xlib:gcontext-dashes gc) '(6 6))
              (= (xlib:gcontext-dashes gc) 6)))
      (finishes (setf (xlib:gcontext-dashes gc) '(6 5 4)))
      (is (or (equalp (xlib:gcontext-dashes gc) '(6 5))
              (equalp (xlib:gcontext-dashes gc) '(6 5 4))))
      (finishes (setf (xlib:gcontext-dashes gc) '(6 5 4 3)))
      (is (equalp (xlib:gcontext-dashes gc) '(6 5 4 3)))
      (is (equal (xlib:gcontext-display gc) display))
      (is (xlib:gcontext-equal gc gc))
      (is (not (xlib:gcontext-equal gc (xlib:create-gcontext :drawable root-window))))
      (is (member (xlib:gcontext-exposures gc) '(:off :on)))
      (finishes (setf (xlib:gcontext-exposures gc) :on))
      (is (equalp (xlib:gcontext-exposures gc) :on))
      (finishes (setf (xlib:gcontext-exposures gc) :off))
      (is (equalp (xlib:gcontext-exposures gc) :off))
      (is (member (xlib:gcontext-fill-rule gc) '(:even-odd :winding)))
      (finishes (setf (xlib:gcontext-fill-rule gc) :even-odd))
      (is (equalp (xlib:gcontext-fill-rule gc) :even-odd))
      (finishes (setf (xlib:gcontext-fill-rule gc) :winding))
      (is (equalp (xlib:gcontext-fill-rule gc) :winding))
      (is (member (xlib:gcontext-fill-style gc) '(:opaque-stippled
                                                  :solid
                                                  :stippled
                                                  :tiled)))
      (finishes (setf (xlib:gcontext-fill-style gc) :solid))
      (is (equalp (xlib:gcontext-fill-style gc) :solid))
      (finishes (setf (xlib:gcontext-fill-style gc) :stippled))
      (is (equalp (xlib:gcontext-fill-style gc) :stippled))
      (is (typep (xlib:gcontext-font gc t) 'xlib:font))
      (is (typep (xlib:gcontext-font gc nil) '(or xlib:font null)))
      ;;TODO: try to setf a font
      (is (typep (xlib:gcontext-foreground gc) 'xlib:card32))
      (finishes (setf (xlib:gcontext-foreground gc) 132))
      (is (= (xlib:gcontext-foreground gc) 132))
      (is (typep (xlib:gcontext-function gc) 'xlib:boole-constant))
      (finishes (setf (xlib:gcontext-function gc) boole-orc1))
      (is (= (xlib:gcontext-function gc) boole-orc1))
      (finishes (setf (xlib:gcontext-function gc) boole-c1))
      (is (= (xlib:gcontext-function gc) boole-c1))
      (is (typep (xlib:gcontext-id gc) 'xlib:resource-id))
      (is (member (xlib:gcontext-join-style gc) '(:bevel :miter :round)))
      (finishes (setf (xlib:gcontext-join-style gc) :miter))
      (is (equalp (xlib:gcontext-join-style gc) :miter))
      (finishes (setf (xlib:gcontext-join-style gc) :round))
      (is (equalp (xlib:gcontext-join-style gc) :round))
      (is (member (xlib:gcontext-line-style gc) '(:solid
                                                  :double-dash
                                                  :on-off-dash)))
      (finishes (setf (xlib:gcontext-line-style gc) :double-dash))
      (is (equalp (xlib:gcontext-line-style gc) :double-dash))
      (finishes (setf (xlib:gcontext-line-style gc) :on-off-dash))
      (is (equalp (xlib:gcontext-line-style gc) :on-off-dash))
      (is (typep (xlib:gcontext-line-width gc) 'xlib:card16))
      (is (xlib:gcontext-p gc))
      (is (not (xlib:gcontext-p root-window)))
      (is (not (xlib:gcontext-p screen)))
      (is (typep (xlib:gcontext-plane-mask gc) 'xlib:mask32))
      (is (typep (xlib:gcontext-plist gc) 'list))
      (finishes (setf (getf (xlib:gcontext-plist gc) :foo) :bar))
      (is (eql :bar (getf (xlib:gcontext-plist gc) :foo)))
      (finishes (remf (xlib:gcontext-plist gc) :foo))
      (is (eql nil (getf (xlib:gcontext-plist gc) :foo)))
      (is (member (xlib:gcontext-subwindow-mode gc) '(:clip-by-children
                                                      :include-inferiors)))
      (finishes (setf (xlib:gcontext-subwindow-mode gc) :clip-by-children))
      (is (equalp (xlib:gcontext-subwindow-mode gc) :clip-by-children))
      (finishes (setf (xlib:gcontext-subwindow-mode gc) :include-inferiors))
      (is (equalp (xlib:gcontext-subwindow-mode gc) :include-inferiors))
      (is (typep (xlib:query-best-stipple 5 5 root-window) 'xlib:card16))
      (is (typep (xlib:query-best-tile 5 5 root-window) 'xlib:card16)))))

;;; TODO: copying graphics contexts, destroying, and graphics context cache
