(in-package :org.wanglianghome.pushbox.test)

(eval-when (:compile-toplevel :execute)
  (load "/home/liang/lib/cl/lisp-unit.lisp")
  (use-package :lisp-unit))

(lisp-unit:define-test test-predicate
  (lisp-unit:assert-true (wl/pushbox::person-p '(p 0)))
  (lisp-unit:assert-false (wl/pushbox::person-p '(0 1)))
  (lisp-unit:assert-true (wl/pushbox::box-p '(b 1)))
  (lisp-unit:assert-false (wl/pushbox::box-p '(1 2)))
  (lisp-unit:assert-true (wl/pushbox::target-p '(o 2)))
  (lisp-unit:assert-false (wl/pushbox::target-p '(b 1))))

(lisp-unit:define-test test-get-map-components
  (let ((test-map '((p 0) (b 1) (o 2) (0 > 1) (1 > 2))))
    (lisp-unit:assert-equal '(p 0) (wl/pushbox::get-person test-map))
    (lisp-unit:assert-equality #'lisp-unit:set-equal
			       '((b 1)) (wl/pushbox::get-box test-map))
    (lisp-unit:assert-equality #'lisp-unit:set-equal
			       '((o 2)) (wl/pushbox::get-target test-map))
    (lisp-unit:assert-equality #'lisp-unit:set-equal
			       '((0 > 1) (1 > 2)) (wl/pushbox::get-graph test-map))))

(lisp-unit:define-test test-person-eql
  (lisp-unit:assert-true (wl/pushbox::person-eql '(p 1) '(p 1)))
  (lisp-unit:assert-false (wl/pushbox::person-eql '(p 1) '(p 2))))

(lisp-unit:define-test test-box-eql
  (lisp-unit:assert-true (wl/pushbox::box-eql '((b 1) (b 2)) '((b 1) (b 2))))
  (lisp-unit:assert-true (wl/pushbox::box-eql '((b 2) (b 1)) '((b 1) (b 2))))
  (lisp-unit:assert-false (wl/pushbox::box-eql '((b 1) (b 2)) '((b 1) (b 3)))))

(lisp-unit:define-test test-state-eql
  (lisp-unit:assert-true (wl/pushbox::state-eql '((p 1) ((b 1) (b 2)) ((1 v 2) (1 ^ 3)))
						'((p 1) ((b 2) (b 1)) ((1 ^ 3) (1 v 2))))))

(lisp-unit:define-test test-position
  (lisp-unit:assert-eql 0 (wl/pushbox::get-position '(p 0)))
  (lisp-unit:assert-eql 1 (wl/pushbox::get-position '(b 1)))
  (lisp-unit:assert-eql 2 (wl/pushbox::get-position '(o 2))))

(lisp-unit:define-test test-node-edge
  (lisp-unit:assert-eql 0 (wl/pushbox::from-node '(0 < 1)))
  (lisp-unit:assert-eql 1 (wl/pushbox::to-node '(0 < 1)))
  (lisp-unit:assert-eql '< (wl/pushbox::edge-direction '(0 < 1))))

(lisp-unit:define-test test-get-edge-direction
  (lisp-unit:assert-eql '< (wl/pushbox::get-edge-direction 0 1 '((0 < 1) (1 < 2)))))

(lisp-unit:define-test test-opposite-edge-direction
  (lisp-unit:assert-eql '< (wl/pushbox::opposite-edge-direction '>))
  (lisp-unit:assert-eql '> (wl/pushbox::opposite-edge-direction '<))
  (lisp-unit:assert-eql 'wl/pushbox::v (wl/pushbox::opposite-edge-direction 'wl/pushbox::^))
  (lisp-unit:assert-eql 'wl/pushbox::^ (wl/pushbox::opposite-edge-direction 'wl/pushbox::v)))

(lisp-unit:define-test test-get-box-target
  (lisp-unit:assert-eql 2 (wl/pushbox::get-box-target 1 '< '((0 < 1) (1 < 2))))
  (lisp-unit:assert-eql 2 (wl/pushbox::get-box-target 1 '< '((0 < 1) (2 > 1)))))

(lisp-unit:define-test test-make-moving-person-ops
  (let ((op (wl/pushbox::make-op :action '(move person from 0 to 1)
				 :preconds '((p 0))
				 :add-list '((p 1))
				 :del-list '((p 0)))))
    (lisp-unit:assert-true
     (and (mapcar #'wl/pushbox::op-equal
		  (list op)
		  (wl/pushbox::make-moving-person-ops '(p 0)
						      '((b 2))
						      '((0 < 1) (1 < 2) (2 < 3))))))
    (lisp-unit:assert-true
     (and (mapcar #'wl/pushbox::op-equal
		  (list op)
		  (wl/pushbox::make-moving-person-ops '(p 0)
						      '((b 2))
						      '((1 > 0) (1 < 2) (2 < 3))))))))

(lisp-unit:define-test test-make-pushing-box-ops
  (let ((op (wl/pushbox::make-op :action '(push box from 1 to 2)
				 :preconds '((p 0) (b 1))
				 :add-list '((p 1) (b 2))
				 :del-list '((p 0) (b 1)))))
    (lisp-unit:assert-true
     (and (mapcar #'wl/pushbox::op-equal
		  (list op)
		  (wl/pushbox::make-pushing-box-ops '(p 0) '((b 1)) '((0 < 1) (1 < 2))))))
    (lisp-unit:assert-true
     (and (mapcar #'wl/pushbox::op-equal
		  (list op)
		  (wl/pushbox::make-pushing-box-ops '(p 0) '((b 1)) '((1 > 0) (1 < 2))))))))

(lisp-unit:define-test test-get-adjacent-edges
  (lisp-unit:assert-equal '((1 < 2)) (wl/pushbox::get-adjacent-edges 1 '((1 < 2) (2 < 3)))))

(lisp-unit:define-test test-normalize-edges
  (lisp-unit:assert-true (lisp-unit:set-equal '((1 < 2) (1 > 3)) (wl/pushbox::normalize-edges 1 '((1 < 2) (3 < 1))))))

(lisp-unit:define-test test-opposite-edge-p
  (lisp-unit:assert-true (wl/pushbox::opposite-edge-p '(1 < 2) '(1 > 3)))
  (lisp-unit:assert-false (wl/pushbox::opposite-edge-p '(1 < 2) '(1 v 3))))

(lisp-unit:define-test test-empty-node-p
  (lisp-unit:assert-true (wl/pushbox::empty-node-p 1 '((b 0) (b 2))))
  (lisp-unit:assert-false (wl/pushbox::empty-node-p 1 '((b 0) (b 1)))))

(lisp-unit:define-test test-movable-box-p
  (lisp-unit:assert-true (wl/pushbox::movable-box-p '(b 1) '((b 1)) '((0 < 1) (1 < 2))))
  (lisp-unit:assert-false (wl/pushbox::movable-box-p '(b 1) '((b 1)) '((0 < 1) (1 v 2))))
  (lisp-unit:assert-true (wl/pushbox::movable-box-p '(b 1) '((b 1) (b 3)) '((0 < 1) (1 < 2) (3 v 1) (1 ^ 4))))
  (lisp-unit:assert-false (wl/pushbox::movable-box-p '(b 1) '((b 1) (b 2) (b 3)) '((0 < 1) (1 < 2) (3 v 1) (1 ^ 4)))))

(lisp-unit:define-test test-dead-state-p
  (lisp-unit:assert-true (wl/pushbox::dead-state-p '((b 1)) '((0 < 1) (1 v 2)))))

(defun save-old-opposite-directions (directions)
  (dolist (dir-pair directions)
    (dolist (dir dir-pair)
      (setf (get dir 'old-opposite-direction) (get dir 'opposite-direction)))))

(defun restore-old-opposite-directions (directions)
  (dolist (dir-pair directions)
    (dolist (dir dir-pair)
      (setf (get dir 'opposite-direction) (get dir 'old-opposite-direction)))))

;;; It's much safer to use `pushbox-run-all-tests' and
;;; `pushbox-run-tests' to run tests than use
;;; `lisp-unit:run-all-tests' and `lisp-unit:run-tests' directly since
;;; they protect original direction information in environment.

(defmacro pushbox-run-tests-1 (directions &body body)
  (let ((dirs (gensym)))
    `(let ((,dirs ,directions))
       (unwind-protect
	    (progn (save-old-opposite-directions ,dirs)
		   (wl/pushbox::make-edge-directions ,dirs)
		   ,@body)
	 (restore-old-opposite-directions ,dirs)))))

(defmacro pushbox-run-all-tests (&optional (directions 'wl/pushbox::*simple-edge-directions*) (package :cl-user))
  `(pushbox-run-tests-1 ,directions
     (lisp-unit:run-all-tests ,package)))

(defmacro pushbox-run-tests (tests &optional (directions 'wl/pushbox::*simple-edge-directions*))
  `(pushbox-run-tests-1 ,directions
     (lisp-unit:run-tests ,tests)))