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

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

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/cl-automaton