[mcclim-cvs] CVS mcclim/Drei/Tests
thenriksen
thenriksen at common-lisp.net
Mon Dec 4 07:54:51 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Drei/Tests
In directory clnet:/tmp/cvs-serv11709/Drei/Tests
Added Files:
undo-tests.lisp testing.lisp rectangle-tests.lisp
packages.lisp motion-tests.lisp kill-ring-tests.lisp
editing-tests.lisp core-tests.lisp buffer-tests.lisp
base-tests.lisp
Log Message:
Replaced the old RT-based test suite with a new FiveAM-based one. Also
added a fair amount of new tests. What isn't tested is:
- CLIM parts
- Commands
- Syntax module and specific syntaxes
(Unfortunately, these are arguably the most interesting things to
test).
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/undo-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/undo-tests.lisp 2006/12/04 07:54:51 1.1
;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;; (c) copyright 2006 by
;;; Troels Henriksen (athas at 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)
(def-suite undo-tests :description "The test suite for tests
related to Drei's undo system.")
(in-suite undo-tests)
(defclass test-undo-record (standard-undo-record)
())
(defmethod flip-undo-record ((record test-undo-record)))
(test add-undo
(let ((tree (make-instance 'standard-undo-tree)))
(finishes (add-undo (make-instance 'test-undo-record) tree))
(finishes (add-undo (make-instance 'test-undo-record) tree))))
(test undo
(let ((tree (make-instance 'standard-undo-tree)))
(add-undo (make-instance 'test-undo-record) tree)
(add-undo (make-instance 'test-undo-record) tree)
(finishes (undo tree 2))
(signals no-more-undo
(undo tree 1))))
(test redo
(let ((tree (make-instance 'standard-undo-tree)))
(add-undo (make-instance 'test-undo-record) tree)
(undo tree 1)
(redo tree 1)
(finishes (undo tree 1))))
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/testing.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/testing.lisp 2006/12/04 07:54:51 1.1
;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;; (c) copyright 2005 by
;;; Aleksandar Bakic (a_bakic at yahoo.com)
;;; (c) copyright 2006 by
;;; Troels Henriksen (athas at 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 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 (syntax ''drei-fundamental-syntax:fundamental-syntax)
(initial-contents "")) &body body)
`(let ((,buffer (make-instance 'drei-buffer :syntax ,syntax
:initial-contents ,initial-contents)))
(update-syntax ,buffer (syntax ,buffer))
, at 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= (buffer-substring buffer begin-offset end-offset)
string)))
(defclass test-drei (drei)
()
(:documentation "An instantiable Drei variant with no
display. Used for testing."))
(defmacro with-drei-environment ((&key (initial-contents "")
(syntax ''drei-fundamental-syntax:fundamental-syntax))
&body body)
(with-gensyms (buffer drei)
`(with-buffer (,buffer :initial-contents ,initial-contents
:syntax ,syntax)
(let ((,drei (make-instance 'test-drei :buffer ,buffer)))
(with-bound-drei-special-variables (,drei :minibuffer nil)
, at body)))))
(defun run-tests ()
(format t "Testing buffer protocol implementation(s)~%")
(run! 'buffer-tests)
(format t "Testing basic functions~%")
(run! 'base-tests)
(format t "Testing the kill ring~%")
(run! 'kill-ring-tests)
(format t "Testing mark motion~%")
(run! 'motion-tests)
(format t "Testing text editing functions~%")
(run! 'editing-tests)
(format t "Testing miscellaneus editor functions~%")
(run! 'core-tests)
(format t "Testing rectangle editing~%")
(run! 'rectangle-tests)
(format t "Testing undo~%")
(run! 'undo-tests)
(format t "Running the CL-AUTOMATON tests~%")
(format t "Testing regular expressions~%")
(run! 'regexp-tests)
(format t "Testing eqv-hash~%")
(run! 'eqv-hash-tests)
(format t "Testing states and transitions~%")
(run! 'state-and-transition-tests)
(format t "Testing core automata functions~%")
(run! 'automaton-tests))
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/rectangle-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/rectangle-tests.lisp 2006/12/04 07:54:51 1.1
;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
;;; (c) copyright 2006 by
;;; Troels Henriksen (athas at 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)
(def-suite rectangle-tests :description "The test suite for
rectangle-editing related tests.")
(in-suite rectangle-tests)
(test map-rectangle-lines
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(macrolet ((check (startcol endcol)
`(progn
(is-true (beginning-of-line-p mark))
(is (= (line-number mark) (incf line)))
(is (> 4 line))
(is (= startcol ,startcol))
(is (= endcol ,endcol)))))
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(let ((line -1))
(map-rectangle-lines *current-buffer*
#'(lambda (mark startcol endcol)
(check 0 16))
*current-point*
*current-mark*)
(is (= line 3)))
(let ((line -1))
(map-rectangle-lines *current-buffer*
#'(lambda (mark startcol endcol)
(check 0 16))
*current-mark*
*current-point*)
(is (= line 3)))
(setf (offset *current-point*) 2)
(setf (offset *current-mark*) 63)
(let ((line -1))
(map-rectangle-lines *current-buffer*
#'(lambda (mark startcol endcol)
(check 2 13))
*current-point*
*current-mark*)
(is (= line 3)))
(let ((line -1))
(map-rectangle-lines *current-buffer*
#'(lambda (mark startcol endcol)
(check 2 13))
*current-mark*
*current-point*)
(is (= line 3)))
(beginning-of-buffer *current-point*)
(beginning-of-buffer *current-mark*)
(let ((line -1))
(map-rectangle-lines *current-buffer*
#'(lambda (mark startcol endcol)
(check 0 0))
*current-point*
*current-mark*)
(is (= line 0))))))
(test extract-and-delete-rectangle-line
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(is (equal (map-rectangle-lines *current-buffer*
#'extract-and-delete-rectangle-line
*current-point*
*current-mark*)
'("Line number one "
"Line number two "
"Line number thre"
"Line number four")))
(buffer-is "
e
"))
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(beginning-of-line *current-mark*)
(is (equal (map-rectangle-lines *current-buffer*
#'extract-and-delete-rectangle-line
*current-point*
*current-mark*)
'(""
""
""
"")))
(buffer-is "Line number one
Line number two
Line number three
Line number four"))
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(forward-line *current-point* *current-syntax*)
(forward-object *current-point* 5)
(end-of-buffer *current-mark*)
(backward-line *current-mark* *current-syntax*)
(beginning-of-line *current-mark*)
(forward-object *current-mark* 12)
(is (equal (map-rectangle-lines *current-buffer*
#'extract-and-delete-rectangle-line
*current-point*
*current-mark*)
'("number "
"number ")))
(buffer-is "Line number one
Line two
Line three
Line number four")))
(test open-rectangle-line
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(map-rectangle-lines *current-buffer*
#'open-rectangle-line
*current-point*
*current-mark*)
(buffer-is " Line number one
Line number two
Line number three
Line number four"))
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(beginning-of-line *current-mark*)
(map-rectangle-lines *current-buffer*
#'open-rectangle-line
*current-point*
*current-mark*)
(buffer-is "Line number one
Line number two
Line number three
Line number four"))
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(forward-line *current-point* *current-syntax*)
(forward-object *current-point* 5)
(end-of-buffer *current-mark*)
(backward-line *current-mark* *current-syntax*)
(beginning-of-line *current-mark*)
(forward-object *current-mark* 12)
(map-rectangle-lines *current-buffer*
#'open-rectangle-line
*current-point*
*current-mark*)
(buffer-is "Line number one
Line number two
Line number three
Line number four")))
(test clear-rectangle-line
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(map-rectangle-lines *current-buffer*
#'clear-rectangle-line
*current-point*
*current-mark*)
(buffer-is "
e
"))
(with-drei-environment (:initial-contents "Line number one
Line number two
Line number three
Line number four")
(beginning-of-buffer *current-point*)
(end-of-buffer *current-mark*)
(beginning-of-line *current-mark*)
(map-rectangle-lines *current-buffer*
#'clear-rectangle-line
*current-point*
*current-mark*)
(buffer-is "Line number one
Line number two
Line number three
Line number four"))
(with-drei-environment (:initial-contents "Line number one
[234 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/packages.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/packages.lisp 2006/12/04 07:54:51 1.1
[267 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2006/12/04 07:54:51 1.1
[583 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/kill-ring-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/kill-ring-tests.lisp 2006/12/04 07:54:51 1.1
[702 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/editing-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/editing-tests.lisp 2006/12/04 07:54:51 1.1
[1117 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/core-tests.lisp 2006/12/04 07:54:51 1.1
[1503 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/buffer-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/buffer-tests.lisp 2006/12/04 07:54:51 1.1
[2397 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/base-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/base-tests.lisp 2006/12/04 07:54:51 1.1
[3252 lines skipped]
More information about the Mcclim-cvs
mailing list