From 96f99d1b539ac96eebc41ff9e1dc279a592356e1 Mon Sep 17 00:00:00 2001 From: Tomek Kurcz Date: Tue, 19 Dec 2017 12:41:30 +0100 Subject: [PATCH 1/2] tests: Add core protocol tests (manual, Screens section) Also change the doc string to something more generic. We don't want to reference chapter numbers that might change in the future. --- tests/core-protocol.lisp | 42 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 41 insertions(+), 1 deletion(-) diff --git a/tests/core-protocol.lisp b/tests/core-protocol.lisp index 63f6d44..919c7f8 100644 --- a/tests/core-protocol.lisp +++ b/tests/core-protocol.lisp @@ -1,5 +1,5 @@ (fiasco:define-test-package (#:xlib-test-displays :in xlib-test:xlib-all-tests) - (:documentation "Tests for `3. Displays' section of the manual.")) + (:documentation "Tests the core protocol.")) (in-package #:xlib-test-displays) ;;; Manual notes: @@ -66,3 +66,43 @@ (is (null (xlib:close-display display))) ;; We can't query closed display. (signals xlib:closed-display (xlib:query-extension display "FOO")))) + +(defmacro with-default-display (display &body body) + `(let ((,display (xlib:open-default-display))) + (unwind-protect + (progn ,@body) + (xlib:close-display ,display)))) + +(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))))) From 249b8c36f3291cdda41b9e1c3b71c1dac29f2eee Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski Date: Tue, 19 Dec 2017 14:10:38 +0100 Subject: [PATCH 2/2] Update core-protocol.lisp --- tests/core-protocol.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/core-protocol.lisp b/tests/core-protocol.lisp index 919c7f8..2b03a6a 100644 --- a/tests/core-protocol.lisp +++ b/tests/core-protocol.lisp @@ -1,5 +1,5 @@ (fiasco:define-test-package (#:xlib-test-displays :in xlib-test:xlib-all-tests) - (:documentation "Tests the core protocol.")) + (:documentation "Tests for the core protocol.")) (in-package #:xlib-test-displays) ;;; Manual notes: