[mcclim-cvs] CVS mcclim/Drei/Tests/cl-automaton

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@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) (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@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) (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@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) (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]
participants (1)
-
thenriksen