/usr/share/common-lisp/source/mcclim/Drei/Tests/testing.lisp is in cl-mcclim 0.9.6.dfsg.cvs20100315-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 | ;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;; (c) copyright 2005 by
;;; Aleksandar Bakic (a_bakic@yahoo.com)
;;; (c) copyright 2006 by
;;; Troels Henriksen (athas@sigkill.dk)
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
;;; License as published by the Free Software Foundation; either
;;; version 2 of the License, or (at your option) any later version.
;;;
;;; This library is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Library General Public License for more details.
;;;
;;; You should have received a copy of the GNU Library General Public
;;; License along with this library; if not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307 USA.
(cl:in-package :drei-tests)
;; Define some stuff to ease the pain of writing repetitive test
;; cases. Also provide global test-suite and test-running entry point.
(defclass delegating-standard-buffer (delegating-buffer) ()
(:default-initargs :implementation (make-instance 'standard-buffer)))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defparameter *buffer-classes* '((standard-buffer)
(delegating-standard-buffer)
(binseq-buffer
persistent-left-sticky-mark
persistent-right-sticky-mark)
(obinseq-buffer
persistent-left-sticky-mark
persistent-right-sticky-mark)
(binseq2-buffer
persistent-left-sticky-line-mark
persistent-right-sticky-line-mark))))
(defmacro buffer-test (name &body body)
"Define FiveAM tests for all the standard buffer
classes. %%BUFFER in `body' will be substituted for a buffer
class, %%LEFT-STICKY-MARK will be substituted for a
left-sticky-mark class and %%RIGHT-STICKY-MARK will be
substituted for a right sticky mark class."
(let (result)
(dolist (class-spec *buffer-classes*)
(destructuring-bind (buffer &optional (left-sticky-mark 'standard-left-sticky-mark)
(right-sticky-mark 'standard-right-sticky-mark))
class-spec
(let ((alist (list (cons '%%buffer `',buffer)
(cons '%%left-sticky-mark `',left-sticky-mark)
(cons '%%right-sticky-mark `',right-sticky-mark))))
(push `(test ,(intern (concatenate 'string (symbol-name buffer)
"-" (symbol-name name)))
,@(sublis alist body))
result))))
(list* 'progn result)))
(defmacro with-buffer ((buffer &key (initial-contents "")) &body body)
`(let ((,buffer (make-instance 'drei-buffer :initial-contents ,initial-contents)))
,@body))
(defmacro with-view ((view &key (buffer (make-instance 'drei-buffer))
(syntax ''drei-fundamental-syntax:fundamental-syntax))
&body body)
(once-only (buffer)
`(let ((,view (make-instance 'textual-drei-syntax-view
:buffer ,buffer)))
(setf (syntax ,view) (make-syntax-for-view ,view ,syntax))
,@body)))
(defun buffer-contents (&optional (buffer (current-buffer)))
"The contents of `(current-buffer)' as a string."
(buffer-substring buffer 0 (size buffer)))
(defun buffer-is (string &optional (buffer (current-buffer))
(begin-offset 0) (end-offset (size buffer)))
"Check (using FiveAM) whether `buffer' contains `string' in the
subsequence delimited by `begin-offset' and `end-offset'."
(is (string= string (buffer-substring buffer begin-offset end-offset))))
(defclass test-drei (drei)
()
(:documentation "An instantiable Drei variant with no
display. Used for testing.")
(:metaclass modual-class)
(:default-initargs :no-cursors t))
(defmacro with-drei-environment ((&key (initial-contents "")
(syntax ''drei-fundamental-syntax:fundamental-syntax))
&body body)
(with-gensyms (buffer view drei)
`(with-buffer (,buffer :initial-contents ,initial-contents)
(with-view (,view :buffer ,buffer :syntax ,syntax)
(let ((,drei (make-instance 'test-drei :view ,view)))
(with-bound-drei-special-variables (,drei :minibuffer nil)
,@body))))))
(def-suite drei-tests :description "The test suite for all Drei
test cases. Has nested test suites for the actual tests.")
(defun run-tests ()
"Run the Drei test suite. A dot will be printed for each passed
test, a \"f\" for each failed test, a \"X\" for each test that
causes an error, and an \"s\" for each skipped test."
(run! 'drei-tests))
|