;; $Id: test.lisp,v 1.23 2006/01/06 13:30:39 jimka Exp $

#|

 This software is Copyright (c) 2005 Jim Newton <jimka@rdrop.com>

 Jim Newton grants you the rights to distribute
 and use this software as governed by the terms
 of the Lisp Lesser GNU Public License
 (http://opensource.franz.com/preamble.html),
 known as the LLGPL.
 
 This program 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 General Public License for more details.
 
|#

(defpackage "HEUTE-TEST"
  (:use "HEUTE"
	 "COMMON-LISP"))

(in-package heute-test)
   
(defclass test-testcase ( testcase)
  ((test-name
    :initform "Testing the HEUTE Package")
   (test-funs
    :initform '(test1
		test2
		test3
		))))

(defvar *denominator* 0)
(defmethod test4 (( testcase test-testcase))
  (/ 1 *denominator*))

(defclass test3-testcase (testcase)
  ((test-name
    :initform "Test 3 testcase")
   (test-funs
    :initform '(test1))))

(defmethod test1 ((testcase test3-testcase))
  (assert-true testcase
	       (= 1 1)
	       :tag 100))

(defclass test2-testcase ( testcase)
  ((test-name
    :initform "Testing more of the HEUTE Package")
   (test-funs
    :initform '(test1))))

(define-condition test-condition () ())
(define-condition test-sub-condition (test-condition) ())

(defmethod test1 ((testcase test2-testcase))
  (assert-false testcase
		(= 1 0)
		:tag 100)
  (assert-true testcase
	       (= 1 1)
	       :tag 101)
  (assert-not-equal testcase
		    "abc" "def"
		    :tag 65
		    :test 'equal)
  (assert-equal testcase
		1 1
		:tag 69)
  (assert-not-condition testcase
			test-condition
			nil
			:tag 73)
  (fail-if-not-condition testcase
			 test-condition
			 (signal 'test-condition)
			 :tag 77)
  (assert-condition testcase
		    test-condition
		    (signal 'test-condition)
		    :tag 81))

(defmethod test1 (( test test-testcase))
  (fail-if-not test 1
	       :tag 85
	       :text "won't happen")
  (fail-if test nil
	   :tag 88
	   :text "expecting this error"))

(defmethod test2  (( test test-testcase))
  (sleep 1))

(defmethod test3 (( testcase test-testcase))
  (sleep 1)
  (fail-if testcase nil
	   :tag 97)
  (fail-if testcase nil
	   :tag 99))



(defclass sub-test-testcase1 ( test-testcase)
  ((test-name
    :initform "Testing the HEUTE SUB Package")
   (test-funs
    :initform '(test1
		test2
		test3))))

(defclass sub-test-testcase2 (test-testcase)
  (( test-name
     :initform "second one")))

(defclass sub-test-testcase21 (sub-test-testcase2)
  (( test-name
     :initform "second one's first child")))

(defclass sub-test-testcase22 (sub-test-testcase2)
  (( test-name
     :initform "second one's second child")))


(defclass sub-test-testcase3 (test-testcase)
  (( test-name
     :initform "third one")))


(defmethod test1 (( test sub-test-testcase1))
  (sleep 1)
  (fail-if-equal test
		 1
		 2.0
		 :text "1 != 2.0"
		 :tag 134)
  (fail-if-not-equal test
		     1
		     1.0
		     :tag 138))


(defmethod test2 (( test sub-test-testcase1))
  (sleep 1)
  (fail-if test nil
	   :tag 144)
  (fail-if test nil
	   :tag 146))



(defmethod test3 (( testcase sub-test-testcase1))
  (sleep 1)
  (fail-if-condition testcase test-condition
		     nil
		     :tag 154)
  
  (fail-if-not-condition testcase test-condition
			 (progn (format t "at 301~%") (signal 'test-condition))
			 :tag 158)

  (fail-if-condition testcase test-sub-condition
		     (signal 'test-condition)
		     :tag 160)
  
  (fail-if-not-condition testcase test-condition
			 (signal 'test-sub-condition)
			 :tag 166))