Added tests

CommonLisp/README.adoc

@@ -4,5 +4,5 @@ This version can be executed using https://lisp-lang.org/[Common Lisp] with the
 
 == Tests
 
-TBD
+Execute the tests with the command `CL_SOURCE_REGISTRY=$(pwd)/conway sbcl --script tests.lisp`.
 

CommonLisp/conway/world.lisp

 (defclass world ()
   ((size :accessor size :initarg :size)
-   (cells :initarg :cells))
+   (cells :accessor cells :initarg :cells))
   (:documentation "A lattice of cells referenced by coord values."))
 
 (defun find-in-list (object list)
@@ -18,6 +18,15 @@
 			(setf (gethash c cells) 'dead)))))
   (make-instance 'world :size size :cells cells))
 
+(defun equal-world (this other)
+  (with-slots (size cells) this
+	(defvar equal-size (= size (size other)))
+	(defvar equal-cells t)
+	(loop for key being the hash-keys of cells using (hash-value value) do
+		  (let ((othercell (gethash key (cells other))))
+			(setq equal-cells (and equal-cells (equalp othercell value)))))
+	(and equal-size equal-cells)))
+
 (defmethod evolve ((object world))
   (with-slots (size cells) object
 	(defvar alive-cells)

CommonLisp/tests.lisp

+(require "asdf")
+(asdf:operate 'asdf:load-op 'conway)
+(load "~/.quicklisp/setup.lisp")
+(ql:quickload :lisp-unit)
+(use-package :lisp-unit)
+
+(define-test test-block
+  (let ((alive (make-block (make-coord :x 0 :y 0))))
+	(let ((original (make-world 5 alive)))
+	  (let ((next (evolve original)))
+		(assert-true (equal-world original next))))))
+
+(define-test test-tub
+  (let ((alive (make-tub (make-coord :x 0 :y 0))))
+	(let ((original (make-world 5 alive)))
+	  (let ((next (evolve original)))
+		(assert-true (equal-world original next))))))
+
+(define-test test-blinker
+  (let ((alive (make-blinker (make-coord :x 0 :y 1))))
+	(let ((original (make-world 3 alive)))
+	  (let ((gen1 (evolve original)))
+		(let ((expected-alive (list (make-coord :x 1 :y 0)
+									(make-coord :x 1 :y 1)
+									(make-coord :x 1 :y 2))))
+		  (let ((expected (make-world 3 expected-alive)))
+			(assert-true (equal-world expected gen1))
+			(let ((gen2 (evolve gen1)))
+			  (assert-true (equal-world original gen2)))))))))
+
+(run-tests :all)
+