From f4ce57fcff77c9b02fde8ebde1084988b9b7fee2 Mon Sep 17 00:00:00 2001 From: Daniel Kochmanski <daniel@turtleware.eu> Date: Sat, 10 Jun 2017 20:22:48 +0200 Subject: [PATCH] tests: shave-yak non-compiling parts --- test/chess.lisp | 4 +++- test/test-driver.lisp | 6 +++--- test/test-suite.lisp | 8 ++++---- test/test.lisp | 38 ++++++++++++++++++-------------------- 4 files changed, 28 insertions(+), 28 deletions(-) diff --git a/test/chess.lisp b/test/chess.lisp index 06a7f50f..299099fd 100644 --- a/test/chess.lisp +++ b/test/chess.lisp @@ -143,8 +143,10 @@ (draw-rectangle* stream 0 0 80 80 :ink (if square +black+ +white+))) - (defmethod draw-piece (frame stream which color square) + (draw-rectangle* stream 0 0 80 80 + :ink (if square +black+ +white+)) + #+ (or) (let* ((key (list which color square)) (ink (second (assoc key (slot-value frame 'bitmaps) :test #'equal)))) (unless ink diff --git a/test/test-driver.lisp b/test/test-driver.lisp index d3860402..76f93840 100644 --- a/test/test-driver.lisp +++ b/test/test-driver.lisp @@ -96,7 +96,7 @@ (defun wait-for-clim-input-state (invocation &optional (timeout *default-input-state-timeout*)) (let ((process (invocation-process invocation))) (let ((port (port (invocation-frame invocation)))) - (when port #-acl86win32 (xm-silica::port-finish-output port))) + (when port #+ (or) (xm-silica::port-finish-output port))) (mp:process-allow-schedule) (flet ((input-state-p (process) (or (not (mp:process-thread process)) @@ -961,7 +961,7 @@ (funcall continuation))) (define-test-step press-push-button (button) - #-acl86win32 (xm-silica::queue-active-event nil nil button)) + #+ (or) (xm-silica::queue-active-event nil nil button)) (defmacro with-waiting ((&key timeout) &body clauses) (let ((i 0) @@ -997,7 +997,7 @@ (locally (declare (special si::*clos-preload-packages*)) (setq si::*clos-preload-packages* (mapcar #'find-package - '(:clim :clim-utils :clim-internals :silica :tk #-acl86win32 :xm-silica)))) + '(:clim :clim-utils :clim-internals :silica :tk)))) ;; This stops warnings happening asynchronously and causing confusion. diff --git a/test/test-suite.lisp b/test/test-suite.lisp index 526b3a70..7d766be3 100644 --- a/test/test-suite.lisp +++ b/test/test-suite.lisp @@ -3438,8 +3438,8 @@ Luke Luck licks the lakes Luke's duck likes.")) (define-benchmark (simple-menu-choose :iterations 10) (stream) "Pop up a simple menu of colors" (without-clim-input - (if #-(or aclpc acl86win32) (typep (port stream) 'xm-silica::xt-port) - #+(or aclpc acl86win32) nil + (if #+(or) (typep (port stream) 'xm-silica::xt-port) + #-(or) nil (sleep 0.1) ;; Avoid division by zero! (menu-choose '(("Red" :value +red+) ("Green" :value +green+) @@ -3456,8 +3456,8 @@ Luke Luck licks the lakes Luke's duck likes.")) (define-benchmark (cached-menu-choose :iterations 10) (stream) "Pop up a cached menu of colors" (without-clim-input - (if #-(or aclpc acl86win32) (typep (port stream) 'xm-silica::xt-port) - #+(or aclpc acl86win32) nil + (if #+(or) (typep (port stream) 'xm-silica::xt-port) + #-(or) nil (sleep 0.1) ;; Avoid division by zero! (menu-choose '(("Red" :value +red+) ("Green" :value +green+) diff --git a/test/test.lisp b/test/test.lisp index 4d13c8e4..289cdfed 100644 --- a/test/test.lisp +++ b/test/test.lisp @@ -334,24 +334,22 @@ (defun text-field-changed (tf value) (format t "~&Text field ~A changed to ~S" tf value)) -(defclass insect () ()) - -(define-test-frame-command (com-make-insect :name t :menu t) - () - (let ((i (make-instance 'insect))) - (with-output-as-presentation (t i (presentation-type-of i)) - (print i)) - (terpri))) - -(define-test-frame-command (com-describe-insect :name t :menu t) - ((bug 'insect - :gesture (nil :menu t) - :prompt "Select an insect")) - (describe bug)) - -(define-test-frame-command (com-disable-insect :name t :menu t) () - (setf (command-enabled 'com-describe-insect *application-frame*) - (not (command-enabled 'com-describe-insect *application-frame*)))) +;; (define-test-frame-command (com-make-insect :name t :menu t) +;; () +;; (let ((i (make-instance 'insect))) +;; (with-output-as-presentation (t i (presentation-type-of i)) +;; (print i)) +;; (terpri))) + +;; (define-test-frame-command (com-describe-insect :name t :menu t) +;; ((bug 'insect +;; :gesture (nil :menu t) +;; :prompt "Select an insect")) +;; (describe bug)) + +;; (define-test-frame-command (com-disable-insect :name t :menu t) () +;; (setf (command-enabled 'com-describe-insect *application-frame*) +;; (not (command-enabled 'com-describe-insect *application-frame*)))) (clim:define-application-frame tf100 () () (:command-table test-frame) @@ -719,8 +717,8 @@ (terpri stream) (setq d (accept 'integer :stream stream :prompt "d" :default d)) (terpri stream)) - (abort) - (frame-exit))))))) + (abort () nil) + (frame-exit () nil))))))) (define-application-frame tf101 () () (:command-table test-frame) -- GitLab