[mcclim-cvs] CVS mcclim/Drei/Tests/cl-automaton
thenriksen
thenriksen at common-lisp.net
Mon Dec 4 07:54:51 UTC 2006
Update of /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton
In directory clnet:/tmp/cvs-serv11709/Drei/Tests/cl-automaton
Added Files:
state-and-transition-tests.lisp regexp-tests.lisp
eqv-hash-tests.lisp automaton-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/cl-automaton/state-and-transition-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/state-and-transition-tests.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)
(def-suite state-and-transition-tests :description "The test
suite for CL-AUTOMATON state-and-transition related tests.")
(in-suite state-and-transition-tests)
(test clone.transition
(let* ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(t2 (automaton::clone t1)))
(is (eqv t1 t2 +equalp-key-situation+))
(is (eql (hash t1 +equalp-key-situation+)
(hash t2 +equalp-key-situation+)))))
(test transition<.1
(let ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\c) :maxc (char-code #\d)
:to (make-instance 'automaton::state)))
(automaton::*to-first* nil))
(is-true (automaton::transition< t1 t2))))
(test transition<.2
(let ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\c) :maxc (char-code #\d)
:to (make-instance 'automaton::state)))
(automaton::*to-first* t))
(setf (automaton::num (automaton::to t1)) 1)
(is-true (automaton::transition< t2 t1)))
(let ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\d)
:to (make-instance 'automaton::state)))
(automaton::*to-first* t))
(is-true (automaton::transition< t2 t1))))
(test transition<.3
(let ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\c)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(automaton::*to-first* nil))
(is-true (automaton::transition< t1 t2))))
(test sstep.test-1
(let* ((s (make-instance 'automaton::state))
(tr (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b) :to s)))
(htadd (automaton::transitions s) tr)
(is (eq (automaton::sstep s #\a) s))))
(test sstep.test-2
(let* ((s (make-instance 'automaton::state))
(tr (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b) :to s)))
(htadd (automaton::transitions s) tr)
(is-false (automaton::sstep s #\c))))
(test add-epsilon
(let* ((s1 (make-instance 'automaton::state))
(s2 (make-instance 'automaton::state))
(tr (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b) :to s2)))
(htadd (automaton::transitions s2) tr)
(automaton::add-epsilon s1 s2)
(is-true (htpresent (automaton::transitions s1) tr))))
(test sorted-transition-vector
(let* ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\c)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(s (make-instance 'automaton::state)))
(htadd (automaton::transitions s) t1)
(htadd (automaton::transitions s) t2)
(is (equalp (automaton::sorted-transition-vector s nil)
(vector t1 t2)))))
(test sorted-transition-list
(let* ((t1 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\c)
:to (make-instance 'automaton::state)))
(t2 (make-instance 'automaton::transition
:minc (char-code #\a) :maxc (char-code #\b)
:to (make-instance 'automaton::state)))
(s (make-instance 'automaton::state)))
(htadd (automaton::transitions s) t1)
(htadd (automaton::transitions s) t2)
(is (equal (automaton::sorted-transition-list s nil)
(list t1 t2)))))--- /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/regexp-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/regexp-tests.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)
(def-suite regexp-tests :description "The test suite for
CL-AUTOMATON regexp related tests.")
(in-suite regexp-tests)
(automaton-test string-regexp.1
(is-true (regexp-equal
(string-regexp "#")
(automaton::make-regexp :empty))))
(automaton-test string-regexp.2
(is-true (regexp-equal
(string-regexp "foo")
(make-instance 'automaton::regexp :kind :string :s "foo")))
(is-true (regexp-equal
(string-regexp "\"foo\"")
(make-instance 'automaton::regexp :kind :string :s "foo")))
(is-true (regexp-equal
(string-regexp "()")
(make-instance 'automaton::regexp :kind :string :s ""))))
(automaton-test string-regexp.3
(is-true (regexp-equal
(string-regexp "c")
(make-instance 'automaton::regexp :kind :char :c #\c)))
(is-true (regexp-equal
(string-regexp "\c")
(make-instance 'automaton::regexp :kind :char :c #\c)))
(is-true (regexp-equal
(string-regexp "\\c")
(make-instance 'automaton::regexp :kind :char :c #\c))))
(automaton-test string-regexp.4
(is-true (regexp-equal
(string-regexp ".")
(automaton::make-regexp :anychar))))
(automaton-test string-regexp.5
(is-true (regexp-equal
(string-regexp "@")
(automaton::make-regexp :anystring))))
(automaton-test string-regexp.6
(is-true (regexp-equal
(string-regexp "<11-15>")
(make-instance 'automaton::regexp :kind :interval
:minr 11 :maxr 15 :digits 2)))
(is-true (regexp-equal
(string-regexp "<11-115>")
(make-instance 'automaton::regexp :kind :interval
:minr 11 :maxr 115 :digits 0)))
(is-true (regexp-equal
(string-regexp "<115-11>")
(make-instance 'automaton::regexp :kind :interval
:minr 11 :maxr 115 :digits 0))))
(automaton-test string-regexp.7
(is-true (regexp-equal
(string-regexp "<sub>")
(make-instance 'automaton::regexp :kind :automaton :s "sub"))))
(automaton-test string-regexp.8
(is-true (regexp-equal
(string-regexp "[a-z]")
(make-instance 'automaton::regexp :kind :char-range :from #\a :to #\z)))
(is-true (regexp-equal
(string-regexp "[a]")
(make-instance 'automaton::regexp :kind :char :c #\a))))
(automaton-test string-regexp.9
(is-true (regexp-equal
(string-regexp "[a][b][c]")
(make-instance 'automaton::regexp :kind :string :s "abc"))))
(automaton-test string-regexp.10
(is-true (regexp-equal
(string-regexp "[ab]")
(automaton::make-regexp
:union (make-instance 'automaton::regexp :kind :char :c #\a)
(make-instance 'automaton::regexp :kind :char :c #\b)))))
(automaton-test string-regexp.11
(is-true (regexp-equal
(string-regexp "[^a-c0-3]")
(automaton::make-regexp
:intersection
(automaton::make-regexp :anychar)
(automaton::make-regexp
:complement
(automaton::make-regexp
:union
(make-instance 'automaton::regexp :kind :char-range
:from #\a :to #\c)
(make-instance 'automaton::regexp :kind :char-range
:from #\0 :to #\3))))))
(is-true (regexp-equal
(string-regexp "[a^b-c]")
(automaton::make-regexp
:union
(automaton::make-regexp
:union (make-instance 'automaton::regexp :kind :char :c #\a)
(make-instance 'automaton::regexp :kind :char :c #\^))
(make-instance 'automaton::regexp :kind :char-range
:from #\b :to #\c)))))
(automaton-test string-regexp.12
(is-true (regexp-equal
(string-regexp "~[a-c]")
(automaton::make-regexp
:complement (make-instance 'automaton::regexp :kind :char-range
:from #\a :to #\c)))))
(automaton-test string-regexp.13
(is-true (regexp-equal
(string-regexp "f?")
(automaton::make-regexp
:optional (make-instance 'automaton::regexp :kind :char :c #\f)))))
(automaton-test string-regexp.14
(is-true (regexp-equal
(string-regexp "(\"foo\")?")
(automaton::make-regexp
:optional (make-instance 'automaton::regexp :kind :string :s "foo")))))
(automaton-test string-regexp.15
(is-true (regexp-equal
(string-regexp "[a-c]*")
(automaton::make-regexp
:repeat (make-instance 'automaton::regexp :kind :char-range
:from #\a :to #\c)))))
(automaton-test string-regexp.16
(is-true (regexp-equal
(string-regexp "(\"foo\")+")
(make-instance
'automaton::regexp :kind :repeat-min
:exp1 (make-instance 'automaton::regexp :kind :string :s "foo")
:minr 1))))
(automaton-test string-regexp.17
(is-true (regexp-equal
(string-regexp "[a-c]{3}")
(make-instance
'automaton::regexp :kind :repeat-minmax
:exp1 (make-instance 'automaton::regexp :kind :char-range
:from #\a :to #\c)
:minr 3 :maxr 3))))
(automaton-test string-regexp.18
(is-true (regexp-equal
(string-regexp "(~c){1,2}")
(make-instance
'automaton::regexp :kind :repeat-minmax
:exp1 (automaton::make-regexp
:complement (make-instance 'automaton::regexp :kind :char :c #\c))
:minr 1 :maxr 2))))
(automaton-test string-regexp.19
(is-true (regexp-equal
(string-regexp "[a-z]~[0-9]")
(automaton::make-regexp
:concatenation
(make-instance 'automaton::regexp :kind :char-range :from #\a :to #\z)
(automaton::make-regexp
:complement (make-instance 'automaton::regexp :kind :char-range
:from #\0 :to #\9))))))
(automaton-test string-regexp.20
(is-true (regexp-equal
(string-regexp "(ab+)&(a+b)|c")
(automaton::make-regexp
:union
(automaton::make-regexp
:intersection
(automaton::make-regexp
:concatenation
(make-instance 'automaton::regexp :kind :char :c #\a)
(make-instance
'automaton::regexp :kind :repeat-min
:exp1 (make-instance 'automaton::regexp :kind :char :c #\b)
:minr 1))
(automaton::make-regexp
:concatenation
(make-instance
'automaton::regexp :kind :repeat-min
:exp1 (make-instance 'automaton::regexp :kind :char :c #\a)
:minr 1)
(make-instance 'automaton::regexp :kind :char :c #\b)))
(make-instance 'automaton::regexp :kind :char :c #\c)))))
(automaton-test string-regexp.21
(is-true (regexp-equal
(string-regexp "a\"b\"+c")
(automaton::make-regexp
:concatenation
(make-instance 'automaton::regexp :kind :char :c #\a)
(automaton::make-regexp
:concatenation
(make-instance
'automaton::regexp :kind :repeat-min
:exp1 (make-instance 'automaton::regexp :kind :string :s "b")
:minr 1)
(make-instance 'automaton::regexp :kind :char :c #\c))))))
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/eqv-hash-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/eqv-hash-tests.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)
(def-suite eqv-hash-tests :description "The test suite for
CL-AUTOMATON eqv-hash related tests.")
(in-suite eqv-hash-tests)
(defclass foo ()
((slot1 :initform 0 :initarg :slot1 :type fixnum :accessor slot1)
(slot2 :initform 0 :initarg :slot2 :type fixnum :accessor slot2)))
(defclass foo-intention (equalp-key-situation) ())
(defparameter +foo-intention+ (make-instance 'foo-intention))
(defmethod eqv ((foo1 foo) (foo2 foo) (s (eql +foo-intention+)))
(eql (slot1 foo1) (slot1 foo2)))
(defmethod hash ((foo1 foo) (s (eql +foo-intention+)))
(floor (slot1 foo1) 2))
(test htref.test-1 ; (eqv i1 i2), (= (hash i1) (hash i2))
(let ((ght (make-generalized-hash-table +foo-intention+))
(i1 (make-instance 'foo :slot1 1 :slot2 2))
(i2 (make-instance 'foo :slot1 1 :slot2 3)))
(setf (htref ght i1) i1)
(setf (htref ght i2) i2)
(is (= (cnt ght) 1))
(is (eq (htref ght i1) i2))
(is (htref ght i2) i2)))
[143 lines skipped]
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/automaton-tests.lisp 2006/12/04 07:54:51 NONE
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/cl-automaton/automaton-tests.lisp 2006/12/04 07:54:51 1.1
[439 lines skipped]
More information about the Mcclim-cvs
mailing list