[mcclim-cvs] CVS mcclim/Drei/Tests

4 Dec 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@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@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 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))
     ,@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)
           ,@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@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]

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

[mcclim-cvs] CVS mcclim/Drei/Tests